* [Source] HexAndStringt (Version Very-Faster)

Iniciado por BlackZeroX, 7 Enero 2010, 01:15 AM

0 Miembros y 1 Visitante están viendo este tema.

BlackZeroX

No se que hacer mas me he puesto a mejorar códigos así que pongo esta función es una función realmente rápida a comparación a las que se encuentran en google, así que pueden Encryptar y/o descifrar miles de MEGAS sin perder velocidad ya que los códigos que se encuentran en google pierden velocidad de descifrado en el acto.

Código (vb) [Seleccionar]


'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum ActionsHexStr
    HexToString = 0
    StringToHex
End Enum
Public Function HexAndString(ByVal vData As String, Optional Accion As ActionsHexStr = HexToString) As String
Dim LenBuffer               As Long
Dim LenOfBuffer             As Integer
Dim Puntero                 As Long
Dim I                       As Long
Dim vStep                   As Integer
    If CBool(IIf(Accion = HexToString And (Len(vData) Mod 2) = 0, True, IIf(Accion = StringToHex, True, False))) Then
        LenBuffer = IIf(Accion = HexToString, Len(vData) / 2, Len(vData) * 2)
        LenOfBuffer = IIf(Accion = HexToString, 1, 2)
        HexAndString = Space(LenBuffer)
        vStep = IIf(Accion = HexToString, 2, 1)
        Puntero = 1
        For I = 1 To Len(vData) Step vStep
            If Accion = HexToString Then
                Mid(HexAndString, Puntero, LenOfBuffer) = Chr$(Val("&H" & Mid$(vData, I, 2)))
                Puntero = Puntero + 1
            Else
                Mid(HexAndString, Puntero, LenOfBuffer) = Hex$(Asc(Mid$(vData, I, 1)))
                Puntero = Puntero + 2
            End If
        Next I
    End If
End Function



P.D.: Estoy aburrido me ire a jugar basketball nos vemos!¡.

Dulces Lunas!¡
The Dark Shadow is my passion.


xmbeat92

#2
Cita de: BlackZeroX▓▓▒▒░░ en  7 Enero 2010, 01:15 AM
No se que hacer mas me he puesto a mejorar códigos así que pongo esta función es una función realmente rápida a comparación a las que se encuentran en google,  [blink]así que pueden Encryptar y/o descifrar miles de MEGAS sin perder velocidad ya que los códigos que se encuentran en google pierden velocidad de descifrado en el acto. [/blink]

Código (vb) [Seleccionar]


'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum ActionsHexStr
   HexToString = 0
   StringToHex
End Enum
Public Function HexAndString(ByVal vData As String, Optional Accion As ActionsHexStr = HexToString) As String
Dim LenBuffer               As Long
Dim LenOfBuffer             As Integer
Dim Puntero                 As Long
Dim I                       As Long
Dim vStep                   As Integer
   If CBool(IIf(Accion = HexToString And (Len(vData) Mod 2) = 0, True, IIf(Accion = StringToHex, True, False))) Then
       LenBuffer = IIf(Accion = HexToString, Len(vData) / 2, Len(vData) * 2)
       LenOfBuffer = IIf(Accion = HexToString, 1, 2)
       HexAndString = Space(LenBuffer)
       vStep = IIf(Accion = HexToString, 2, 1)
       Puntero = 1
       For I = 1 To Len(vData) Step vStep
           If Accion = HexToString Then
               Mid(HexAndString, Puntero, LenOfBuffer) = Chr$(Val("&H" & Mid$(vData, I, 2)))
               Puntero = Puntero + 1
           Else
               Mid(HexAndString, Puntero, LenOfBuffer) = Hex$(Asc(Mid$(vData, I, 1)))
               Puntero = Puntero + 2
           End If
       Next I
   End If
End Function



P.D.: Estoy aburrido me ire a jugar basketball nos vemos!¡.

Dulces Lunas!¡


El Code esta bueno para lo que es...
pero si de cifrar/descifrar yo uso esta funcion:

Private Function cifrar(ByVal Cadena As String, _
                       ByVal Pass As String, Mode As Boolean) As String
Dim LC As Long
Dim LP As Long
Dim I As Long
Dim E As Long
Dim A As String
Dim B As String
Dim NewAscii As Byte
Dim S As Integer
LC = Len(Cadena)
LP = Len(Pass)

For I = 1 To LC
   E = E + 1
   A = Mid(Cadena, I, 1)
   
   If E > LP Then E = 1
   
   B = Mid(Pass, E, 1)
   
   If Mode Then
       S = Asc(A) + Asc(B)
       NewAscii = IIf(S > 255, S - Asc(B), S)
   Else
       S = Asc(A) - Asc(B)
       NewAscii = IIf(S < 0, S + Asc(B), S)
   End If
   cifrar = cifrar & Chr(NewAscii)
Next

End Function


ya que el resultado dependera de la contraseña, lo que la hace mas dificil de que alguien ajeno robe la informacion. la misma la tome de alguna pagina de internet que no recuerdo y tampoco tenia dicha funcion, es por eso que puede que no coincidan con la funcion original del autor
El hombre encuentra a Dios detrás de cada puerta que la ciencia logra abrir. -Einstein

BlackZeroX

#3
Cita de: xmbeat92 en  9 Febrero 2010, 02:11 AM

El Code esta bueno para lo que es...
pero si de cifrar/descifrar yo uso esta funcion:

Private Function cifrar(ByVal Cadena As String, _
                       ByVal Pass As String, Mode As Boolean) As String
Dim LC As Long
Dim LP As Long
Dim I As Long
Dim E As Long
Dim A As String
Dim B As String
Dim NewAscii As Byte
Dim S As Integer
LC = Len(Cadena)
LP = Len(Pass)

For I = 1 To LC
   E = E + 1
   A = Mid(Cadena, I, 1)
   
   If E > LP Then E = 1
   
   B = Mid(Pass, E, 1)
   
   If Mode Then
       S = Asc(A) + Asc(B)
       NewAscii = IIf(S > 255, S - Asc(B), S)
   Else
       S = Asc(A) - Asc(B)
       NewAscii = IIf(S < 0, S + Asc(B), S)
   End If
   cifrar = cifrar & Chr(NewAscii)
Next

End Function


ya que el resultado dependera de la contraseña, lo que la hace mas dificil de que alguien ajeno robe la informacion. la misma la tome de alguna pagina de internet que no recuerdo y tampoco tenia dicha funcion, es por eso que puede que no coincidan con la funcion original del autor

mmmm este es el mio ¬¬" y es mas rápido que el tuyo en consideración a cadenas de texto Largas

http://foro.elhacker.net/programacion_vb/source_encoder_and_decode_algoritmo_simple-t277003.0.html

Sangrientas Lunas!¡.
.
The Dark Shadow is my passion.

xmbeat92

En eso tienes toda la razon, en cuanto a seguridad creo que no
El hombre encuentra a Dios detrás de cada puerta que la ciencia logra abrir. -Einstein

BlackZeroX

Cita de: xmbeat92 en 11 Febrero 2010, 01:03 AM
En eso tienes toda la razon, en cuanto a seguridad creo que no

deja de hablar por hablar por que los textos salientes de ambos algoritmos tienen esatamente la misma seguridad es decir es Crackeadle niño ¬¬"

mmmta madre este habla como si deberás lo hubiese probado y comparado ¬¬"
The Dark Shadow is my passion.

xmbeat92

tranquilo wey que no es para que te molestes!!

:-X
es mas, si te hace sentir bien retiro lo dicho, no vengo a pelear, uno viene aprender, ojalá sepas entender
El hombre encuentra a Dios detrás de cada puerta que la ciencia logra abrir. -Einstein

BlackZeroX

tengo un carácter algo raro ¬¬"

P.D.: No me weyee's
The Dark Shadow is my passion.