Results 1 to 3 of 3

Thread: BASE64 and MD5 help Please

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Apr 2003
    Posts
    148

    BASE64 and MD5 help Please

    Code:
    Option Explicit
    
    Private Const CRYPT_STRING_BASE64  As Long = 1
    Private Const CRYPT_STRING_BINARY  As Long = 2
    Private Const CALG_MD5             As Long = 32771
    
    Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hSessionKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
    
    
    Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
    Private Declare Function CryptBinaryToString Lib "crypt32.dll" Alias "CryptBinaryToStringA" (ByVal pbBinary As String, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As String, ByRef pcchString As Long) As Long
    
    Public Function BASE64(ByVal InputStr As String) As String
      Dim lpOutput As String
      Dim lpOutputLength As Long
      
      Call CryptBinaryToString(InputStr, LenB(InputStr), CRYPT_STRING_BASE64, vbNullString, lpOutputLength)
      
      If (lpOutputLength > 0) Then
          lpOutput = Space$((lpOutputLength / 2) + 1)
          Call CryptBinaryToString(InputStr, Len(InputStr), CRYPT_STRING_BASE64, lpOutput, lpOutputLength)
      End If
      
      BASE64 = lpOutput
    End Function
    
    Public Function MD5(ByVal InputStr As String) As String
      Dim hCryptProv As Long
      Dim hHashObjct As Long
      Dim lpOutput As String * 16
        
      If (CryptAcquireContext(hCryptProv, vbNullChar, vbNullChar, &H1, 0) = 0) Then
          Exit Function
      End If
      If (CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHashObjct) = 0) Then
          Exit Function
      End If
      If (CryptHashData(hHashObjct, InputStr, Len(InputStr), 0) = 0) Then
          Exit Function
      End If
      If (CryptGetHashParam(hHashObjct, &H2, ByVal lpOutput, Len(lpOutput), 0) = 0) Then
          Exit Function
      End If
      MD5 = lpOutput
        
      Call CryptDestroyHash(hHashObjct)
      Call CryptReleaseContext(hCryptProv, 0)
    End Function
    I need this to bytes or any
    Code:
    Private Declare Function CryptBinaryToString Lib "crypt32.dll" Alias "CryptBinaryToStringA" (ByVal pbBinary As String, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As String, ByRef pcchString As Long) As Long
    
    Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
    I need to change pbdata as string into pbdata as any or bytes
    because some other language windows won't show up char.

    thank you

  2. #2
    Frenzied Member Jim Davis's Avatar
    Join Date
    Mar 2001
    Location
    Mars base one Username: Jim Davis Password: yCrm33
    Posts
    1,284

    Re: BASE64 and MD5 help Please

    since you work with unicode strings it would be better to use those api calls that are unicode safe, just like CryptBinaryToStringW in this case. but, you may also want to replace the String to Long, there you can send the pointer (by using the StrPtr() method) of the string instead of the string itself. it makes the call as unicode safe.

    Code:
    Private Declare Function CryptBinaryToStringUnicode Lib "crypt32.dll" Alias "CryptBinaryToStringW" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
    
    '.....
      Call CryptBinaryToString(StrPtr(InputStr), LenB(InputStr), CRYPT_STRING_BASE64, 0&, lpOutputLength)
    
    '.....
    
          Call CryptBinaryToString(StrPtr(InputStr), Len(InputStr), CRYPT_STRING_BASE64, StrPtr(lpOutput), lpOutputLength)
    hope it works.


    i also won't recommend you to convert the string to byte array, because strings in vb are stored as unicode strings, there every letters are represented in 16bit format, but byte array is 8 bit only, so you will lose the high or low bytes then. either case will cause unwanted results.

  3. #3
    Frenzied Member Jim Davis's Avatar
    Join Date
    Mar 2001
    Location
    Mars base one Username: Jim Davis Password: yCrm33
    Posts
    1,284

    Re: BASE64 and MD5 help Please

    Yes, it definitely works. I also found the way how to reverse the base64. the important part is that the unicode string's will be twice that long as the ansi representation, therefore you have to multiply (at the encodings), then later divide (at the decodings) the lengths by 2.

    vb Code:
    1. Private Const CRYPT_STRING_BASE64  As Long = 1
    2. Private Declare Function CryptBinaryToStringUnicode Lib "crypt32.dll" Alias "CryptBinaryToStringW" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
    3. Private Declare Function CryptStringToBinaryUnicode Lib "crypt32.dll" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Any, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    4.  
    5.  
    6. Public Function BASE64W(ByVal InputStr As String) As String
    7.   Dim lpOutput As String
    8.   Dim lpOutputLength As Long
    9.  
    10.   Call CryptBinaryToStringUnicode(StrPtr(InputStr), LenB(InputStr) * 2, CRYPT_STRING_BASE64, 0&, lpOutputLength)
    11.  
    12.   If (lpOutputLength > 0) Then
    13.       lpOutput = Space$((lpOutputLength / 2) - 1)
    14.       Call CryptBinaryToStringUnicode(StrPtr(InputStr), LenB(InputStr) * 2, CRYPT_STRING_BASE64, StrPtr(lpOutput), lpOutputLength)
    15.   End If
    16.  
    17.   BASE64W = lpOutput
    18.  
    19. End Function
    20.  
    21. Public Function BASE64W_D(ByVal InputStr As String) As String
    22.   Dim lpOutput As String
    23.   Dim lpOutputLength As Long
    24.   Dim dwActualUsed As Long
    25.  
    26.   Call CryptStringToBinaryUnicode(StrPtr(InputStr), Len(InputStr), CRYPT_STRING_BASE64, ByVal 0&, lpOutputLength, 0, dwActualUsed)
    27.  
    28.   If (lpOutputLength > 0) Then
    29.       lpOutput = Space$((lpOutputLength) \ 2)
    30.       Call CryptStringToBinaryUnicode(StrPtr(InputStr), Len(InputStr), CRYPT_STRING_BASE64, StrPtr(lpOutput), lpOutputLength, 0, dwActualUsed)
    31.   End If
    32.  
    33.   BASE64W_D = lpOutput
    34. End Function
    35.  
    36. '  Debug.Print BASE64W("óêöùïüùöó úõ12")
    37. '  Debug.Print BASE64W_D(BASE64W("óêöùïüùöó úõ12"))

    i also found that the lpOutput = Space$((lpOutputLength / 2) + 1) in your original code resulting two extra (unecessary) 0's at the end of the string. that +1 shouldn't be -1?
    Last edited by Jim Davis; Nov 1st, 2009 at 10:03 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width