Visual Basic Foro
General => Códigos - Aportes - Recursos => Mensaje iniciado por: coco en Marzo 23, 2014, 08:21:30 pm
-
Aca dejo un codigo para encriptar a base64. Ya se que existen muchas clases que hacen esto (inclusive leandro uso un par de las mismas), pero no me gusta agregar mas clases al pedo (ya que solamente lo necesito en un solo lugar a esto, y la clase de base64 tenia bastante codigo para meterlo en donde lo necesitaba), asi que hice este snippet, que usa el api Crypt32.
Option Explicit
Private Const CRYPT_STRING_BASE64 As Long = &H1
Private Const CRYPT_STRING_NOCRLF As Long = &H40000000
Private Const CRYPT_STRING_NOCR As Long = &H80000000
Private Declare Function CryptBinaryToStringA Lib "crypt32.dll" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As String, ByVal pcchString As Long) As Long
Private Declare Function CryptStringToBinaryA Lib "crypt32.dll" (ByVal pszString As String, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByVal pcbBinary As Long, ByVal pdwSkip As Long, ByVal pdwFlags As Long) As Long
'// VB6 code by cocus (23-mar-2014)
'// original code:
'// http://www.experts-exchange.com/Programming/Microsoft_Development/A_3216-Fast-Base64-Encode-and-Decode.html
Private Function Base64EncodeString(ByVal sString As String, _
ByRef sOut As String) As Boolean
Base64EncodeString = Base64Encode(StrConv(sString, vbFromUnicode), sOut)
End Function
Private Function Base64DecodeString(ByVal sString As String, _
ByRef sOut As String) As Boolean
Dim bvData() As Byte
Base64DecodeString = Base64Decode(sString, bvData())
If Base64DecodeString Then
sOut = StrConv(bvData, vbUnicode)
End If
End Function
Private Function Base64Encode(ByRef bvSrc() As Byte, _
ByRef sOut As String) As Boolean
Dim lLenOut As Long
'// calculate buffer len
Call CryptBinaryToStringA(VarPtr(bvSrc(0)), _
UBound(bvSrc) + 1, _
CRYPT_STRING_BASE64 Or CRYPT_STRING_NOCRLF, _
vbNullString, _
VarPtr(lLenOut))
If lLenOut = 0 Then
Exit Function
End If
sOut = Space$(lLenOut - 1)
'// now convert to base64
Call CryptBinaryToStringA(VarPtr(bvSrc(0)), _
UBound(bvSrc) + 1, _
CRYPT_STRING_BASE64 Or CRYPT_STRING_NOCRLF, _
sOut, _
VarPtr(lLenOut))
Base64Encode = True
End Function
Private Function Base64Decode(ByVal sIn As String, _
ByRef bvOut() As Byte) As Boolean
Dim lLenOut As Long
'// calculate buffer len
Call CryptStringToBinaryA(sIn, _
Len(sIn), _
CRYPT_STRING_BASE64, _
0, _
VarPtr(lLenOut), _
0, _
0)
If lLenOut = 0 Then
Exit Function
End If
ReDim bvOut(lLenOut - 1)
'// now convert to base64
Call CryptStringToBinaryA(sIn, _
Len(sIn), _
CRYPT_STRING_BASE64, _
VarPtr(bvOut(0)), _
VarPtr(lLenOut), _
0, _
0)
Base64Decode = True
End Function
y para probar:
Private Sub Form_Load()
Dim s As String
Call Base64EncodeString(Now, s)
Debug.Print "Base64: "; s
Call Base64DecodeString(s, s)
Debug.Print "Origin: "; s
End Sub
Saludos!
-
Buena Coco, muy piola, desconosia esas apis.
-
Hola, perdon que reviva un post antiguo
No entiendo porque me agrega dos cuadraditos la cadena encriptada como si hiciera un salto de linea u otro al final de la cadena convertida y que no son parte de la conversión.
Por ejemplo, si envio la cadena: Prueba que esta en un Textbox y hago esto:
Dim s As String
Call Base64EncodeString(txtText1, s)
lblLabel1 = s
Obtengo en lblLabel1 la cadena UHJ1ZWJh
y luego si lo desencripto efectivamente obtengo Prueba, pero en memoria la cadena encriptada es UHJ1ZWJh y dos cuadraditos
(http://i.snag.gy/glt9z.jpg)
El problema es que si meto esa cadena a la BD voy a tener problemas para luego hacer la comparacion (mejor dicho ya me salto el fallo al recuperar de la BD por eso me percate). Esta demas que diga que la BD es MySQL porque el problema de los cudraditos desde la creación de la cadena encriptada.
El unico artificio funcional que me resulta para resolver este problema es tomar toda la cadena menos 2 caracteres asi:
Mid(s ,1, Len(s)-2)
¿Existe otra forma mejor?
Gracias
-
Estimado YAcosta
En la prueba que he realizado no se presentan los caracteres que indicas
(https://onedrive.live.com/?cid=28C2A6606AE1B6DF&id=28C2A6606AE1B6DF%21360&v=3)
https://onedrive.live.com/?cid=28C2A6606AE1B6DF&id=28C2A6606AE1B6DF%21360&v=3
Saludos desde algún lugar de Lima-Perú
-
Hola Albertomi.
Entonces esto es mas extraño aun porque de primera vista no es un problema con el codigo. Incluso el problema me salta en un proyecto nuevo, limpio y siempre me agrega al final de la variable s esos dos cuadraditos. De momento lo he resuelto manipulando la cadena pero la duda aun queda.
EDITO: Acabo de percatarme de un detalle que no habia visto en tu foto, alli veo que agregaste
s = vbNullString
¿Porque? ¿Es necesario? entiendo que es para asegurarse de que la cadena este vacía, realmente vacia... pero ¿después de un Dim? o ¿si cabe la posibilidad a un nivel no detectable por el IDE de que si halla algun dato y con el vbNullString nos aseguramos? (parecen varias preguntas pero en realidad es una sola)
En todo caso tampoco me funciono doc.
(http://i.snag.gy/VBVDE.jpg)
Ah y otro detalle, si te fijas en el Inmediato, al hacerle un len veras que me cuenta 10 caracteres cuando en realidad deberian ser para ese caso 8 caracteres. ¿Es curioso no?
-
Hola, Yván.
No creo aportar nada con esto, pero lo digo por las dudas.
Copié y pegué el código que puso Coco y solo cambié "Now" por "Text1.text" (en la caja de texto puse "Prueba") y siempre devuelve, tanto en el form como en el inmediato y en el tooltiptext, "UHJ1ZWJh" y "Prueba" al codificar y decodificar, respectivamente.
No sé si habrás manipulado este código y habrás cambiado algo para adaptarlo a alguna necesidad.
Pondría una captura de pantalla aquí si supiera cómo hacerlo... :-[
EDITO: Eso lo había hecho en Win7. En WinXP me sale igual que a vos. Los cuadraditos correspondientes a los códigos de CR y LF. No sé por qué los agrega al final.
¡Perdón!
Jerónimo
-
En el código de la función "Base64Encode" cambié una línea:
Esta:
sOut = Space$(lLenOut - 1)Por esta:
sOut = Space$(lLenOut - 3) Solo cambié el 1 por el 3
Así funcionó bien con todas las pruebas que hice. A lo mejor te sirve. Si fuera así, sería más cómodo porque no habría que manipular todas las strings que se manden a encriptar.
Muchas gracias.
Jerónimo
-
Ah que buen dato doc, efectivamente mis pruebas han sido solo en WinXP, quiere decir que mi solucion iba a tromar cuando instalen en un Seven, voy a hacer la modificacion que tu hiciste (porque lo del lLenOut - 3 lo probaste en ambas no? en Xp y 7)
-
No, no hice la prueba en Win7. ¡Mala mía! Me enfoqué en XP, que era el origen de tu problema.
No creo que funcione en Win7 esa modificación, puesto que en ese SO la funión no trae ningún carácter de más.
Lo que haría sería lo siguiente:
Al final de la función Base64Encode, luego de "Base64Encode = True", pondría esto:
If Right(sOut, 2) = vbCrLf Then
sOut = Left$(sOut, Len(sOut) - 2)
Else
Debug.Print "Win7"
End If
De esa manera creo que funcionaría en XP y en Win7.
Jerónimo
-
¿lo probaste doc?
Creo que mejor pregunto por el SO, tengo codigo para saber eso, si es XP uso el de -3. Si es Seven uso el -1... y si es W8??... creo que ya empiezo mejor a optar por otras alternativas de encriptamiento..
¿Para que quiero esto? Voy a publicar para la renta un programa de gestión de tienda pequeño en versión shareware (lo prueban por 30 dias y si lo quieren que paguen una módica anualidad... un poco capturando el espíritu de Hugo y crear un negocio escalable), por tanto capturo unos datos de la maquina del cliente, la encripto y me la envio a mi hosting, a la vez que esa cadena la almaceno en bd local del cliente. Cuando viaje por red la data a mi host quiero que esa cadena viaje encriptada y lo mismo cuando lo almacene en local (que si por alli me abren la BD no detecten tan fácilmente que gsdrRYThgDrwSDF es 23452346 que podría ser la serial de su disco duro entre otras cosas).
Pero el potencial cliente pueda tener una XP, un W7, un W8... y el encriptador debería funcionar al 200% en cualquiera de esos S.O. Si tienes algún otro método de encriptamiento te agradecería me lo jugases (o un link).
Gracias doc.
-
Creo que con esa última modificación debiera funcionar, al menos en Win7 y en XP. Porque verifica la existencia de vbCrLf al final de la cadena. Si está, lo quita. Si no, deja todo como está. Y esto, más allá de qué sistema operativo se trate. Esto lo probé con las mismas cadenas (varias) en ambos SO.
Ahora, en Win8 no tengo idea, porque no lo uso. A lo mejor cambia algo más (o no). Incluso, mi Win7 es de 64 bits, así que no sé si esa diferencia será por esto o solo porque es Win7 (no sé si me expliqué bien).
Yo utilicé hace mucho una encriptación casera, donde manipulaba la cadena en cuestión: modificaba los caracteres y agregaba otros, como para que tampoco coincidan, la original y la encriptada, en la cantidad. Pero es algo muy básico y "hogareño".
-
Gracias doc, voy a probarlo mas tarde que no tuve tiempo.
Saludos
-
Hola, lo que pasa es que en XP no existe el flag "CRYPT_STRING_NOCRLF", por ende le agrega cr lf al final. Simplemente fijense si existe CRLF al final, tal cual como hace Jeronimo. O bien, usar el api que devuelve la version de windows y chequear si es menor a vista, borrar el CRLF.
Saludos
-
Gracias por la explicación, coco. No sabía por qué pasaba eso.
Saludos.
Jerónimo
-
Gracias Coco, siempre se aprende algo. Jeronimo no se si checaste el video que hice para Hugo, bueno habia olvidado comentar que luego que tuve instalado el IDE en el 8.1 y probe el codigo con tu modificacion y (como confirma Coco) funciona perfectamente. Por tanto el codigo corre sin problema en XP, W7 y W8 (y Seguro que también en W10).
Saludos
-
No vi el video todavía, aunque leí el comentario.
Me alegro porque haya andado bien.
En algún momento voy a conseguir un W8 también para probarlo (el Win).
Saludos.
Jerónimo