elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Ayuda para crear encriptador de texto a base64 en vb6.0
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Ayuda para crear encriptador de texto a base64 en vb6.0  (Leído 5,965 veces)
Anonx

Desconectado Desconectado

Mensajes: 21



Ver Perfil
Ayuda para crear encriptador de texto a base64 en vb6.0
« en: 25 Diciembre 2012, 01:39 am »

hola a todos, estoy creando un proyecto que tenga varios encriptadores, como binario, hex...  y en mi caso necesito saber como poner para que escribas en el form algo en el textbox y pulsar en cifrar a base64 y se encripte, gracias


En línea

Be Happy! :rolleyes:
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: Ayuda para crear encriptador de texto a base64 en vb6.0
« Respuesta #1 en: 27 Diciembre 2012, 02:46 am »

Hola te paso de dos forma la primera un modulo clase llamado Base64Class y la segunda al estilo vbscript.

Base64Class
Código
  1. Option Explicit
  2.  
  3. Private Const Equals As Byte = 61    'Asc("=")
  4.  
  5. Private Const Mask1 As Byte = 3      '00000011
  6. Private Const Mask2 As Byte = 15     '00001111
  7. Private Const Mask3 As Byte = 63     '00111111
  8. Private Const Mask4 As Byte = 192    '11000000
  9. Private Const Mask5 As Byte = 240    '11110000
  10. Private Const Mask6 As Byte = 252    '11111100
  11.  
  12. Private Const Shift2 As Byte = 4
  13. Private Const Shift4 As Byte = 16
  14. Private Const Shift6 As Byte = 64
  15.  
  16. Private Base64Lookup() As Byte
  17. Private Base64Reverse() As Byte
  18.  
  19. Public Function EncodeString(Text As String) As String
  20.  
  21.   Dim Data() As Byte
  22.  
  23.   Data = StrConv(Text, vbFromUnicode)
  24.   EncodeString = EncodeByteArray(Data)
  25.  
  26. End Function
  27.  
  28. Public Function EncodeByteArray(Data() As Byte) As String
  29.  
  30.   Dim EncodedData() As Byte
  31.  
  32.   Dim DataLength As Long
  33.   Dim EncodedLength As Long
  34.  
  35.   Dim Data0 As Long
  36.   Dim Data1 As Long
  37.   Dim Data2 As Long
  38.  
  39.   Dim l As Long
  40.   Dim m As Long
  41.  
  42.   Dim Index As Long
  43.  
  44.   Dim CharCount As Long
  45.  
  46.   DataLength = UBound(Data) + 1
  47.  
  48.   EncodedLength = (DataLength \ 3) * 4
  49.   If DataLength Mod 3 > 0 Then EncodedLength = EncodedLength + 4
  50.   EncodedLength = EncodedLength + ((EncodedLength \ 76) * 2)
  51.   If EncodedLength Mod 78 = 0 Then EncodedLength = EncodedLength - 2
  52.   ReDim EncodedData(EncodedLength - 1)
  53.  
  54.   m = (DataLength) Mod 3
  55.  
  56.   For l = 0 To UBound(Data) - m Step 3
  57.      Data0 = Data(l)
  58.      Data1 = Data(l + 1)
  59.      Data2 = Data(l + 2)
  60.      EncodedData(Index) = Base64Lookup(Data0 \ Shift2)
  61.      EncodedData(Index + 1) = Base64Lookup(((Data0 And Mask1) * Shift4) Or (Data1 \ Shift4))
  62.      EncodedData(Index + 2) = Base64Lookup(((Data1 And Mask2) * Shift2) Or (Data2 \ Shift6))
  63.      EncodedData(Index + 3) = Base64Lookup(Data2 And Mask3)
  64.      Index = Index + 4
  65.      CharCount = CharCount + 4
  66.  
  67.      If CharCount = 76 And Index < EncodedLength Then
  68.         EncodedData(Index) = 13
  69.         EncodedData(Index + 1) = 10
  70.         CharCount = 0
  71.         Index = Index + 2
  72.      End If
  73.   Next
  74.  
  75.   If m = 1 Then
  76.      Data0 = Data(l)
  77.      EncodedData(Index) = Base64Lookup((Data0 \ Shift2))
  78.      EncodedData(Index + 1) = Base64Lookup((Data0 And Mask1) * Shift4)
  79.      EncodedData(Index + 2) = Equals
  80.      EncodedData(Index + 3) = Equals
  81.      Index = Index + 4
  82.   ElseIf m = 2 Then
  83.      Data0 = Data(l)
  84.      Data1 = Data(l + 1)
  85.      EncodedData(Index) = Base64Lookup((Data0 \ Shift2))
  86.      EncodedData(Index + 1) = Base64Lookup(((Data0 And Mask1) * Shift4) Or (Data1 \ Shift4))
  87.      EncodedData(Index + 2) = Base64Lookup((Data1 And Mask2) * Shift2)
  88.      EncodedData(Index + 3) = Equals
  89.      Index = Index + 4
  90.   End If
  91.  
  92.   EncodeByteArray = StrConv(EncodedData, vbUnicode)
  93.  
  94. End Function
  95.  
  96. Public Function DecodeToString(EncodedText As String) As String
  97.  
  98.   Dim Data() As Byte
  99.  
  100.   Data = DecodeToByteArray(EncodedText)
  101.   DecodeToString = StrConv(Data, vbUnicode)
  102.  
  103. End Function
  104.  
  105. Public Function DecodeToByteArray(EncodedText As String) As Byte()
  106.  
  107.   Dim Data() As Byte
  108.   Dim EncodedData() As Byte
  109.  
  110.   Dim DataLength As Long
  111.   Dim EncodedLength As Long
  112.  
  113.   Dim EncodedData0 As Long
  114.   Dim EncodedData1 As Long
  115.   Dim EncodedData2 As Long
  116.   Dim EncodedData3 As Long
  117.  
  118.   Dim l As Long
  119.   Dim m As Long
  120.  
  121.   Dim Index As Long
  122.  
  123.   Dim CharCount As Long
  124.  
  125.   EncodedData = StrConv(Replace$(Replace$(EncodedText, vbCrLf, ""), "=", ""), vbFromUnicode)
  126.  
  127.   EncodedLength = UBound(EncodedData) + 1
  128.   DataLength = (EncodedLength \ 4) * 3
  129.  
  130.   m = EncodedLength Mod 4
  131.   If m = 2 Then
  132.      DataLength = DataLength + 1
  133.   ElseIf m = 3 Then
  134.      DataLength = DataLength + 2
  135.   End If
  136.  
  137.   ReDim Data(DataLength - 1)
  138.  
  139.   For l = 0 To UBound(EncodedData) - m Step 4
  140.      EncodedData0 = Base64Reverse(EncodedData(l))
  141.      EncodedData1 = Base64Reverse(EncodedData(l + 1))
  142.      EncodedData2 = Base64Reverse(EncodedData(l + 2))
  143.      EncodedData3 = Base64Reverse(EncodedData(l + 3))
  144.      Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
  145.      Data(Index + 1) = ((EncodedData1 And Mask2) * Shift4) Or (EncodedData2 \ Shift2)
  146.      Data(Index + 2) = ((EncodedData2 And Mask1) * Shift6) Or EncodedData3
  147.      Index = Index + 3
  148.   Next
  149.  
  150.   Select Case ((UBound(EncodedData) + 1) Mod 4)
  151.   Case 2
  152.      EncodedData0 = Base64Reverse(EncodedData(l))
  153.      EncodedData1 = Base64Reverse(EncodedData(l + 1))
  154.      Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
  155.   Case 3
  156.      EncodedData0 = Base64Reverse(EncodedData(l))
  157.      EncodedData1 = Base64Reverse(EncodedData(l + 1))
  158.      EncodedData2 = Base64Reverse(EncodedData(l + 2))
  159.      Data(Index) = (EncodedData0 * Shift2) Or (EncodedData1 \ Shift4)
  160.      Data(Index + 1) = ((EncodedData1 And Mask2) * Shift4) Or (EncodedData2 \ Shift2)
  161.   End Select
  162.  
  163.   DecodeToByteArray = Data
  164.  
  165. End Function
  166.  
  167. Private Sub Class_Initialize()
  168.  
  169.   Dim l As Long
  170.  
  171.   ReDim Base64Reverse(255)
  172.  
  173.   Base64Lookup = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
  174.  
  175.   For l = 0 To 63
  176.      Base64Reverse(Base64Lookup(l)) = l
  177.   Next
  178.  
  179. End Sub
  180.  

mas corta
Código
  1.  
  2. Public Function DecodeBase64(ByVal strData As String) As Byte()
  3.    Dim objXML As Object
  4.    Dim objNode As Object
  5.  
  6.    Set objXML = CreateObject("MSXML2.DOMDocument")
  7.    Set objNode = objXML.createElement("b64")
  8.    objNode.dataType = "bin.base64"
  9.    objNode.Text = strData
  10.    DecodeBase64 = objNode.nodeTypedValue
  11.  
  12.    Set objNode = Nothing
  13.    Set objXML = Nothing
  14.  
  15. End Function
  16.  
  17.  
  18. Public Function EnecodeBase64(ByVal strData As String) As Byte()
  19.    Dim objStream As Object
  20.    Dim objNode As Object
  21.    Dim objXML As Object
  22.    Dim bArray() As Byte
  23.  
  24.    Set objStream = CreateObject("ADODB.Stream")
  25.  
  26.    With objStream
  27.        .Type = 2
  28.        .Open
  29.        .Charset = "unicode"
  30.        .WriteText strData
  31.        .Flush
  32.        .Position = 0
  33.        .Type = 1
  34.        .read (2)
  35.        bArray = .read
  36.        .Close
  37.    End With
  38.  
  39.    Set objXML = CreateObject("MSXML2.DOMDocument")
  40.    Set objNode = objXML.createElement("b64")
  41.  
  42.    objNode.dataType = "bin.base64"
  43.    objNode.nodeTypedValue = bArray
  44.    EnecodeBase64 = objNode.Text
  45.  
  46.    Set objStream = Nothing
  47.    Set objNode = Nothing
  48.    Set objXML = Nothing
  49.  
  50. End Function
  51.  



En línea

Anonx

Desconectado Desconectado

Mensajes: 21



Ver Perfil
Re: Ayuda para crear encriptador de texto a base64 en vb6.0
« Respuesta #2 en: 27 Diciembre 2012, 06:32 am »

muchas gracias, de verdad :)
En línea

Be Happy! :rolleyes:
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: Ayuda para crear encriptador de texto a base64 en vb6.0
« Respuesta #3 en: 28 Diciembre 2012, 00:15 am »

Aprovecho para apuntar que base64 no es un cifrado sino una codificación.
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines