[ADM] Cadena y Enteros

Librerías finalizadas programadas por usuarios entusiastas

[ADM] Cadena y Enteros

Notapor PowerDeath » Sab Ago 02, 2014 6:56 am

Les dejo la librería Cadenas que me he puesto a "rellenar" en mis practicas con Pauscal.
Le he agregado encriptaciónes, Procedimientos de Cadena y Enteros.

03/10/2014

Actualizado: RepartirCad
Agregado: MatEntCad - MatCadEnt - UnirCad - UnirEnt - CadWCad - EsPar - MatEliminar

Código: Seleccionar todo
Importar "Declare.prp"

$ADV-
$EBC-

Público:
Const CrLf=#13#10
Const Null=#0
Privado:
Proc CallWindowProc(,,,,:Entero):Entero, "user32.dll" "CallWindowProcA" ' API
Proc VarCyFromR8(nro:Real, Referencia cy:Decimal):Entero, "oleaut32"
Público:

' REGION
Proc HexEnt(hex:Cadena):Entero
   Var i:Byte
   Var car:Entero

   Contar i = CadLong(hex) a 1
      car = Ascii(ParteCad(hex, i))
      Si (i > 8) or (car < 48 and car > 58) or (car < 65 and car > 71) Entonces GenerarError errParamInv
      Resultado = Resultado + ((> car<65 ? car - 48 : car - 55) shr (i-1))
   Seguir
FinProc

Proc EsPar(Número:Entero):Booleano
   Var Texto:Cadena
   Texto = EntCad(Número)
   Texto = DerechaCad(Texto,1)
   Seleccionar Texto
      Caso "2","4","6","8","0"
         Devolver Verd
      Caso Otro
         Devolver Falso
   FinSeleccionar
FinProc

Proc CadWCad(Str:Cadena,Opcional Nulls:Booleano = Falso):Cadena
   Var Matriz[],Matriz_2[],s:Cadena,i,c:Entero
   Matriz = RepartirCad(Str)
   Si EsPar(CadLong(Str))
      ReDim Matriz_2,(Límite(Matriz) * 2) + 2
      s = Null + Null
   SiNo
      ReDim Matriz_2,(Límite(Matriz) * 2) + 3
      s = Null
   FinSi
   Contar i = 1 a Límite(Matriz_2)
      Si EsPar(i) Entonces
         Matriz_2[i] = Null
      SiNo
         Matriz_2[i] = Matriz[c]
         'Mensaje(Matriz[c])
         c = c + 1
      FinSi
   Seguir
   Si Nulls = Verd
      Devolver UnirCad(Matriz_2) + s
   SiNo
      Devolver UnirCad(Matriz_2)' + s
   FinSi
FinProc

'Hack!! La función RealDec hace fallar al compilador, así que la implementamos diferente

Proc RealDec2(nro:Real):Decimal
   VarCyFromR8(nro, Resultado)
FinProc


Proc CadDec(txt:Cadena):Decimal
   Resultado = RealDec2(CadReal(txt))
FinProc


Proc DecCad(nro:Decimal):Cadena
   Resultado = RealCad(DecReal(nro))
FinProc


Proc EntDec(nro:EnteroSig):Decimal
   Var @temp:EnteroSig
   temp@ = Resultado@
   temp = nro
   Resultado = Resultado * 10000
FinProc


Proc DecEnt(nro:Decimal):EnteroSig
   Var @temp:Decimal
   Var da[]:EnteroSig
   da=[0,0]
   temp@ = da[0]@
   temp = nro/10000
   Resultado = da[0]
FinProc

'FIN REGION

Proc EntreCad(Referencia Texto,Inicial,Final:Cadena,Opcional InicialB:Entero = 1):Cadena
   Var Primero,Segundo:Entero,Cadenilla:Cadena
   Primero = BuscarEnCad(Texto,Inicial,InicialB)
   Segundo = BuscarEnCad(Texto,Final,Primero + 1)
   Cadenilla = ParteCad(Texto,Primero,(Segundo) - (Primero))
   Cadenilla = DerechaCad(Cadenilla,CadLong(Cadenilla) - 1)
   Devolver Cadenilla
FinProc


'Proc CadROTN(Referencia sData:Cadena,Referencia sValue:Entero):Cadena ' Encriptador Rot Numero.   ' :S
'   Var Result,Letra:Cadena,iTemp:Byte
'      Contar iTemp = 1 a CadLong(sData)
'         Letra = ParteCad(sData,iTemp,1)
'         Result = Result + Carac(Ascii(Letra) + sValue)
'      Seguir
'   Devolver Result
'FinProc

' Produce un error al intentar acceder a la memoria al devolver la cadena des-encriptada, Estado = Falso.
Proc ROTN(Referencia sData:Cadena,Referencia sValue:Entero,Opcional Estado:Booleano = Verd):Cadena ' Des-Encriptador Rot Numero.  ' :S
Var Result,Letra:Cadena,iTemp:Byte
Si Estado
      Contar iTemp = 1 a CadLong(sData)
         Letra = ParteCad(sData,iTemp,1)
         Result = Result + Carac(Ascii(Letra) + sValue)
      Seguir
   Devolver Result
SiNo
      Contar iTemp = 1 a CadLong(sData)
         Letra = ParteCad(sData,iTemp,1)
         Result = Result + Carac(Ascii(Letra) - sValue)
      Seguir
   Devolver Result ' Error.
FinSi
FinProc

Proc MatEliminar(Matriz[]:Cadena,Expresión:Cadena):Cadena[]
Var i:Entero,Matriz2[]:Cadena,Contador:Entero
ReDim Matriz2,1
Contar i = 0 a Límite(Matriz)
   Si Matriz[i] <> Expresión Entonces
      Si Contador = LongMat(Matriz2) Entonces ReDim Preservar Matriz2,LongMat(Matriz2) + 1
      Matriz2[Contador] = Matriz[i]
      Contador = Contador + 1
   FinSi
Seguir
   Resultado = Matriz2
FinProc

' Reparte cada letra de una Cadena en una matriz de cadena.
Proc RepartirCad(Textos:Cadena,Opcional LongitudCad:Entero = 1):Cadena[]
Var i,Longitud:Entero,Matriz[]:Cadena
Longitud = CadLong(Textos)
Si LongitudCad > Longitud Entonces GenerarError 0,"La longitud establecida es mayor a la longitud del texto."
Si EsPar(LongitudCad) Xor EsPar(Longitud) Entonces GenerarError 1, "Si la longitud del parametro #1 es par -" + CrLf + "El valor del segundo parametro tambien debe serlo."
ReDim Matriz, Longitud
i = 1
Mientras i <= Longitud
   Matriz[i - 1] = ParteCad(Textos,i,LongitudCad)
   i = i + LongitudCad
FinMientras
   Resultado = MatEliminar(Matriz,"")
FinProc

Proc UnirCad(Matriz[]:Cadena):Cadena
   Var Result:Cadena,i:Entero
   Contar i = 0 a Límite(Matriz)
      Result = Result + Matriz[i]
   Seguir
   Devolver Result
FinProc

' Reparte cada valor de un Entero en una matriz de entero.
Proc RepartirEnt(Números:Entero):Entero[]
Var i,Longitud,Matriz[]:Entero,Textos:Cadena
Textos = EntCad(Números)
Longitud = CadLong(Textos)
ReDim Matriz, Longitud
Contar i = 1 a Longitud
   Matriz[i -1] = CadEnt(ParteCad(Textos,i,1))
Seguir
   Resultado = Matriz
FinProc

Proc UnirEnt(Matriz[]:Entero,Opcional Sumar:Booleano = Falso):Entero
   Var Result:Cadena,Beta:Entero,i:Entero
   Var Matris[]:Cadena
   'Matris = MatEntCad(Matriz)
   Contar i = 0 a Límite(Matriz)
      Si Sumar = Verd Entonces Beta = Beta + Matriz[i]
      Si Sumar = Falso Entonces Result = Result + EntCad(Matriz[i])
   Seguir
   Si Sumar = Verd Entonces Devolver Beta
   Si Sumar = Falso Entonces Devolver CadEnt(Result)
FinProc

Proc MatEntCad(Matriz[]:Entero):Cadena[]
   Var Result[]:Cadena,i:Entero
   Redim Result,LongMat(Matriz)
   Contar i = 0 a Límite(Matriz)
      Result[i] = EntCad(Matriz[i])
   Seguir
   Resultado = Result
FinProc

Proc MatCadEnt(Matriz[]:Cadena):Entero[]
   Var Result[],i:Entero
   Redim Result,LongMat(Matriz)
   Contar i = 0 a Límite(Matriz)
      Result[i] = CadEnt(Matriz[i])
   Seguir
   Resultado = Result
FinProc

Proc RepartirDec(Números:Decimal):Decimal[]
Var i,Longitud:Entero,Matriz[]:Decimal,Textos:Cadena
Textos = DecCad(Números)
Longitud = CadLong(Textos)
ReDim Matriz, Longitud
Contar i = 1 a Longitud
   Matriz[i -1] = CadDec(ParteCad(Textos,i,1))
Seguir
   Resultado = Matriz
FinProc

Proc RepartirReal(Números:Real):Real[]
Var i,Longitud:Entero,Matriz[]:Real,Textos:Cadena
Textos = RealCad(Números)
Longitud = CadLong(Textos)
ReDim Matriz, Longitud
Contar i = 1 a Longitud
   Matriz[i -1] = CadReal(ParteCad(Textos,i,1))
Seguir
   Resultado = Matriz
FinProc

Proc MatrizByteDeCadena(Referencia Temp:Cadena):Byte[]
Var i,lLen:Entero,bArr[]:Byte,Letra:Cadena
    lLen = CadLong(Temp)
    Redim bArr,lLen
    Contar i = 1 a lLen
      Letra = ParteCad(Temp,i, 1)
      bArr[i - 1] = Ascii(Letra)
    Seguir
    Resultado = bArr
FinProc


Proc EsSimbolo(Referencia PalabraA:Cadena):Booleano ' VERIFICAR
Var i:Entero
Var a:Cadena
Const nums = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Resultado = Falso
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si Neg LetraExiste(Nums,a) > 0 Entonces
         Resultado = Verd
         Salir Contar
      FinSi
Seguir
FinProc


Proc CadXor(Referencia Cadena1:Cadena):Cadena
Var Kod,X2:Cadena
Var X3:Entero
Contar X3 = 1 a CadLong(Cadena1)
X2 = ParteCad(Cadena1,X3,1)
Kod = Kod + Carac(ASCII(X2) Xor 255)
Seguir
Devolver Kod
FinProc


Proc Base64(Texto:Cadena,Opcional Enriptar:Booleano = Verd):Cadena
Var B64E[],B64D[],s_Texto[],d_Salida[]:Byte,c_Long,SalidaSize,LineBreak:Entero
s_Texto = MatrizByteDeCadena(Texto)
c_Long = CadLong(Texto)
  Si Enriptar
  LineBreak = 76
  SalidaSize = (c_Long * 4 \ 3)
  SalidaSize = SalidaSize + (SalidaSize \ LineBreak) * 2 + 4
  Redim d_Salida, SalidaSize - 1
  Redim B64E, 254
  B64E = [&55, &89, &E5, &FF, &75, &14, &53, &56, &57, _
    &E8, &41, &00, &00, &00, &41, &42, &43, &44, &45, &46, &47, &48, &49, &4A, _
    &4B, &4C, &4D, &4E, &4F, &50, &51, &52, &53, &54, &55, &56, &57, &58, &59, _
    &5A, &61, &62, &63, &64, &65, &66, &67, &68, &69, &6A, &6B, &6C, &6D, &6E, _
    &6F, &70, &71, &72, &73, &74, &75, &76, &77, &78, &79, &7A, &30, &31, &32, _
    &33, &34, &35, &36, &37, &38, &39, &2B, &2F, &00, &5A, &8B, &5D, &08, &8B, _
    &7D, &10, &8B, &4D, &0C, &E9, &8F, &00, &00, &00, &0F, &B6, &33, &C1, &EE, _
    &02, &01, &D6, &8A, &06, &88, &07, &31, &C0, &83, &F9, &01, &76, &0C, &0F, _
    &B6, &43, &01, &25, &F0, &00, &00, &00, &C1, &E8, &04, &0F, &B6, &33, &83, _
    &E6, &03, &C1, &E6, &04, &09, &C6, &01, &D6, &8A, &06, &88, &47, &01, &83, _
    &F9, &01, &76, &21, &0F, &B6, &43, &02, &25, &C0, &00, &00, &00, &C1, &E8, _
    &06, &0F, &B6, &73, &01, &83, &E6, &0F, &C1, &E6, &02, &09, &C6, &01, &D6, _
    &8A, &06, &88, &47, &02, &EB, &04, &C6, &47, &02, &3D, &83, &F9, &02, &76, _
    &10, &0F, &B6, &73, &02, &83, &E6, &3F, &01, &D6, &8A, &06, &88, &47, &03, _
    &EB, &04, &C6, &47, &03, &3D, &8D, &5B, &03, &8D, &7F, &04, &83, &E9, &03, _
    &83, &6D, &FC, &04, &75, &0C, &8B, &45, &14, &89, &45, &FC, &66, &B8, &0D, _
    &0A, &66, &AB, &85, &C9, &0F, &8F, &69, &FF, &FF, &FF, &C6, &07, &00, &5F, _
    &5E, &5B, &C9, &C2, &10, &00]
    CallWindowProc(B64E[0]@, s_Texto[0]@, c_Long,d_Salida[0]@,SalidaSize)
    Devolver CadenaDePtrCad(d_Salida[0]@)
  SiNo
  Redim d_Salida,c_Long - 1
  Redim B64D, 275
  B64D = [&C8, &10, &00, &00, &53, &56, &57, &83, &65, _
    &F8, &00, &E8, &50, &00, &00, &00, &3E, &FF, &FF, &FF, &3F, &34, &35, &36, _
    &37, &38, &39, &3A, &3B, &3C, &3D, &FF, &FF, &FF, &00, &FF, &FF, &FF, &00, _
    &01, &02, &03, &04, &05, &06, &07, &08, &09, &0A, &0B, &0C, &0D, &0E, &0F, _
    &10, &11, &12, &13, &14, &15, &16, &17, &18, &19, &FF, &FF, &FF, &FF, &FF, _
    &FF, &1A, &1B, &1C, &1D, &1E, &1F, &20, &21, &22, &23, &24, &25, &26, &27, _
    &28, &29, &2A, &2B, &2C, &2D, &2E, &2F, &30, &31, &32, &33, &8F, &45, &F0, _
    &8B, &7D, &0C, &8B, &5D, &08, &31, &D2, &E9, &91, &00, &00, &00, &83, &65, _
    &FC, &00, &83, &7D, &FC, &04, &7D, &54, &8A, &03, &43, &84, &C0, &75, &03, _
    &83, &EA, &03, &3C, &3D, &75, &09, &4A, &80, &3B, &3D, &75, &01, &4A, &B0, _
    &00, &84, &C0, &75, &1A, &83, &7D, &FC, &04, &7D, &0D, &8B, &75, &FC, &C6, _
    &44, &35, &F4, &00, &FF, &45, &FC, &EB, &ED, &6A, &01, &8F, &45, &F8, &EB, _
    &1F, &3C, &2B, &72, &19, &3C, &7A, &77, &15, &0F, &B6, &F0, &83, &EE, &2B, _
    &03, &75, &F0, &8A, &06, &8B, &75, &FC, &88, &44, &35, &F4, &FF, &45, &FC, _
    &EB, &A6, &8D, &75, &F4, &66, &8B, &06, &C0, &E0, &02, &C0, &EC, &04, &08, _
    &E0, &88, &07, &66, &8B, &46, &01, &C0, &E0, &04, &C0, &EC, &02, &08, &E0, _
    &88, &47, &01, &8A, &46, &02, &C0, &E0, &06, &24, &C0, &0A, &46, &03, &88, _
    &47, &02, &8D, &7F, &03, &8D, &52, &03, &83, &7D, &F8, &00, &0F, &84, &65, _
    &FF, &FF, &FF, &89, &D0, &5F, &5E, &5B, &C9, &C2, &10, &00]
    CallWindowProc(B64D[0]@, s_Texto[0]@,d_Salida[0]@,0,0)
    Devolver CadenaDePtrCad(d_Salida[0]@)
  FinSi
FinProc


Proc RC4(Referencia Texto, Password:Cadena,Opcional Estado:Booleano = Verd):Cadena
Var Matriz[],CadByte[]:Byte
CadByte = MatrizByteDeCadena(Texto)
Si Estado
ReDim Matriz,266
Matriz = [&C8,&10,&01,&00,&6A,&00,&6A,&00,&53,&56,&57,&8B,&55,&10,&31,_
            &C9,&89,&C8,&49,&89,&D7,&F2,&AE,&48,&48,&29,&C8,&89,&45,&F0,_
            &85,&C0,&0F,&84,&DC,&00,&00,&00,&B9,&00,&01,&00,&00,&88,&C8,_
            &2C,&01,&88,&84,&0D,&EF,&FE,&FF,&FF,&E2,&F3,&83,&65,&F4,&00,_
            &83,&65,&FC,&00,&81,&7D,&FC,&00,&01,&00,&00,&7D,&47,&8B,&45,_
            &FC,&31,&D2,&F7,&75,&F0,&92,&03,&45,&10,&0F,&B6,&00,&8B,&4D,_
            &FC,&0F,&B6,&8C,&0D,&F0,&FE,&FF,&FF,&01,&C8,&03,&45,&F4,&25,_
            &FF,&00,&00,&00,&89,&45,&F4,&8B,&75,&FC,&8A,&84,&35,&F0,&FE,_
            &FF,&FF,&8B,&7D,&F4,&86,&84,&3D,&F0,&FE,&FF,&FF,&88,&84,&35,_
            &F0,&FE,&FF,&FF,&FF,&45,&FC,&EB,&B0,&8D,&9D,&F0,&FE,&FF,&FF,_
            &31,&FF,&89,&FA,&39,&55,&0C,&76,&63,&8B,&85,&EC,&FE,&FF,&FF,_
            &40,&25,&FF,&00,&00,&00,&89,&85,&EC,&FE,&FF,&FF,&89,&D8,&03,_
            &85,&EC,&FE,&FF,&FF,&0F,&B6,&00,&03,&85,&E8,&FE,&FF,&FF,&25,_
            &FF,&00,&00,&00,&89,&85,&E8,&FE,&FF,&FF,&89,&DE,&03,&B5,&EC,_
            &FE,&FF,&FF,&8A,&06,&89,&DF,&03,&BD,&E8,&FE,&FF,&FF,&86,&07,_
            &88,&06,&0F,&B6,&0E,&0F,&B6,&07,&01,&C1,&81,&E1,&FF,&00,&00,_
            &00,&8A,&84,&0D,&F0,&FE,&FF,&FF,&8B,&75,&08,&01,&D6,&30,&06,_
            &42,&EB,&98,&5F,&5E,&5B,&C9,&C2,&10,&00]
            CallWindowProc(Matriz[0]@,CadByte[0]@,CadLong(Texto),Password@,0)
            Devolver CadenaDePtrCad(CadByte[0]@)
SiNo
ReDim Matriz,266
Matriz = [&C8,&10,&01,&00,&6A,&00,&6A,&00,&53,&56,&57,&8B,&55,&10,&31,_
            &C9,&89,&C8,&49,&89,&D7,&F2,&AE,&48,&48,&29,&C8,&89,&45,&F0,_
            &85,&C0,&0F,&84,&DC,&00,&00,&00,&B9,&00,&01,&00,&00,&88,&C8,_
            &2C,&01,&88,&84,&0D,&EF,&FE,&FF,&FF,&E2,&F3,&83,&65,&F4,&00,_
            &83,&65,&FC,&00,&81,&7D,&FC,&00,&01,&00,&00,&7D,&47,&8B,&45,_
            &FC,&31,&D2,&F7,&75,&F0,&92,&03,&45,&10,&0F,&B6,&00,&8B,&4D,_
            &FC,&0F,&B6,&8C,&0D,&F0,&FE,&FF,&FF,&01,&C8,&03,&45,&F4,&25,_
            &FF,&00,&00,&00,&89,&45,&F4,&8B,&75,&FC,&8A,&84,&35,&F0,&FE,_
            &FF,&FF,&8B,&7D,&F4,&86,&84,&3D,&F0,&FE,&FF,&FF,&88,&84,&35,_
            &F0,&FE,&FF,&FF,&FF,&45,&FC,&EB,&B0,&8D,&9D,&F0,&FE,&FF,&FF,_
            &31,&FF,&89,&FA,&39,&55,&0C,&76,&63,&8B,&85,&EC,&FE,&FF,&FF,_
            &40,&25,&FF,&00,&00,&00,&89,&85,&EC,&FE,&FF,&FF,&89,&D8,&03,_
            &85,&EC,&FE,&FF,&FF,&0F,&B6,&00,&03,&85,&E8,&FE,&FF,&FF,&25,_
            &FF,&00,&00,&00,&89,&85,&E8,&FE,&FF,&FF,&89,&DE,&03,&B5,&EC,_
            &FE,&FF,&FF,&8A,&06,&89,&DF,&03,&BD,&E8,&FE,&FF,&FF,&86,&07,_
            &88,&06,&0F,&B6,&0E,&0F,&B6,&07,&01,&C1,&81,&E1,&FF,&00,&00,_
            &00,&8A,&84,&0D,&F0,&FE,&FF,&FF,&8B,&75,&08,&01,&D6,&30,&06,_
            &42,&EB,&98,&5F,&5E,&5B,&C9,&C2,&10,&00]
            CallWindowProc(Matriz[0]@,CadByte[0]@,CadLong(Texto),Password@,0)
            Devolver CadenaDePtrCad(CadByte[0]@)
FinSi
FinProc

' Rellena con caracteres Nulos una cadena.
Proc Espacio(Longitud:Entero):Cadena
Devolver RepCarac(0,Longitud)
FinProc


Proc EsDecimal(Referencia PalabraA:Cadena):Booleano ' VERIFICAR
Var i:Entero
Var a,nums:Cadena
nums = "123456789."
Resultado = Verd
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc


Proc EsAlfanumerico(Referencia PalabraA:Cadena):Booleano
Var i:Entero
Var nums,a:Cadena
nums = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
Resultado = Verd
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc


Proc EsMinusculas(Referencia PalabraA:Cadena):Booleano
Var i:Entero
Var nums,a:Cadena
nums = "abcdefghijklmnopqrstuvwxyz"
Resultado = Verd
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc


Proc EsMayusculas(Referencia PalabraA:Cadena):Booleano
Var i:Entero
Var nums,a:Cadena
nums = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Resultado = Verd
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc


Proc EsCadena(Referencia PalabraA:Cadena):Booleano
Var i:Entero
Var nums,a:Cadena
nums = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Resultado = Verd
Contar i = 1 a CadLong(PalabraA)
   a = ParteCad(PalabraA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc


Proc EsNumero(Referencia NumeroA:Cadena):Booleano
Var i:Entero
Var nums,a:Cadena
nums = "0123456789"
Resultado = Verd
Contar i = 1 a CadLong(NumeroA)
   a = ParteCad(NumeroA,i,1)
      Si LetraExiste(Nums,a) = 0 Entonces
         Resultado = Falso
         Salir Contar
      FinSi
Seguir
FinProc

'Proc Posicion(CadenaA,CaracterA:Cadena):Booleano
'Var A:Entero,B:Cadena,Final:Booleano
'Final = 0
'Contar A = 1 a CadLong(CadenaA)
'   b = ParteCad(CadenaA,A,1)
'      Si b = CaracterA Entonces
'         Final = A
'         Salir Contar
'      FiNSi
'Seguir
'   Devolver Final
'FinProc

' Verifica si una letra existe dentro de una cadena.
Proc LetraExiste(Referencia CadenaA,Caracter:Cadena):Booleano
Var Letra_A:Cadena,Longitud_A,Valor_A:Entero
Longitud_A = CadLong(CadenaA)
Resultado = Falso
Contar Valor_A = 1 a Longitud_A
   Letra_A = ParteCad(CadenaA,Valor_A,1)
   Si Letra_A = Caracter
      Resultado = Verd ; Salir Contar
   FinSi
Seguir
FinProc

' Invierte una cadena.
Proc InvertirCad(Referencia Cadenilla:Cadena):Cadena
Var Longitudes,EsteNumero:Entero,TextoDevuelto,Letrita:Cadena
   Contar EsteNumero = CadLong(Cadenilla) a 1 Dec
      Letrita = ParteCad(Cadenilla,EsteNumero,1)
      TextoDevuelto = TextoDevuelto + Letrita
   Seguir
Devolver TextoDevuelto
FinProc

Proc InvertirEnt(Número:Entero):Entero
Var Longitudes,EsteNumero:Entero,TextoDevuelto,Letrita,Cadenilla:Cadena
Cadenilla = EntCad(Número)
   Contar EsteNumero = CadLong(Cadenilla) a 1 Dec
      Letrita = ParteCad(Cadenilla,EsteNumero,1)
      TextoDevuelto = TextoDevuelto + Letrita
   Seguir
Devolver CadEnt(TextoDevuelto)
FinProc


Proc CadPtr(Referencia lpStr:Cadena):Entero
  Var @Dir:Entero
  Dir@=lpStr@
  Resultado=Dir
FinProc


Proc CadLong(Referencia lpStr:Cadena):Entero
  Var @Ptr,Ret:Entero
  Ret=CadPtr(lpStr)
  Si (Ret=0) Salir
  Ptr@=Ret-4
  Resultado=Ptr
FinProc

Proc EntLong(Referencia lpStr:Entero):Entero
Var Matriz[]:Entero
Matriz = RepartirEnt(lpStr)
Devolver LongMat(Matriz)
FinProc

Proc CadLongAlt(Referencia lpStr:Cadena):Entero
Var Matriz[]:Cadena
Matriz = RepartirCad(lpStr)
Devolver LongMat(Matriz)
FinProc

Proc CadMayus(Referencia lpStr:Cadena):Cadena
  CharUpperBuff(lpStr,CadLong(lpStr))
  Resultado=lpStr
FinProc


Proc CadMinus(Referencia lpStr:Cadena):Cadena
  CharLowerBuff(lpStr,CadLong(lpStr))
  Resultado=lpStr
FinProc


Proc Carac(Referencia bByte:Byte):Cadena
  Var Temp:Cadena, @Ptr:Byte
  Temp="c"
  Ptr@=CadPtr(Temp)
  Ptr=bByte
  Resultado=Temp
FinProc


Proc RepCarac(bByte:Byte,dwRep:Entero):Cadena
  Var Rep:Cadena, i:Entero
  Rep=Carac(bByte)
  Contar i = 1 a dwRep
    Resultado=Resultado + Rep
  Seguir
FinProc


Proc CadEnt(Referencia lpStr:Cadena):EnteroSig
  Var Temp:Cadena, LenCad:Entero, Num:EnteroSig
  LenCad=CadLong(lpStr)
  Temp=RepCarac(0,(LenCad+1)*2)
  MultiByteToWideChar(0,0,lpStr,LenCad,Temp,LenCad*2)
  Si (VarI4FromStr(Temp,0,0,Num)) GenerarError errTipoIncompatible
  Resultado=Num
FinProc


Proc EntCad(lNum:EnteroSig):Cadena
  Var Temp,Res:Cadena, LenCad:Entero
  $CED-
  'la funci$F3n EntStr requiere un puntero a la variable de cadena, no a la
  'cadena en así, por eso deshabilitamos el modificador $CED
  VarBstrFromI4(lNum,0,0,Temp)
  $CED  'lo rehabilitamos
  LenCad=CadLong(Temp)\2
  Res=RepCarac(32,LenCad)
  WideCharToMultiByte(0,0,Temp,-1,Res,LenCad,Nulo,Nulo)
  Resultado=Res
FinProc


Proc CadReal(Referencia lpStr:Cadena):Real
  Var Temp:Cadena, LenCad:Entero, Num:Real
  LenCad=CadLong(lpStr)
  Temp=RepCarac(0,(LenCad+1)*2)
  MultiByteToWideChar(0,0,lpStr,LenCad,Temp,LenCad*2)
  Si (VarR8FromStr(Temp,0,0,Num)) GenerarError errTipoIncompatible
  Resultado=Num
FinProc


Proc RealCad(lNum:Real):Cadena
  Var Temp,Res:Cadena, LenCad:Entero
  $CED-
  'la funci$F3n EntStr requiere un puntero a la variable de cadena, no a la
  'cadena en así, por eso deshabilitamos el modificador $CED
  VarBstrFromR8(lNum,0,0,Temp)
  $CED  'lo rehabilitamos
  LenCad=CadLong(Temp)\2
  Res=RepCarac(32,LenCad)
  WideCharToMultiByte(0,0,Temp,-1,Res,LenCad,Nulo,Nulo)
  Resultado=Res
FinProc


Proc EntHex(lNum:Entero,Opcional FillWithZero:Booleano):Cadena
  Var Digit,i:Byte
  Contar i=1 a 8
    Si (lNum=0) And (FillWithZero=Falso) Salir
    Digit=lNum And &0F
    Resultado=Carac(>Digit<10?Digit+48:Digit+55)+Resultado
    lNum=lNum shr 4
  Seguir
FinProc


Proc ParteCad(Referencia Texto:Cadena, Comienzo:EnteroSig, Opcional Longit:EnteroSig=-1):Cadena
  Var Temp:Cadena, LenTxt:EnteroSig
  Si (Comienzo<1) Or (Longit<(-1)) GenerarError errParamInv
  LenTxt=CadLong(Texto)
  Si (LenTxt=0) GenerarError errParamInv
  Si (Longit=-1) Longit=LenTxt-Comienzo+1
  Si (Comienzo+Longit-1>LenTxt) Or (Comienzo>LenTxt) GenerarError errParamInv
  Temp=RepCarac(0,Longit)
  CopyMemory(CadPtr(Temp),CadPtr(Texto)+Comienzo-1,Longit)
  Resultado=Temp
FinProc

Proc ParteEnt(Referencia Texto:Entero, Comienzo:EnteroSig, Opcional Longit:EnteroSig=-1):Entero
Var TXT:Cadena
TXT = EntCad(Texto)
Devolver CadEnt(ParteCad(TXT,Comienzo,Longit))
FinProc

Proc IzquierdaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Si (CadLong(Texto)<=Longit) Devolver Texto
  Resultado=ParteCad(Texto,1,Longit)
FinProc

Proc IzquierdaEnt(Referencia Texto:Entero,Longit:EnteroSig):Entero
Var TXT:Cadena
TXT = EntCad(Texto)
Devolver CadEnt(IzquierdaCad(TXT,Longit))
FinProc

Proc DerechaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Var LenTxt:Entero
  LenTxt=CadLong(Texto)
  Si (LenTxt<=Longit) Devolver Texto
  Resultado=ParteCad(Texto,LenTxt-Longit+1,Longit)
FinProc

Proc DerechaEnt(Referencia Texto:Entero,Longit:EnteroSig):Entero
Var TXT:Cadena
TXT = EntCad(Texto)
Devolver CadEnt(DerechaCad(TXT,Longit))
FinProc

Proc CadenaDeMatrizByte(Referencia ByteAry[]:Byte):Cadena
  Var Temp:Cadena, LenTxt:EnteroSig
  LenTxt=LongMat(ByteAry)
  Si LenTxt<1 Salir
  Temp=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Temp),ByteAry@,LenTxt)
  Resultado=Temp
FinProc


Proc CadenaDePtrCad(Referencia PtrCad:Entero):Cadena
  Var Temp:Cadena, LenTxt:EnteroSig
  LenTxt=lstrlenptr(PtrCad)
  Si LenTxt<1 Salir
  Temp=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Temp),PtrCad,LenTxt)
  Resultado=Temp
FinProc


Proc Ascii(Referencia lpStr:Cadena):Byte
  Var i:Entero,@Ret:Byte
  Si (CadLong(lpStr))
    Ret@=CadPtr(lpStr)
    Resultado=Ret
  FinSi
FinProc


Proc BuscarEnCad(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,LongMatch,TotLng:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=1
  Contar i = dwPos a TotLng
    Si (ParteCad(lpStr,i,LongMatch)=lpMatch) Devolver i
  Seguir
FinProc

Proc BuscarEnEnt(Referencia lpStr,lpMatch:Entero,Opcional dwPos:Entero):Entero
Var TXT_A,TXT_B:Cadena
TXT_A = EntCad(lpStr)
TXT_B = EntCad(lpMatch)
Devolver BuscarEnCad(TXT_A,TXT_B,dwPos)
FinProc

Proc BuscarEnCadInv(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,LongMatch,TotLng:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=TotLng
  Contar i = dwPos a 1 Dec
    Si (ParteCad(lpStr,i,LongMatch)=lpMatch) Devolver i
  Seguir
FinProc

Proc BuscarEnEntInv(Referencia lpStr,lpMatch:Entero,Opcional dwPos:Entero):Entero
Var TXT_A,TXT_B:Cadena
TXT_A = EntCad(lpStr)
TXT_B = EntCad(lpMatch)
Devolver BuscarEnCadInv(TXT_A,TXT_B,dwPos)
FinProc


Proc TruncarCadena(Referencia lpStr:Cadena):Cadena
  Var Pos:Entero,lpStrA,A:Cadena
  lpStrA = lpStr
  A = Null
  Pos=BuscarEnCad(lpStrA,A)
  Si (Pos=0) Devolver lpStr
  Si (Pos=1) Salir
  Resultado=IzquierdaCad(lpStr,Pos-1)
FinProc


Proc Reemplazar(Referencia Str,Match,Rep:Cadena, Opcional Pos:EnteroSig):Cadena
  Var i,LongMatch,CL,TotLng:Entero
  LongMatch=CadLong(Match)
  Si (LongMatch=0) GenerarError errParamInv
  CL=CadLong(Str)
  Si (CL=0) Salir
  TotLng=CL-LongMatch+1
  Si (Pos>TotLng) GenerarError errParamInv
  Si (Pos=0) Pos=1
  Contar i = 1 a CL
    Si ((i>=Pos) And (i<=TotLng) And (ParteCad(Str,i,LongMatch)=Match))
      Resultado=Resultado+Rep
      i=i+LongMatch-1
    SiNo
      Resultado=Resultado+ParteCad(Str,i,1)
    FinSi
  Seguir
FinProc


Proc Separar(Referencia Texto,Sep:Cadena, Opcional PosInicio:Entero=1, Opcional MaxRet:Entero):Cadena[]
  Var Pos,Ret,Mx,SepLen,TxtLen:Entero
  SepLen = CadLong(Sep)
  Si (SepLen = 0) GenerarError errParamInv
  TxtLen = CadLong(Texto)
  Borrar Resultado
  Repetir
    Ret = BuscarEnCad(Texto,Sep,Pos+1)
    Si (Ret=0) Salir Repetir
    Redim Preservar Resultado, Mx + 1
    Resultado[Mx] = ParteCad(Texto,Pos+1,Ret-Pos-1)
    Pos = Ret + SepLen - 1
    Mx = Mx + 1
    Si (MaxRet) Si (Mx = MaxRet) Salir Repetir
    Si (Pos>=TxtLen) Salir Repetir
  PorSiempre
  Redim Preservar Resultado, Mx + 1
  Resultado[Mx] = > (Pos>=TxtLen) ? ("") : (ParteCad(Texto,Pos+1))
FinProc



Clase pscCadenas, _
  Buff[]:PSCCADENASINFO, _
  MaxBuff,iHwnd:Entero

Público:
  ClaseVar Eventos:PSCCADENAS_EVENTINFO

Privado:
  Proc evCambiar()
    Si (Eventos.AlCambiar@) Eventos.AlCambiar(hWnd,0)
  FinProc
  Proc evAdd(Pos:EnteroSig)
    Si (Eventos.AlAgregar@) Eventos.AlAgregar(hWnd,Pos)
  FinProc
  Proc evDel(Pos:EnteroSig)
    Si (Eventos.AlQuitar@) Eventos.AlQuitar(hWnd,Pos)
  FinProc
  Proc EsValido(Indice:Entero)
    Si (Indice>=MaxBuff) GenerarError errParamInv
  FinProc
  Proc GetItem(Indice:Entero):Cadena
    EsValido(Indice)
    Resultado=Buff[Indice].Texto
  FinProc
  Proc SetItem(Valor:Cadena, Indice:Entero)
    EsValido(Indice)
    Buff[Indice].Texto=Valor
    evCambiar()
  FinProc
  Proc GetDato(Indice:Entero):EnteroSig
    EsValido(Indice)
    Resultado=Buff[Indice].Dato
  FinProc
  Proc SetDato(Valor:EnteroSig, Indice:Entero)
    EsValido(Indice)
    Buff[Indice].Dato=Valor
  FinProc
  Proc GetCantidad:Entero
    Resultado=MaxBuff
  FinProc
Público:
  Prop hWnd:Entero
    Lec:iHwnd
    Esc:iHwnd
  FinProp
  Prop Cantidad:Entero
    Lec:GetCantidad
  FinProp
  Prop Item:Cadena
    Lec:GetItem
    Esc:SetItem
  FinProp
  Prop Dato:EnteroSig
    Lec:GetDato
    Esc:SetDato
  FinProp
  Proc Agregar(Texto:Cadena)
    MaxBuff=MaxBuff+1
    Redim Preservar Buff,MaxBuff
    Buff[MaxBuff-1].Texto=Texto
    evAdd(MaxBuff-1)
  FinProc
  Proc Insertar(Texto:Cadena, Indice:Entero)
    Var i:Entero
    EsValido(Indice)
    Agregar("")
    Contar i=Indice+1 a MaxBuff
      Buff[i]=Buff[i-1]
    Seguir
    Buff[Indice].Texto=Texto
    evAdd(Indice)
  FinProc
  Proc Eliminar(Indice:Entero)
    Var i:Entero
    EsValido(Indice)
    MaxBuff=MaxBuff-1
    Contar i=Indice+1 a MaxBuff
      Buff[i-1]=Buff[i]
    Seguir
    Redim Preservar Buff,MaxBuff
    evDel(Indice)
  FinProc
FinClase


¡Saludos!
Imagen
PowerDeath
 
Mensajes: 160
Registrado: Sab Ago 11, 2012 5:29 am

Sponsor


Volver a Librerias

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado

cron