PARAMETERS m.Cadena && m.Cadena = Tabla.CampoMemo
m.Cadena = ALLTRIM( m.Cadena)
PRIVATE m.Variable00, m.Variable01, m.Variable02, m.Variable03, m.Variable04, m.Variable05, m.Variable06, m.Variable07, m.Variable08, m.Variable09,;
m.Variable10, m.Variable11, m.Variable12, m.Variable13, m.Variable14, m.Variable15, m.Variable16, m.Variable17, m.Variable18, m.Variable19,;
m.Variable20, m.Variable21, m.Variable22, m.Variable23, m.Variable24, m.Variable25, m.Variable26, m.Variable27, m.Variable28, m.Variable29
STORE '' TO m.Variable00, m.Variable01, m.Variable02, m.Variable03, m.Variable04, m.Variable05, m.Variable06, m.Variable07, m.Variable08, m.Variable09,;
m.Variable10, m.Variable11, m.Variable12, m.Variable13, m.Variable14, m.Variable15, m.Variable16, m.Variable17, m.Variable18, m.Variable19,;
m.Variable20, m.Variable21, m.Variable22, m.Variable23, m.Variable24, m.Variable25, m.Variable26, m.Variable27, m.Variable28, m.Variable29
DO WHILE LEFT( m.Cadena, 2) == CHR( 13) + CHR( 10)
m.Cadena = ALLTRIM( SUBSTR( m.Cadena, 3))
ENDDO
DO WHILE RIGHT( m.Cadena, 2) == CHR( 13) + CHR( 10)
m.Cadena = ALLTRIM( LEFT( m.Cadena, LEN( m.Cadena) - 2))
ENDDO
IF !RIGHT( m.Cadena, 2) == CHR( 13) + CHR( 10)
m.Cadena = m.Cadena + CHR( 13) + CHR( 10)
ENDIF
m.Renglon = ''
DO WHILE !EMPTY( m.Cadena)
DO _InternarceMas
IF m.Cadena == CHR( 13) + CHR( 10)
m.Cadena = ''
EXIT
ENDIF
ENDDO
RELEASE m.Variable00, m.Variable01, m.Variable02, m.Variable03, m.Variable04, m.Variable05, m.Variable06, m.Variable07, m.Variable08, m.Variable09,;
m.Variable10, m.Variable11, m.Variable12, m.Variable13, m.Variable14, m.Variable15, m.Variable16, m.Variable17, m.Variable18, m.Variable19,;
m.Variable20, m.Variable21, m.Variable22, m.Variable23, m.Variable24, m.Variable25, m.Variable26, m.Variable27, m.Variable28, m.Variable29
*********************
PROCEDURE _InternarceMas
*********************
IF _SiElProximoRenglonNoEsValido()
RETURN
ENDIF
IF _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioI()
RETURN
ENDIF
IF _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioD()
RETURN
ENDIF
IF _UnirRenglonesDivididos()
RETURN
ENDIF
IF _SiElRenglonNoSeDebeConsiderar()
RETURN
ENDIF
DO _EntresacarEspaciosYTabuladosDeMas
DO _Comando
*****************
PROCEDURE _Comando
*****************
DO CASE
CASE 'DO WHILE ' $ UPPER( m.Renglon)
PRIVATE m.Condicion, m.MarcaDelIF, m.Bucle, m.CadenaVerdadera, m.Salir, m.Volver
m.Condicion = SUBSTR( m.Renglon, AT( 'DO WHILE ', m.Renglon) + 9)
m.MarcaDelIF = SUBSTR( m.Renglon, 1, AT( 'DO WHILE ', m.Renglon) - 1)
m.Bucle = ALLTRIM( SUBSTR( m.Cadena, 1, AT( m.MarcaDelIF + 'ENDDO', m.Cadena) - 1))
m.CadenaVerdadera = SUBSTR( m.Cadena, AT( m.MarcaDelIF + 'ENDDO', m.Cadena) + 5 + LEN( m.MarcaDelIF))
m.Salir = .F.
DO WHILE EVAL( m.Condicion)
m.Volver = .F.
m.Cadena = m.Bucle
DO WHILE !EMPTY( m.Cadena)
DO _InternarceMas
ENDDO
IF m.Salir
EXIT
ENDIF
ENDDO
m.Cadena = m.CadenaVerdadera
CASE 'EXIT' $ UPPER( m.Renglon)
m.Cadena = ''
m.Salir = .T.
CASE 'LOOP' $ UPPER( m.Renglon)
m.Cadena = ''
m.Volver = .T.
CASE 'IF ' $ UPPER( LEFT( m.Renglon, 4))
PRIVATE m.Condicion, m.MarcaDelIF, m.BucleIF, m.BucleELSE, m.CadenaVerdadera
m.Condicion = SUBSTR( m.Renglon, AT( 'IF ', m.Renglon) + 3)
m.MarcaDelIF = SUBSTR( m.Renglon, 1, AT( 'IF ', m.Renglon) - 1)
IF m.MarcaDelIF + 'ELSE' $ UPPER( m.Cadena)
m.BucleIF = ALLTRIM( SUBSTR( m.Cadena, 1, AT( m.MarcaDelIF + 'ELSE', m.Cadena) - 1))
m.BucleELSE = ALLTRIM( SUBSTR( m.Cadena, AT( m.MarcaDelIF + 'ELSE', m.Cadena) + 4 + LEN( m.MarcaDelIF)))
m.BucleELSE = ALLTRIM( SUBSTR( m.BucleELSE, 1, AT( m.MarcaDelIF + 'ENDIF', m.BucleELSE) - 1))
ELSE
m.BucleIF = ALLTRIM( SUBSTR( m.Cadena, 1, AT( m.MarcaDelIF + 'ENDIF', m.Cadena) - 1))
m.BucleELSE = ''
ENDIF
m.CadenaVerdadera = SUBSTR( m.Cadena, AT( m.MarcaDelIF + 'ENDIF', m.Cadena) + 5 + LEN( m.MarcaDelIF))
IF EVAL( m.Condicion)
m.Cadena = m.BucleIF
DO WHILE !EMPTY( m.Cadena)
DO _InternarceMas
ENDDO
ELSE
IF !EMPTY( m.BucleELSE)
m.Cadena = m.BucleELSE
DO WHILE !EMPTY( m.Cadena)
DO _InternarceMas
ENDDO
ENDIF
ENDIF
IF ( VARTYPE( m.Salir) == 'U' OR !m.Salir) AND ( VARTYPE( m.Volver) == 'U' OR !m.Volver)
m.Cadena = m.CadenaVerdadera
ENDIF
OTHERWISE
&Renglon
ENDCASE
********************************
PROCEDURE _SiElProximoRenglonNoEsValido
********************************
m.Renglon = ALLTRIM( SUBSTR( m.Cadena, 1, AT( CHR( 13), m.Cadena) - 1))
m.Cadena = SUBSTR( m.Cadena, AT( CHR( 13), m.Cadena) + 2)
IF '#IF' $ UPPER( m.Renglon)
DO WHILE .T.
m.Renglon = ALLTRIM( SUBSTR( m.Cadena, 1, AT( CHR( 13), m.Cadena) - 1))
m.Cadena = SUBSTR( m.Cadena, AT( CHR( 13), m.Cadena) + 2)
IF '#ENDIF' $ UPPER( m.Renglon)
m.Renglon = ALLTRIM( SUBSTR( m.Cadena, 1, AT( CHR( 13), m.Cadena) - 1))
m.Cadena = SUBSTR( m.Cadena, AT( CHR( 13), m.Cadena) + 2)
EXIT
ENDIF
ENDDO
ENDIF
RETURN EMPTY( m.Renglon)
********************************************************
PROCEDURE _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioI
********************************************************
DO WHILE !EMPTY( m.Renglon) AND ;
( LEFT( m.Renglon, 1) == CHR( 32) OR ;
LEFT( m.Renglon, 1) == CHR( 9))
m.Renglon = SUBSTR( m.Renglon, 2)
ENDDO
RETURN EMPTY( m.Renglon)
********************************************************
PROCEDURE _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioD
********************************************************
DO WHILE !EMPTY( m.Renglon) AND ;
( RIGHT( m.Renglon, 1) == CHR( 32) OR ;
RIGHT( m.Renglon, 1) == CHR( 9))
m.Renglon = LEFT( m.Renglon, LEN( m.Renglon) - 1)
ENDDO
RETURN EMPTY( m.Renglon)
***************************
PROCEDURE _UnirRenglonesDivididos
***************************
LOCAL m.Renglon2
DO WHILE CHR( 59) == RIGHT( m.Renglon, 1)
m.Renglon = LEFT( m.Renglon, LEN( m.Renglon) - 1)
IF _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioD()
EXIT
ENDIF
m.Renglon2 = m.Renglon
IF _SiElProximoRenglonNoEsValido()
m.Renglon = m.Renglon2
EXIT
ENDIF
IF _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioI()
m.Renglon = m.Renglon2
EXIT
ENDIF
IF _SiDespuesDeEliminarEspaciosyTabuladosEnRenglonQuedaVacioD()
m.Renglon = m.Renglon2
EXIT
ENDIF
m.Renglon = m.Renglon2 + CHR( 32) + m.Renglon
ENDDO
RETURN EMPTY( m.Renglon)
**********************************
PROCEDURE _SiElRenglonNoSeDebeConsiderar
**********************************
IF '*' == LEFT( m.Renglon, 1)
RETURN
ENDIF
IF '&' + '&' $ m.Renglon
m.Renglon = ALLTRIM( SUBSTR( m.Renglon, 1, AT( '&' + '&', m.Renglon) - 1))
RETURN EMPTY( m.Renglon)
ENDIF
RETURN .F.
*************************************
PROCEDURE _EntresacarEspaciosYTabuladosDeMas
*************************************
PRIVATE m.NuevoRenglon, m.Literal, m.Espacios, m.Palabra, m.Letra
m.NuevoRenglon = ''
m.Literal = ''
m.Espacios = 0
m.Palabra = ''
DO WHILE !EMPTY( m.Renglon)
IF LEN( m.Renglon) = 1
m.Letra = m.Renglon
m.Renglon = ''
ELSE
m.Letra = LEFT( m.Renglon, 1)
m.Renglon = SUBSTR( m.Renglon, 2)
ENDIF
DO _EntresacarEspaciosYTabulados
ENDDO
m.Renglon = m.NuevoRenglon
********************************
PROCEDURE _EntresacarEspaciosYTabulados
********************************
IF m.Letra = CHR( 39) OR m.Letra = CHR( 34)
m.Espacios = 0
IF EMPTY( m.Literal)
m.Literal = m.Letra
ELSE
IF m.Letra = m.Literal
m.Literal = ''
ENDIF
ENDIF
ELSE
IF EMPTY( m.Literal)
IF m.Letra = CHR( 32)
IF EMPTY( m.Espacios)
m.Espacios = 1
ELSE
m.Letra = ''
ENDIF
ELSE
IF m.Letra = CHR( 9)
IF EMPTY( m.Espacios)
m.Letra = CHR( 32)
m.Espacios = 1
ELSE
m.Letra = ''
ENDIF
ELSE
m.Espacios = 0
ENDIF
ENDIF
ENDIF
ENDIF
IF LEN( m.Letra) = 1
m.NuevoRenglon = m.NuevoRenglon + m.Letra
ENDIF
Comentarios sobre la versión: 7.0 (0)
No hay comentarios