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!
