Attribute VB_Name = "Mod1ConvertToOptionExplicitNewcheckWhenVariant" ' ============================================ ' MÓDULO DE ANÁLISIS DE TIPOS CON FLUJO ' ============================================ ' Descripción: Analiza expresiones VB6 y determina ' tipos de datos considerando el flujo del código ' ============================================ Option Explicit ' ============================================ ' SECCIÓN 1: DECLARACIONES Y TIPOS ' ============================================ ' Tipo para tokens de expresiones Private Type token Value As String TokenType As String ' "Number", "Operator", "Function", "Variable", "String" Position As Long End Type ' Tipo para estado de variables Private Type VariableState Name As String CurrentType As DataType LastAssignmentLine As Long IsDeclared As Boolean DeclaredType As DataType End Type ' Enumeración de tipos de datos Public Enum DataType dtUnknown = 0 dtByte = 1 dtInteger = 2 dtLong = 3 dtSingle = 4 dtDouble = 5 dtCurrency = 6 dtString = 7 dtBoolean = 8 dtDate = 9 dtVariant = 10 dtObject = 11 End Enum ' ============================================ ' SECCIÓN 2: FUNCIÓN PRINCIPAL PÚBLICA ' ============================================ Public Function AnalizarValorParaTipoConFlujo(ByVal expresion As String, _ ByVal codigoCompleto As String, _ ByVal nombreVariable As String) As String Dim estadoVariables() As VariableState Dim lineas() As String Dim tipoFinal As DataType ' Inicializar array ReDim estadoVariables(0) ' Analizar todo el código lineas = Split(codigoCompleto, vbCrLf) ' Primero buscar declaraciones Call BuscarDeclaraciones(lineas, estadoVariables) ' Luego analizar el flujo línea por línea Call AnalizarFlujoCompleto(lineas, estadoVariables) ' Obtener el tipo final de la variable que nos interesa tipoFinal = ObtenerTipoVariable(nombreVariable, estadoVariables) AnalizarValorParaTipoConFlujo = DataTypeToString(tipoFinal) End Function ' ============================================ ' SECCIÓN 3: ANÁLISIS DE FLUJO DE CÓDIGO ' ============================================ Private Sub BuscarDeclaraciones(lineas() As String, estados() As VariableState) Dim i As Long Dim linea As String For i = 0 To UBound(lineas) linea = Trim$(lineas(i)) If InStr(linea, "Dim ") > 0 Or InStr(linea, "Private ") > 0 Or InStr(linea, "Public ") > 0 Then Call ProcesarDeclaracion(linea, estados) End If If InStr(linea, "Sub ") > 0 Or InStr(linea, "Function ") > 0 Then Call ProcesarParametros(linea, estados) End If Next i End Sub Private Sub AnalizarFlujoCompleto(lineas() As String, estados() As VariableState) Dim i As Long Dim linea As String Dim posIgual As Long Dim variable As String Dim expresion As String Dim tipoExpresion As DataType For i = 0 To UBound(lineas) linea = Trim$(lineas(i)) posIgual = InStr(linea, "=") If posIgual > 0 Then Dim charAntes As String, charDespues As String If posIgual > 1 Then charAntes = Mid$(linea, posIgual - 1, 1) If posIgual < Len(linea) Then charDespues = Mid$(linea, posIgual + 1, 1) If charAntes <> "<" And charAntes <> ">" And charAntes <> "!" And _ charDespues <> "=" And charDespues <> ">" And charDespues <> "<" Then variable = Trim$(Left$(linea, posIgual - 1)) expresion = Trim$(Mid$(linea, posIgual + 1)) If Left$(variable, 4) = "Set " Then variable = Trim$(Mid$(variable, 5)) End If tipoExpresion = AnalizarExpresionConContexto(expresion, estados) Call ActualizarEstadoVariable(variable, tipoExpresion, i, estados) End If End If Next i End Sub Private Sub ProcesarDeclaracion(linea As String, estados() As VariableState) Dim partes() As String Dim variables() As String Dim tipo As String Dim i As Long, j As Long linea = Replace(linea, "Dim ", "") linea = Replace(linea, "Private ", "") linea = Replace(linea, "Public ", "") If InStr(linea, " As ") > 0 Then partes = Split(linea, " As ") variables = Split(partes(0), ",") tipo = Trim$(partes(1)) For i = 0 To UBound(variables) ' Buscar espacio en el array For j = 0 To UBound(estados) If estados(j).Name = "" Then Exit For Next j If j > UBound(estados) Then ReDim Preserve estados(UBound(estados) + 10) End If estados(j).Name = Trim$(variables(i)) estados(j).DeclaredType = StringToDataType(tipo) estados(j).CurrentType = estados(j).DeclaredType estados(j).IsDeclared = True estados(j).LastAssignmentLine = -1 Next i End If End Sub Private Sub ProcesarParametros(linea As String, estados() As VariableState) Dim posInicio As Long, posFin As Long Dim parametros As String Dim params() As String Dim i As Long, j As Long Dim partes() As String posInicio = InStr(linea, "(") posFin = InStr(linea, ")") If posInicio > 0 And posFin > posInicio Then parametros = Mid$(linea, posInicio + 1, posFin - posInicio - 1) params = Split(parametros, ",") For i = 0 To UBound(params) If InStr(params(i), " As ") > 0 Then partes = Split(Trim$(params(i)), " As ") partes(0) = Replace(partes(0), "ByVal ", "") partes(0) = Replace(partes(0), "ByRef ", "") partes(0) = Replace(partes(0), "Optional ", "") For j = 0 To UBound(estados) If estados(j).Name = "" Then Exit For Next j If j > UBound(estados) Then ReDim Preserve estados(UBound(estados) + 10) End If estados(j).Name = Trim$(partes(0)) estados(j).DeclaredType = StringToDataType(Trim$(partes(1))) estados(j).CurrentType = estados(j).DeclaredType estados(j).IsDeclared = True estados(j).LastAssignmentLine = -1 End If Next i End If End Sub ' ============================================ ' SECCIÓN 4: GESTIÓN DE ESTADO DE VARIABLES ' ============================================ Private Function ObtenerTipoVariable(nombre As String, estados() As VariableState) As DataType Dim i As Long If UBound(estados) >= 0 Then For i = 0 To UBound(estados) If estados(i).Name <> "" Then If UCase$(estados(i).Name) = UCase$(nombre) Then ObtenerTipoVariable = estados(i).CurrentType Exit Function End If End If Next i End If ObtenerTipoVariable = dtVariant End Function Private Sub ActualizarEstadoVariable(nombre As String, nuevoTipo As DataType, _ linea As Long, estados() As VariableState) Dim i As Long Dim encontrado As Boolean ' Buscar si ya existe For i = 0 To UBound(estados) If estados(i).Name <> "" Then If UCase$(estados(i).Name) = UCase$(nombre) Then encontrado = True If estados(i).IsDeclared And estados(i).DeclaredType <> dtVariant Then ' Tipo fijo, no cambia Else estados(i).CurrentType = nuevoTipo estados(i).LastAssignmentLine = linea End If Exit For End If End If Next i ' Si no existe, agregar If Not encontrado Then ' Buscar primera posición vacía o expandir array For i = 0 To UBound(estados) If estados(i).Name = "" Then Exit For End If Next i ' Si no hay espacio, expandir If i > UBound(estados) Then ReDim Preserve estados(UBound(estados) + 10) End If estados(i).Name = nombre estados(i).CurrentType = nuevoTipo estados(i).LastAssignmentLine = linea estados(i).IsDeclared = False estados(i).DeclaredType = dtVariant End If End Sub ' ============================================ ' SECCIÓN 5: ANÁLISIS DE EXPRESIONES ' ============================================ Private Function AnalizarExpresionConContexto(expresion As String, estados() As VariableState) As DataType Dim tokens() As token Dim tipoResultado As DataType tipoResultado = AnalizarCasoSimple(expresion) If tipoResultado <> dtUnknown Then AnalizarExpresionConContexto = tipoResultado Exit Function End If tokens = TokenizarExpresion(expresion) AnalizarExpresionConContexto = AnalizarTokensConContexto(tokens, estados) End Function Private Function AnalizarCasoSimple(ByVal valor As String) As DataType ' String literal If Left$(valor, 1) = Chr$(34) Then AnalizarCasoSimple = dtString Exit Function End If ' Boolean literal If UCase$(valor) = "TRUE" Or UCase$(valor) = "FALSE" Then AnalizarCasoSimple = dtBoolean Exit Function End If ' Date literal If Left$(valor, 1) = "#" And Right$(valor, 1) = "#" Then AnalizarCasoSimple = dtDate Exit Function End If ' Número simple If IsNumeric(valor) And InStr(valor, "(") = 0 Then If InStr(valor, ".") > 0 Then ' Tiene decimales Dim decimales As Integer decimales = Len(Mid$(valor, InStr(valor, ".") + 1)) If decimales > 4 Then AnalizarCasoSimple = dtCurrency Else AnalizarCasoSimple = dtDouble End If Else ' Entero Dim numVal As Variant numVal = Val(valor) If numVal >= -32768 And numVal <= 32767 Then AnalizarCasoSimple = dtInteger Else AnalizarCasoSimple = dtLong End If End If Exit Function End If AnalizarCasoSimple = dtUnknown End Function ' ============================================ ' SECCIÓN 6: TOKENIZACIÓN ' ============================================ Private Function TokenizarExpresion(ByVal expresion As String) As token() Dim tokens() As token Dim tokenCount As Long Dim i As Long Dim currentToken As String Dim inString As Boolean Dim char As String ReDim tokens(0) tokenCount = 0 currentToken = "" inString = False For i = 1 To Len(expresion) char = Mid$(expresion, i, 1) ' Manejo de strings If char = Chr$(34) Then If inString Then currentToken = currentToken & char Call AgregarToken(tokens, tokenCount, currentToken, "String", i) currentToken = "" inString = False Else If currentToken <> "" Then Call AgregarToken(tokens, tokenCount, currentToken, DeterminarTipoToken(currentToken), i) End If currentToken = char inString = True End If ElseIf inString Then currentToken = currentToken & char ' Operadores y delimitadores ElseIf InStr("+-*/\^(),.=<>", char) > 0 Then If currentToken <> "" Then Call AgregarToken(tokens, tokenCount, currentToken, DeterminarTipoToken(currentToken), i) currentToken = "" End If Call AgregarToken(tokens, tokenCount, char, "Operator", i) ' Espacios ElseIf char = " " Then If currentToken <> "" Then Call AgregarToken(tokens, tokenCount, currentToken, DeterminarTipoToken(currentToken), i) currentToken = "" End If ' Otros caracteres Else currentToken = currentToken & char End If Next i ' Último token If currentToken <> "" Then Call AgregarToken(tokens, tokenCount, currentToken, DeterminarTipoToken(currentToken), i) End If ' Identificar funciones por contexto For i = 0 To tokenCount - 2 If tokens(i).TokenType = "Variable" Then If i < tokenCount - 1 Then If tokens(i + 1).Value = "(" Then tokens(i).TokenType = "Function" End If End If End If Next i ' Redimensionar array final If tokenCount > 0 Then ReDim Preserve tokens(tokenCount - 1) Else ReDim tokens(0) End If TokenizarExpresion = tokens End Function Private Sub AgregarToken(ByRef tokens() As token, ByRef count As Long, _ ByVal Value As String, ByVal TokenType As String, ByVal pos As Long) If count > UBound(tokens) Then ReDim Preserve tokens(count + 10) End If tokens(count).Value = Value tokens(count).TokenType = TokenType tokens(count).Position = pos count = count + 1 End Sub Private Function DeterminarTipoToken(ByVal token As String) As String If IsNumeric(token) Then DeterminarTipoToken = "Number" ElseIf Left$(token, 1) = Chr$(34) Then DeterminarTipoToken = "String" Else DeterminarTipoToken = "Variable" End If End Function ' ============================================ ' SECCIÓN 7: ANÁLISIS DE TOKENS ' ============================================ Private Function AnalizarTokensConContexto(tokens() As token, estados() As VariableState) As DataType Dim i As Long Dim tipos() As DataType Dim tipoActual As DataType Dim hayOperadores As Boolean ReDim tipos(UBound(tokens)) For i = 0 To UBound(tokens) Select Case tokens(i).TokenType Case "Number" If InStr(tokens(i).Value, ".") > 0 Then tipos(i) = dtDouble Else Dim numVal As Variant numVal = Val(tokens(i).Value) If numVal >= -32768 And numVal <= 32767 Then tipos(i) = dtInteger Else tipos(i) = dtLong End If End If Case "String" tipos(i) = dtString Case "Function" tipos(i) = AnalizarLlamadaFuncion(tokens, i) Case "Variable" tipos(i) = ObtenerTipoVariable(tokens(i).Value, estados) If i < UBound(tokens) - 1 Then If tokens(i + 1).Value = "." Then tipos(i) = AnalizarPropiedadObjeto(tokens, i) End If End If Case "Operator" If InStr("+-*/\^", tokens(i).Value) > 0 Then hayOperadores = True ElseIf InStr("<>", tokens(i).Value) > 0 Then If tokens(i).Value <> "<>" Then hayOperadores = True End If End If End Select Next i If hayOperadores Then tipoActual = dtUnknown For i = 0 To UBound(tokens) If tokens(i).TokenType = "Operator" Then If i > 0 And i < UBound(tokens) Then tipoActual = PromoverTipos(tipos(i - 1), tipos(i + 1), tokens(i).Value) End If End If Next i If tipoActual = dtUnknown Then tipoActual = ObtenerTipoMasAmplio(tipos) End If Else For i = 0 To UBound(tipos) If tipos(i) <> dtUnknown Then tipoActual = tipos(i) Exit For End If Next i End If AnalizarTokensConContexto = tipoActual End Function Private Function AnalizarTokens(tokens() As token, Optional ByVal codigo As String = "") As DataType Dim i As Long Dim resultado As DataType resultado = dtUnknown ' Buscar patrones específicos For i = 0 To UBound(tokens) Select Case tokens(i).TokenType Case "Function" resultado = AnalizarLlamadaFuncion(tokens, i) If resultado <> dtUnknown Then Exit For Case "Variable" If i < UBound(tokens) Then If tokens(i + 1).Value = "." Then resultado = AnalizarPropiedadObjeto(tokens, i) If resultado <> dtUnknown Then Exit For End If End If Case "Operator" If InStr("+-*/\^", tokens(i).Value) > 0 Then resultado = AnalizarOperacion(tokens, i) End If End Select Next i ' Si no se determinó el tipo, usar análisis de contexto If resultado = dtUnknown And codigo <> "" Then resultado = AnalizarContexto(tokens, codigo) End If ' Default final If resultado = dtUnknown Then resultado = DeterminarTipoPorDefecto(tokens) End If AnalizarTokens = resultado End Function ' ============================================ ' SECCIÓN 8: ANÁLISIS DE FUNCIONES ' ============================================ Private Function AnalizarLlamadaFuncion(tokens() As token, ByVal pos As Long) As DataType Dim nombreFuncion As String nombreFuncion = UCase$(tokens(pos).Value) ' Tabla de funciones VB6 y sus tipos de retorno Select Case nombreFuncion ' Matemáticas - Double Case "SQR", "LOG", "EXP", "SIN", "COS", "TAN", "ATN", "ROUND" AnalizarLlamadaFuncion = dtDouble ' Matemáticas - Single Case "RND": AnalizarLlamadaFuncion = dtSingle ' Timer Case "TIMER": AnalizarLlamadaFuncion = dtSingle ' Conversión de tipos Case "CINT": AnalizarLlamadaFuncion = dtInteger Case "CLNG": AnalizarLlamadaFuncion = dtLong Case "CDBL": AnalizarLlamadaFuncion = dtDouble Case "CSNG": AnalizarLlamadaFuncion = dtSingle Case "CCUR": AnalizarLlamadaFuncion = dtCurrency Case "CSTR": AnalizarLlamadaFuncion = dtString Case "CBOOL": AnalizarLlamadaFuncion = dtBoolean Case "CDATE": AnalizarLlamadaFuncion = dtDate Case "CBYTE": AnalizarLlamadaFuncion = dtByte Case "VAL": AnalizarLlamadaFuncion = dtDouble Case "STR", "STR$": AnalizarLlamadaFuncion = dtString ' Funciones especiales Case "ABS", "SGN", "INT", "FIX" AnalizarLlamadaFuncion = AnalizarFuncionEspecial(tokens, pos, nombreFuncion) ' Funciones de cadena Case "LEN", "INSTR", "INSTRREV": AnalizarLlamadaFuncion = dtLong Case "ASC", "ASCB", "ASCW": AnalizarLlamadaFuncion = dtInteger Case "LEFT", "RIGHT", "MID", "TRIM", "LTRIM", "RTRIM": AnalizarLlamadaFuncion = dtString Case "LEFT$", "RIGHT$", "MID$", "TRIM$", "LTRIM$", "RTRIM$": AnalizarLlamadaFuncion = dtString Case "UCASE", "LCASE", "UCASE$", "LCASE$": AnalizarLlamadaFuncion = dtString Case "SPACE", "SPACE$", "STRING", "STRING$": AnalizarLlamadaFuncion = dtString Case "CHR", "CHR$": AnalizarLlamadaFuncion = dtString ' Funciones de fecha/hora Case "NOW", "DATE", "TIME": AnalizarLlamadaFuncion = dtDate Case "YEAR", "MONTH", "DAY", "WEEKDAY": AnalizarLlamadaFuncion = dtInteger Case "HOUR", "MINUTE", "SECOND": AnalizarLlamadaFuncion = dtInteger Case "DATEADD", "DATESERIAL", "DATEVALUE": AnalizarLlamadaFuncion = dtDate Case "TIMESERIAL", "TIMEVALUE": AnalizarLlamadaFuncion = dtDate Case "DATEDIFF": AnalizarLlamadaFuncion = dtLong ' Funciones de archivo Case "FREEFILE", "LOF", "EOF", "LOC", "SEEK": AnalizarLlamadaFuncion = dtLong Case "FILELEN", "FILEDATETIME": AnalizarLlamadaFuncion = dtLong Case "GETATTR": AnalizarLlamadaFuncion = dtInteger Case "DIR", "DIR$", "CURDIR", "CURDIR$": AnalizarLlamadaFuncion = dtString ' Funciones de objeto Case "CREATEOBJECT", "GETOBJECT": AnalizarLlamadaFuncion = dtObject ' Funciones de array Case "LBOUND", "UBOUND": AnalizarLlamadaFuncion = dtLong Case "ARRAY": AnalizarLlamadaFuncion = dtVariant ' Otras funciones Case "RGB", "QBCOLOR": AnalizarLlamadaFuncion = dtLong Case "SHELL": AnalizarLlamadaFuncion = dtDouble Case "CHOOSE", "SWITCH", "IIF": AnalizarLlamadaFuncion = dtVariant Case "TYPENAME": AnalizarLlamadaFuncion = dtString Case "VARTYPE": AnalizarLlamadaFuncion = dtInteger Case "ISARRAY", "ISDATE", "ISEMPTY", "ISERROR": AnalizarLlamadaFuncion = dtBoolean Case "ISMISSING", "ISNULL", "ISNUMERIC", "ISOBJECT": AnalizarLlamadaFuncion = dtBoolean Case Else AnalizarLlamadaFuncion = dtVariant End Select End Function Private Function AnalizarFuncionEspecial(tokens() As token, ByVal pos As Long, _ ByVal funcion As String) As DataType Dim tipoArgumento As DataType Dim posInicio As Long, posFin As Long ' Encontrar el contenido entre paréntesis posInicio = pos + 2 ' Después de "funcion(" posFin = EncontrarCierreParentesis(tokens, pos + 1) If posFin > posInicio Then ' Extraer tokens del argumento Dim argTokens() As token argTokens = ExtraerTokensRango(tokens, posInicio, posFin - 1) ' Analizar tipo del argumento tipoArgumento = AnalizarTokens(argTokens, "") Select Case funcion Case "ABS" ' Abs retorna el mismo tipo que recibe AnalizarFuncionEspecial = tipoArgumento Case "SGN" ' Sgn siempre retorna Integer (-1, 0, 1) AnalizarFuncionEspecial = dtInteger Case "INT", "FIX" ' Int y Fix mantienen el tipo pero sin decimales Select Case tipoArgumento Case dtSingle, dtDouble, dtCurrency AnalizarFuncionEspecial = tipoArgumento Case Else AnalizarFuncionEspecial = dtLong End Select End Select Else ' Default si no se puede analizar Select Case funcion Case "SGN": AnalizarFuncionEspecial = dtInteger Case Else: AnalizarFuncionEspecial = dtDouble End Select End If End Function ' ============================================ ' SECCIÓN 9: ANÁLISIS DE PROPIEDADES ' ============================================ Private Function AnalizarPropiedadObjeto(tokens() As token, ByVal pos As Long) As DataType Dim objeto As String Dim propiedad As String If pos + 2 > UBound(tokens) Then AnalizarPropiedadObjeto = dtUnknown Exit Function End If objeto = UCase$(tokens(pos).Value) propiedad = UCase$(tokens(pos + 2).Value) ' Screen object If objeto = "SCREEN" Then Select Case propiedad Case "TWIPSPERPIXELX", "TWIPSPERPIXELY": AnalizarPropiedadObjeto = dtSingle Case "WIDTH", "HEIGHT": AnalizarPropiedadObjeto = dtLong Case Else: AnalizarPropiedadObjeto = dtUnknown End Select ' Form/Control properties ElseIf InStr(",LEFT,TOP,WIDTH,HEIGHT,", "," & propiedad & ",") > 0 Then AnalizarPropiedadObjeto = dtLong ElseIf InStr(",SCALELEFT,SCALETOP,SCALEWIDTH,SCALEHEIGHT,", "," & propiedad & ",") > 0 Then AnalizarPropiedadObjeto = dtSingle ElseIf InStr(",CURRENTX,CURRENTY,", "," & propiedad & ",") > 0 Then AnalizarPropiedadObjeto = dtSingle ElseIf propiedad = "TEXT" Or propiedad = "CAPTION" Then AnalizarPropiedadObjeto = dtString ElseIf propiedad = "VALUE" Then AnalizarPropiedadObjeto = dtInteger Else AnalizarPropiedadObjeto = dtUnknown End If End Function ' ============================================ ' SECCIÓN 10: ANÁLISIS DE OPERACIONES ' ============================================ Private Function AnalizarOperacion(tokens() As token, ByVal posOperador As Long) As DataType Dim tipoIzq As DataType, tipoDer As DataType Dim operador As String operador = tokens(posOperador).Value ' Analizar operandos izquierdo y derecho If posOperador > 0 And posOperador < UBound(tokens) Then tipoIzq = DeterminarTipoDataDeToken(tokens(posOperador - 1)) tipoDer = DeterminarTipoDataDeToken(tokens(posOperador + 1)) ' Aplicar reglas de promoción AnalizarOperacion = PromoverTipos(tipoIzq, tipoDer, operador) Else AnalizarOperacion = dtUnknown End If End Function Private Function PromoverTipos(tipo1 As DataType, tipo2 As DataType, operador As String) As DataType ' División siempre produce Double If operador = "/" Then PromoverTipos = dtDouble Exit Function End If ' Exponenciación siempre produce Double If operador = "^" Then PromoverTipos = dtDouble Exit Function End If ' División entera y módulo producen Long If operador = "\" Or operador = "Mod" Then PromoverTipos = dtLong Exit Function End If ' Para otros operadores, promover al tipo más amplio If tipo1 = dtDouble Or tipo2 = dtDouble Then PromoverTipos = dtDouble ElseIf tipo1 = dtSingle Or tipo2 = dtSingle Then PromoverTipos = dtSingle ElseIf tipo1 = dtCurrency Or tipo2 = dtCurrency Then PromoverTipos = dtCurrency ElseIf tipo1 = dtLong Or tipo2 = dtLong Then PromoverTipos = dtLong ElseIf tipo1 = dtInteger Or tipo2 = dtInteger Then PromoverTipos = dtInteger Else PromoverTipos = dtVariant End If End Function Private Function ObtenerTipoMasAmplio(tipos() As DataType) As DataType Dim i As Long Dim resultado As DataType resultado = dtUnknown For i = 0 To UBound(tipos) If tipos(i) <> dtUnknown Then If resultado = dtUnknown Then resultado = tipos(i) Else ' Comparar y quedarse con el más amplio If tipos(i) = dtDouble Or resultado = dtDouble Then resultado = dtDouble ElseIf tipos(i) = dtSingle Or resultado = dtSingle Then resultado = dtSingle ElseIf tipos(i) = dtCurrency Or resultado = dtCurrency Then resultado = dtCurrency ElseIf tipos(i) = dtLong Or resultado = dtLong Then resultado = dtLong ElseIf tipos(i) = dtInteger Or resultado = dtInteger Then resultado = dtInteger End If End If End If Next i ObtenerTipoMasAmplio = resultado End Function ' ============================================ ' SECCIÓN 11: FUNCIONES AUXILIARES ' ============================================ Private Function EncontrarCierreParentesis(tokens() As token, ByVal posInicio As Long) As Long Dim nivel As Integer Dim i As Long nivel = 1 For i = posInicio + 1 To UBound(tokens) If tokens(i).Value = "(" Then nivel = nivel + 1 ElseIf tokens(i).Value = ")" Then nivel = nivel - 1 If nivel = 0 Then EncontrarCierreParentesis = i Exit Function End If End If Next i EncontrarCierreParentesis = -1 End Function Private Function ExtraerTokensRango(tokens() As token, ByVal inicio As Long, ByVal fin As Long) As token() Dim resultado() As token Dim i As Long, j As Long If fin >= inicio And inicio >= 0 And fin <= UBound(tokens) Then ReDim resultado(fin - inicio) j = 0 For i = inicio To fin resultado(j) = tokens(i) j = j + 1 Next i Else ReDim resultado(0) End If ExtraerTokensRango = resultado End Function Private Function DeterminarTipoDataDeToken(token As token) As DataType Select Case token.TokenType Case "Number" If InStr(token.Value, ".") > 0 Then DeterminarTipoDataDeToken = dtDouble Else Dim numVal As Variant numVal = Val(token.Value) If numVal >= -32768 And numVal <= 32767 Then DeterminarTipoDataDeToken = dtInteger Else DeterminarTipoDataDeToken = dtLong End If End If Case "String" DeterminarTipoDataDeToken = dtString Case "Function", "Variable" DeterminarTipoDataDeToken = dtVariant Case Else DeterminarTipoDataDeToken = dtUnknown End Select End Function Private Function DeterminarTipoPorDefecto(tokens() As token) As DataType Dim i As Long Dim tieneDecimales As Boolean Dim tieneString As Boolean For i = 0 To UBound(tokens) If tokens(i).Value = "." And i > 0 And i < UBound(tokens) Then If IsNumeric(tokens(i - 1).Value) And IsNumeric(tokens(i + 1).Value) Then tieneDecimales = True End If End If If tokens(i).TokenType = "String" Then tieneString = True End If Next i If tieneString Then DeterminarTipoPorDefecto = dtString ElseIf tieneDecimales Then DeterminarTipoPorDefecto = dtDouble Else DeterminarTipoPorDefecto = dtLong End If End Function Private Function AnalizarContexto(tokens() As token, codigo As String) As DataType ' Aquí analizarías el código completo para buscar declaraciones ' Por ahora retorna Unknown AnalizarContexto = dtUnknown End Function ' ============================================ ' SECCIÓN 12: CONVERSIONES DE TIPOS ' ============================================ Private Function DataTypeToString(dt As DataType) As String Select Case dt Case dtByte: DataTypeToString = "Byte" Case dtInteger: DataTypeToString = "Integer" Case dtLong: DataTypeToString = "Long" Case dtSingle: DataTypeToString = "Single" Case dtDouble: DataTypeToString = "Double" Case dtCurrency: DataTypeToString = "Currency" Case dtString: DataTypeToString = "String" Case dtBoolean: DataTypeToString = "Boolean" Case dtDate: DataTypeToString = "Date" Case dtObject: DataTypeToString = "Object" Case dtVariant: DataTypeToString = "Variant" Case Else: DataTypeToString = "Variant" End Select End Function Private Function StringToDataType(tipo As String) As DataType Select Case UCase$(tipo) Case "BYTE": StringToDataType = dtByte Case "INTEGER": StringToDataType = dtInteger Case "LONG": StringToDataType = dtLong Case "SINGLE": StringToDataType = dtSingle Case "DOUBLE": StringToDataType = dtDouble Case "CURRENCY": StringToDataType = dtCurrency Case "STRING": StringToDataType = dtString Case "BOOLEAN": StringToDataType = dtBoolean Case "DATE": StringToDataType = dtDate Case "OBJECT": StringToDataType = dtObject Case "VARIANT": StringToDataType = dtVariant Case Else: StringToDataType = dtVariant End Select End Function ' ============================================ ' SECCIÓN 13: PROCEDIMIENTOS DE PRUEBA ' ============================================ Sub TestConFlujo() Dim codigo As String Dim tipo As String codigo = "Private Sub PicCaptionForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)" & vbCrLf & _ " newH = 1.1" & vbCrLf & _ " If Button = 1 Then" & vbCrLf & _ " newLeft = ((X * 10) + Me.left) - MouseX" & vbCrLf & _ " newLeft = newLeft + newH" & vbCrLf & _ " newTop = ((Y * Screen.TwipsPerPixelY) + Me.top) - MouseY" & vbCrLf & _ " Me.left = newLeft" & vbCrLf & _ " Me.top = newTop" & vbCrLf & _ " End If" & vbCrLf & _ "End Sub" ' Analizar con flujo tipo = AnalizarValorParaTipoConFlujo("", codigo, "newLeft") Debug.Print "newLeft final es: " & tipo ' Double (por la suma con newH) tipo = AnalizarValorParaTipoConFlujo("", codigo, "newH") Debug.Print "newH es: " & tipo ' Double (1.1) tipo = AnalizarValorParaTipoConFlujo("", codigo, "X") Debug.Print "X es: " & tipo ' Single (del parámetro) End Sub