Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

SHA256/384/512 in XP SP3

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC SHA256/384/512 in XP SP3

    The key to these high order SHAs is the type of provider and its associated Cryptographic Service Provider (CSP).

    With HashFile we use %PROV_RSA_FULL and $MS_DEF_PROV respectively to gain access to the inbuilt MD5 an SHA1.

    If we use %PROV_RSA_AES and $MS_ENH_RSA_AES_PROV then not only do we gain access to MD5 and SHA1 but also SHA256, SHA384 and SHA512. Note that for XP < SP3 these values are not to be found.

    These values are used in the function crGetDefaultRSAHandle. The provider type is used for the CryptAcquireContext API. If there is a default Cryptographic Service Provider (CSP) associated with the given provider type then it will be used without further ado. If there is not a default CSP then we force the issue with a second pass of CryptAcquireContext giving this time both the provider type and CSP.

    It follows then if there is a default CSP the following code will work with both XP SP3 and Vista. If there is not a default CSP then the following code will work with XP SP3 but may fail with Vista.

    The values we need, including all the necessary numeric equates, have been added to Don Dickinson's Wincrypt.inc in post #3.

    For XP SP3 we have for the CSP:
    $MS_ENH_RSA_AES_PROV = "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)"

    and for Vista we have for the CSP:
    $MS_ENH_RSA_AES_PROV = "Microsoft Enhanced RSA and AES Cryptographic Provider"

    That is sans "(Prototype)" with Vista.

    For Vista without a default CSP associated with %PROV_RSA_AES then Wincrypt.inc should be edited. With a default CSP then no editing is required because the correct CSP will be used.

    Right, that is the caveat out of the way.

    This is a typical output of the test code in post #2 on a 100MB file and some text.



    Much of PBMain is involved with the display and whether you are using PBWin or PBCC.

    The core statment is: Hash( sText, WhichHash, HashHex, Flag )

    The input sText is either a filepath or text.

    The input WhichHash is one of MD5, SHA1, SHA256, SHA384 and SHA512. There are lesser algorithms available but the following code does not concern itsef with them.

    The output HashHex is the resulting hash value in hex string format.

    The input Flag is either 0 or 1 simply advises Hash() whether sText is either text or a file respectively.

    On reading a file we don't need the data again so file cacheing is bypassed. In theory this should speed things up but I'm not sure how significant that is. However, we do avoid the possibility of existing cache data being put aside which may have been used again. The bypassing is, of course, achieved via FILE_FLAG_NO_BUFFERING in the CreateFile API. Buffer addresses for read and write operations should be sector aligned when using FILE_FLAG_NO_BUFFERING and to this end I have used VirtualAlloc API. Of course, this is ideal for the test code below as the file is read by each and every algorithm.

    Some of the code is either a direct port or an adaptation of Don Dickinson's code which accompanied the publication of Wincrypt.inc, 10 years ago in a few weeks time.

    Initial tests saw MD5 on files being slower than anticipated. I was already using my timer macro and did not want to move its position to different areas of the code - I wanted multiple timers so updated the timer macro here.

    I was now in a position to do something like this

    StartTimer(1)
    Code ...
    StopTimer(1)
    zTrace("Timer 1:" + sTimeTaken(1,2))

    where sTimeTaken(1,2) means using Timer 1 and display to 2 decimal places.

    zTrace is Practice Terrier's superb little tracing utilty. If you have not seen this yet then you should check it out here.

    To cut a long story short I found that the issue was clearly related to the first instance of Hash() and had nothing to with MD5, it was nothing to do with bypassing the file cache and seemed to be a small absolute value so its effect diminished as the file being tested increased in size. First instance smacks of some kind of initialization but I don't know what. I should add that we are only talking about 5 to 10 milliseconds.

    To ensure that all trials are on a level playing field the simplest solution is to execute a dummy run of Hash() before the trials start.

    The test code will fail with XP < SP3. The application should not fail, he says fingers crossed, as an adaptation of José Roca's API error trapper is used. If we use %PROV_RSA_FULL and $MS_DEF_PROV, as HashFile does, then MD5 and SHA1 will succeed and the high order SHAs will fail. You have been warned.

    I should add that the following is not the first to gather these high order SHAs. Rick Kelly has done a monumental task - see his post here. It did not dawn on me at that time what was under the bonnet - a cursory glance and I was off like a shot. There are others much better qualified than I who could make good use of Rick's work.

    As always, have fun.

  • #2
    NB Your filepath is required - in red below

    Code:
    #Compile Exe "MsHashFn.exe"
    #Dim All
    #Register None
    #Tools Off
    
    %NOMMIDS     = 1
    %NOGDI       = 1
    
    #Include "WIN32API.inc" ' 27 August 2009
    #Include "WinCrypt.inc"
    
    'Declare Function zTrace Lib "zTrace.DLL" Alias "zTrace" (zMessage As Asciiz) As Long
    
    %BufferSize   = 65536
    %Text = 0 : %File = 1
    
    Global App As String
    Global hProv As Long
    Global ReadBuffer As Dword Ptr
    
    ' Macros
    Macro SysErrMsg( API, Number ) = MessageBox 0, SystemErrorMessage( WinErr, API, FuncName$, Number ), ByVal StrPtr(App), %MB_ICONERROR + %MB_TOPMOST
    
    Global qFreq, qStart(), qStop(), qOverhead As Quad
    
    Macro InitializeTimer
      Dim qStart( 0 To 15) As Global Quad
      Dim qStop( 0 To 15 ) As Global Quad
      QueryPerformanceFrequency qFreq 
      QueryPerformanceCounter qStart(0) ' Intel suggestion. First use may be suspect 
      QueryPerformanceCounter qStart(0) ' So, wack it twice <smile>
      QueryPerformanceCounter qStop(0)
      qOverhead = qStop(0) - qStart(0)  ' Relatively small 
    End Macro
    
    Macro StartTimer(i) = QueryPerformanceCounter qStart(i)
    Macro StopTimer(i) = QueryPerformanceCounter qStop(i)
    
    ' In the following i is the ith timer and 0 <= j <= 3 For 0 To 3 decimal places
    Macro sTimeTaken( i, j ) = Using$(Choose$(j+1,"####","####.#", "####.##","####.###"), (qStop(i) - qStart(i) - qOverhead)*1000/qFreq) + "ms"
    Macro nTimeTaken(i) = (qStop(i) - qStart(i) - qOverhead)*1000/qFreq
    ' End Macros
    
    ' ~~~~~~~~~~~~~
    
    Function PBMain
    
      Local Message, sText, HashHex As String
      Local WinErr, i, lResult, Flag, L As Long
      
      ' Initialize
        Dim Alg( 1 To 5 ) As Long
        Alg(1) = %CALG_MD5
        Alg(2) = %CALG_SHA1
        Alg(3) = %CALG_SHA_256
        Alg(4) = %CALG_SHA_384
        Alg(5) = %CALG_SHA_512
        
        Dim sAlg( 1 To 5 ) As String
        sAlg(1) = "MD5"
        sAlg(2) = "SHA1"
        sAlg(3) = "SHA256"
        sAlg(4) = "SHA384"
        sAlg(5) = "SHA512"
        
        hProv = crGetDefaultRSAHandle
        If hProv = 0 Then Exit Function 'We have already been advised of a failure
        
        ReadBuffer = VirtualAlloc( ByVal %Null, %BufferSize, %MEM_COMMIT Or %MEM_TOP_DOWN, %PAGE_READWRITE )
        ' Buffer addresses for read and write operations should be sector aligned when using FILE_FLAG_NO_BUFFERING
        If IsFalse ReadBuffer Then
          WinErr = GetLastError : SysErrMsg( "VirtualAlloc", 10 )
          Exit Function
        End If
        
        InitializeTimer
        
        App = Exe.Name$ ' For the SysErrMsg macro
      ' End of initialization
        
      sText = "Whatever" ' [COLOR="Red"]Your filepath here[/COLOR]
      
      ' Execute a dummy run so that tests are on a level playing field 
      lResult = Hash(sText, %CALG_MD5, HashHex, %File)
      
      Message = "File" + $Tab + sText + $CrLf + $CrLf
      #If %Def(%Pb_Cc32)
        Print "File" : Print
      #EndIf
      Flag = %File
      GoSub DisplayResults
      
      sText = "The quick brown fox jumps over the lazy dog"
      Message = Message + $CrLf + "Text" + $CrLf + $CrLf
      #If %Def(%Pb_Cc32)
        Print : Print "Text" : Print
      #EndIf
      Flag = %Text
      GoSub DisplayResults
      
      #If %Def(%Pb_Win32)
        MsgBox Message, , App
      #Else
        Print: Print "Press a key to exit"
        Waitkey$
      #EndIf
      
      ' Tidy up
      CryptReleaseContext hProv, 0
      VirtualFree ByVal ReadBuffer, %Null, %MEM_RELEASE
      
      Exit Function
      
    DisplayResults:
    
      For i = 1 To 5
        StartTimer(0)
          lResult = Hash( sText, Alg(i), HashHex, Flag )
        StopTimer(0)
          If lResult = %TRUE Then
            #If %Def(%Pb_Win32) 
              If i < 4 Then
                If Flag = %File Then
                  Message = Message + sAlg(i) + $Tab + sTimeTaken(0,2) + "    " + HashHex + $CrLf + $CrLf
                Else
                  Message = Message + sAlg(i) + $Tab + HashHex + $CrLf + $CrLf
                End If
              Else
                If Flag = %File Then
                  Message = Message + sAlg(i) + $Tab + sTimeTaken(0,2) + "    "
                Else
                  Message = Message + sAlg(i) + $Tab
                End If
                L = Len(HashHex)\2
                Message = Message + Left$(HashHex, L-4) + $CrLf + $Tab + Mid$(HashHex, L-3) + $CrLf + $CrLf 
              End If
            #Else
              If i < 4 Then
                If Flag = %File Then
                  Print sAlg(i);sTimeTaken(0,2);" ";HashHex
                  Print
                Else
                  Print sAlg(i);" ";HashHex
                  Print
                End If
              Else
                If Flag = %File Then
                  Print sAlg(i);sTimeTaken(0,2)
                Else
                  Print sAlg(i)
                End If
                L = Len(HashHex)\2
                Print "  ";Left$(HashHex, L)
                Print "  ";Right$(HashHex, L)
                Print
              End If
            #EndIf
          Else
            #If %Def(%Pb_Win32)
              Message = Message + sAlg(i) + " Failed" + $CrLf + $CrLf
            #Else
              Print sAlg(i);" Failed" 
            #EndIf
        End If
      Next
      Return
      
    End Function
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function Hash( sText As String, WhichHash As Long, HashHex As String, ByVal Flag As Long ) As Long
    
      ' Input: sText is the message - text string, binary string, binary file or whatever
      ' WhichHash is %CALG_MD5 and so on.
      ' Flag is either %File or %Text
      ' Output: HashHex is the computed Hash value as a hex string
      
      Local hHash, WinErr As Long
      
      If CryptCreateHash( hProv, WhichHash, 0, 0, hHash ) = %False Then
        WinErr = GetLastError : SysErrMsg( "CryptCreateHash", 10 )
        GoTo Failure
      End If
      If Flag = %File Then
        If FileToHash( sText, hHash ) = %False Then GoTo Failure
      Else
        If TextToHash( sText, hHash ) = %False Then GoTo Failure
      End If
      If GetHash( HashHex, hHash ) = %False Then GoTo Failure
      Function = %True
      Exit Function
    
    Failure:
    
    End Function
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function crGetDefaultRSAHandle As Long
      Local WinErr As Long
      
      If CryptAcquireContext( hProv, ByVal %Null, ByVal %Null, %PROV_RSA_AES, 0 ) = %False Then
        If CryptAcquireContext( hProv, ByVal %Null, $MS_ENH_RSA_AES_PROV, %PROV_RSA_AES, %CRYPT_VERIFYCONTEXT ) = %False Then
          WinErr = GetLastError : SysErrMsg( "CryptAcquireContext", 10 )
        Else
          Function = hProv
        End If
      Else
        Function = hProv
      End If
    
    End Function
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function FileToHash( sFile As String, hHash As Long ) As Long
    
      Local hFile, WinErr  As Long
      Local zFile  As Asciiz * 256
      Local nbLoaded As Dword
      
      zFile = sFile
      hFile = CreateFile( zFile, %GENERIC_READ, 0, ByVal 0, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN Or %FILE_FLAG_NO_BUFFERING, ByVal 0 )
      If hFile = %INVALID_HANDLE_VALUE Then
        WinErr = GetLastError : SysErrMsg( "CreateFile", 10 )
        Exit Function
      End If
      Do
        If ReadFile( hFile, ByVal ReadBuffer, %BufferSize, nbLoaded, ByVal 0 ) = %False Then
          WinErr = GetLastError : SysErrMsg( "ReadFile", 20 )
          CloseHandle( hFile )
          Exit Function
        End If
        If nbLoaded = 0 Then Exit Loop
        If CRYPTHASHDATA( hHash, ByVal ReadBuffer, nbLoaded, 0 ) = %False Then
          WinErr = GetLastError : SysErrMsg( "CryptHashData", 30 )
          CloseHandle( hFile )
          Exit Function
        End If
      Loop Until nbLoaded < %BufferSize
      CloseHandle( hFile )
      Function = %True
              
    End Function
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function TextToHash( sText As String, hHash As Long ) As Long
      Local WinErr, Chunk, NextChunk, Balance, Completed, dummy As Long
      Dim ChunkText  As String * %BufferSize
    
      Chunk = %BufferSize
      dummy = Len( sText )
      Balance = dummy Mod Chunk
      Completed = %False
      NextChunk = 1
      Do
        ChunkText = Mid$( sText, NextChunk, Chunk )
        If NextChunk + Chunk >= dummy Then
          If Balance = 0 Then Exit Loop
          Chunk = Balance
          Completed = %TRUE
        End If
        If CryptHashData( hHash, ChunkText, Chunk, 0 ) = %False Then
          WinErr = GetLastError : SysErrMsg( "CryptHasData", 10 )
          Exit Function
        End If
        NextChunk = NextChunk + Chunk
      Loop Until completed
    
      Function = %TRUE
    
    End Function
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function GetHash( HashHex As String, hHash As Long ) As Long
      #Register None
      Register i As Long
      Local hSize, WinErr As Long
      
      Dim hByte( )  As Byte
      Dim hByteHex( )  As String * 2
      If CryptGetHashParam( hHash, %HP_HASHSIZE, hSize, 4, 0 ) = %False Then
        WinErr = GetLastError : SysErrMsg( "CryptGetHashParam", 10 )
        Exit Function
      End If
      ReDim hByte( hSize - 1 ) As Byte
      If CryptGetHashParam( hHash, %HP_HASHVAL, hByte( 0 ), hSize, 0 ) = %False Then
        WinErr = GetLastError : SysErrMsg( "CryptGetHashParam", 20 )
        Exit Function
      End If
    
      HashHex = Space$( 2 * hSize )
      ReDim hByteHex( hSize - 1 ) As String * 2 At StrPtr( HashHex )
      For i = 0 To hSize - 1
        hByteHex( i ) = Hex$( hByte( i ), 2 )
      Next
      
      ' hHash is rendered useless after CryptGetHashParam so we may as well destroy it here
      CryptDestroyHash hHash
      
      Function = %TRUE
    
    End Function 
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Function SystemErrorMessage( ByVal WinErr As Long, API As String, sFunction As String, ByVal Number As Long ) As String
      Local pBuffer As Asciiz Ptr, ncbBuffer As Dword
      Local sText As String
    
      ncbBuffer = FormatMessage( %FORMAT_MESSAGE_ALLOCATE_BUFFER Or %FORMAT_MESSAGE_FROM_SYSTEM Or %FORMAT_MESSAGE_IGNORE_INSERTS, _
        ByVal %Null, WinErr, %Null, ByVal VarPtr( pBuffer ), 0, ByVal %Null )
      If ncbBuffer Then
        sText = Peek$( pBuffer, ncbBuffer )
        sText = Remove$( sText, Any Chr$( 13 ) + Chr$( 10 ) )
        Function = $CrLf + "Error" + Format$( WinErr, " #####" ) + " during " + API + $CrLf + $CrLf + _
          Chr$(34) + sText + Chr$(34) + $CrLf + $CrLf + "Location : " + sFunction + IIf$( Number, Format$( Number, " ###" ), "" )
        LocalFree pBuffer
      Else
        Function = "Unknown error - Code:" + Format$( WinErr, " #####" )
      End If
    
    End Function
    Last edited by David Roberts; 19 Oct 2009, 07:51 PM. Reason: Used a wrong counter in one of the SysErrMsg lines

    Comment


    • #3
      Code:
      '############################ REPLY ############################
      'Don Dickinson, Member
      'posted November 09, 1999 10:36 PM
      
      
      '
      '  wincrypt.inc
      '
      '  Partial translation of Microsoft's CryptoAPI to Power Basic 32-bit
      '  Translated from Visual C++ header files by Don Dickinson
      '  Nov, 1999
      '
      Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
            (  hCryptProv As Long, zContainer As Asciiz, zProvider As Asciiz, _
               ByVal dwProvType As Dword, ByVal dwFlags As Dword ) As Long
      
      Declare Function CryptGetProvParam Lib "advapi32.dll" Alias "CryptGetProvParam" _
            (  ByVal hProv As Long, ByVal dwParam As Dword, pbData As Any, _
               dwDataLen As Dword, ByVal dwFlags As Dword ) As Long
      
      Declare Function CryptReleaseContext Lib "advapi32.dll" Alias "CryptReleaseContext" _
            (  ByVal hCryptProv As Long, ByVal dwFlags As Dword ) As Long
      
      Declare Function CryptSetProvider Lib "advapi32.dll" Alias "CryptSetProviderA" _
            (  zProvName As Asciiz, ByVal dwProvType As Dword ) As Long
      
      Declare Function CryptSetProvParam Lib "advapi32.dll" Alias "CryptSetProvParam" _
            (  ByVal hCryptProv As Long, ByVal dwParam As Dword, pbData As Any, ByVal dwFlags As Dword ) As Long
      
      Declare Function CryptCreateHash Lib "advapi32.dll" Alias "CryptCreateHash" _
            (  ByVal hProv As Long, ByVal iAlgID As Long, ByVal hKey As Long, _
               ByVal dwFlags As Dword, hHash As Long ) As Long
      
      Declare Function CryptHashData Lib "advapi32.dll" Alias "CryptHashData" _
            (  ByVal hHash As Long, pbData As Any, ByVal dwDatalen As Dword, _
               ByVal dwFlags As Long ) As Long
               
      ' Added [1]
      ' ~~~~~~~~~
      Declare Function CryptGetHashParam Lib "advapi32.dll" Alias "CryptGetHashParam" _
            (  ByVal hHash As Long, ByVal dwParam As Dword, pbData As Any, _
               pdwDataLen As Long, ByVal dwFlags As Long ) As Long
               
      Declare Function CryptDuplicateHash Lib "advapi32.dll" Alias "CryptDuplicateHash" _
            ( ByVal hHash As Long, ByVal pdwReserved As Dword, ByVal dwFlags As Dword, phHash As Dword) As Long         
      ' ~~~~~~~~~
      
      Declare Function CryptDeriveKey Lib "advapi32.dll" Alias "CryptDeriveKey" _
            (  ByVal hProv As Long, ByVal AlgID As Long, ByVal hBaseData As Long, _
               ByVal dwFlags As Long, hKey As Long ) As Long
      
      Declare Function CryptEncrypt Lib "advapi32.dll" Alias "CryptEncrypt" _
            (  ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, _
               ByVal dwFlags As Dword, pbData As Any, pdwDataLen As Long, _
               ByVal dwBufLen As Long ) As Long
      
      Declare Function CryptDecrypt Lib "advapi32.dll" Alias "CryptDecrypt" _
            (  ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, _
               ByVal dwFlags As Dword, pbData As Any, pdwDataLen As Long ) As Long
      
      Declare Function CryptDestroyHash Lib "advapi32.dll" Alias "CryptDestroyHash" _
            (  ByVal hHash As Long ) As Long
      
      Declare Function CryptDestroyKey Lib "advapi32.dll" Alias "CryptDestroyKey" _
            (  ByVal hKey As Long ) As Long
      
      ' Added [1]
      ' ~~~~~~~~~
      Declare Function CryptGenRandom Lib "advapi32.dll" Alias "CryptGenRandom" _
            ( ByVal hProv As Long, ByVal dwLen As Dword, pbBuffer As Byte) As Long
      ' ~~~~~~~~~
      
      $MS_DEF_PROV_A = "Microsoft Base Cryptographic Provider v1.0"
      $MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
      
      ' Added [1]
      ' ~~~~~~~~~
      $MS_ENH_RSA_AES_PROV = "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)"
      ' ~~~~~~~~~
      
      '- Return constants for CryptAquireContext
      ' %ERROR_INVALID_PARAMETER          = defined in win32api.inc
      ' %ERROR_NOT_ENOUGH_MEMORY          = defined in win32api.inc
      
      #If %Def(%THESE_AREN_NOT_YET_DEFINED)
      %NTE_BAD_FLAGS
      %NTE_BAD_KEYSET
      %NTE_BAD_KEYSET_PARAM
      %NTE_BAD_PROV_TYPE
      %NTE_BAD_SIGNATURE
      %NTE_EXISTS
      %NTE_KEYSET_ENTRY_BAD
      %NTE_KEYSET_NOT_DEF
      %NTE_NO_MEMORY
      %NTE_PROV_DLL_NOT_FOUND
      %NTE_PROV_TYPE_ENTRY_BAD
      %NTE_PROV_TYPE_NO_MATCH
      %NTE_PROV_TYPE_NOT_DEF
      %NTE_PROVIDER_DLL_FAIL
      %NTE_SIGNATURE_FILE_BAD
      #EndIf
      
      %PROV_RSA_FULL           = 1
      %PROV_RSA_SIG            = 2
      %PROV_DSS                = 3
      %PROV_FORTEZZA           = 4
      %PROV_MS_EXCHANGE        = 5
      %PROV_SSL                = 6
      %PROV_RSA_SCHANNEL       = 12
      %PROV_DSS_DH             = 13
      %PROV_EC_ECDSA_SIG       = 14
      %PROV_EC_ECNRA_SIG       = 15
      %PROV_EC_ECDSA_FULL      = 16
      %PROV_EC_ECNRA_FULL      = 17
      %PROV_SPYRUS_LYNKS       = 20
      %PROV_RSA_AES            = 24
      
      ' dwFlags definitions For CryptAcquireContext
      %CRYPT_VERIFYCONTEXT     = &hF0000000
      %CRYPT_NEWKEYSET         = &h00000008
      %CRYPT_DELETEKEYSET      = &h00000010
      %CRYPT_MACHINE_KEYSET    = &h00000020
      
      '  CryptSetProvParam
      '
      %PP_CLIENT_HWND          = 1
      %PP_CONTEXT_INFO         = 11
      %PP_KEYEXCHANGE_KEYSIZE  = 12
      %PP_SIGNATURE_KEYSIZE    = 13
      %PP_KEYEXCHANGE_ALG      = 14
      %PP_SIGNATURE_ALG        = 15
      %PP_DELETEKEY            = 24
      
      '- CryptGetProvParam
      '
      %PP_ENUMALGS             = 1
      %PP_ENUMCONTAINERS       = 2
      %PP_IMPTYPE              = 3
      %PP_NAME                 = 4
      %PP_VERSION              = 5
      %PP_CONTAINER            = 6
      %PP_CHANGE_PASSWORD      = 7
      %PP_KEYSET_SEC_DESCR     = 8
      %PP_CERTCHAIN            = 9
      %PP_KEY_TYPE_SUBTYPE     = 10
      %PP_PROVTYPE             = 16
      %PP_KEYSTORAGE           = 17
      %PP_APPLI_CERT           = 18
      %PP_SYM_KEYSIZE          = 19
      %PP_SESSION_KEYSIZE      = 20
      %PP_UI_PROMPT            = 21
      %PP_ENUMALGS_EX          = 22
      
      '  dwFlag definitions For CryptGenKey
      %CRYPT_EXPORTABLE        = &h00000001
      %CRYPT_USER_PROTECTED    = &h00000002
      %CRYPT_CREATE_SALT       = &h00000004
      %CRYPT_UPDATE_KEY        = &h00000008
      %CRYPT_NO_SALT           = &h00000010
      %CRYPT_PREGEN            = &h00000040
      %CRYPT_RECIPIENT         = &h00000010
      %CRYPT_INITIATOR         = &h00000040
      %CRYPT_ONLINE            = &h00000080
      %CRYPT_SF                = &h00000100
      %CRYPT_CREATE_IV         = &h00000200
      %CRYPT_KEK               = &h00000400
      %CRYPT_DATA_KEY          = &h00000800
      
      '  dwFlags definitions For CryptDeriveKey
      %CRYPT_SERVER           = &h00000400
      
      %KEY_LENGTH_MASK         = &hFFFF0000
      
      '  dwFlag definitions For CryptExportKey
      %CRYPT_Y_ONLY            = &h00000001
      %CRYPT_SSL2_SLUMMING     = &h00000002
      
      '  dwFlags definitions For CryptHashSessionKey
      %CRYPT_LITTLE_ENDIAN    = &h00000001
      
      '  dwFlag definitions For CryptSetProviderEx And CryptGetDefaultProvider
      %CRYPT_MACHINE_DEFAULT   = &h00000001
      %CRYPT_USER_DEFAULT      = &h00000002
      %CRYPT_DELETE_DEFAULT    = &h00000004
      
      '  exported key blob definitions
      %SIMPLEBLOB              = &h1
      %PUBLICKEYBLOB           = &h6
      %PRIVATEKEYBLOB          = &h7
      %PLAINTEXTKEYBLOB        = &h8
      
      %AT_KEYEXCHANGE          = 1
      %AT_SIGNATURE            = 2
      
      %CRYPT_USERDATA          = 1
      
      '  dwParam
      %KP_IV                   = 1       '  Initialization vector
      %KP_SALT                 = 2       '  Salt value
      %KP_PADDING              = 3       '  Padding values
      %KP_MODE                 = 4       '  Mode of the cipher
      %KP_MODE_BITS            = 5       '  Number of bits To feedback
      %KP_PERMISSIONS          = 6       '  Key permissions Dword
      %KP_ALGID                = 7       '  Key algorithm
      %KP_BLOCKLEN             = 8       '  Block Size of the cipher
      %KP_KEYLEN               = 9       '  Length of key In bits
      %KP_SALT_EX              = 10      '  Length of salt In bytes
      %KP_P                    = 11      '  DSS/Diffie-Hellman P value
      %KP_G                    = 12      '  DSS/Diffie-Hellman G value
      %KP_Q                    = 13      '  DSS Q value
      %KP_X                    = 14      '  Diffie-Hellman X value
      %KP_Y                    = 15      '  Y value
      %KP_RA                   = 16      '  Fortezza RA value
      %KP_RB                   = 17      '  Fortezza RB value
      %KP_INFO                 = 18      '  For putting information into an RSA envelope
      %KP_EFFECTIVE_KEYLEN     = 19      '  setting And getting RC2 effective key length
      %KP_SCHANNEL_ALG         = 20      '  For setting the Secure Channel algorithms
      %KP_CLIENT_RANDOM        = 21      '  For setting the Secure Channel Client Random Data
      %KP_SERVER_RANDOM        = 22      '  For setting the Secure Channel Server Random Data
      %KP_RP                   = 23
      %KP_PRECOMP_MD5          = 24
      %KP_PRECOMP_SHA          = 25
      %KP_CERTIFICATE          = 26      '  For setting Secure Channel certificate Data (PCT1)
      %KP_CLEAR_KEY            = 27      '  For setting Secure Channel clear key Data (PCT1)
      %KP_PUB_EX_LEN           = 28
      %KP_PUB_EX_VAL           = 29
      
      '  KP_PADDING
      %PKCS5_PADDING           = 1       '  PKCS 5 (sec 6.2) padding method
      %RANDOM_PADDING          = 2
      %ZERO_PADDING           = 3
      
      '  KP_MODE
      %CRYPT_MODE_CBC          = 1       '  Cipher block chaining
      %CRYPT_MODE_ECB          = 2       '  Electronic code book
      %CRYPT_MODE_OFB          = 3       '  Output feedback mode
      %CRYPT_MODE_CFB          = 4       '  Cipher feedback mode
      %CRYPT_MODE_CTS          = 5       '  Ciphertext stealing mode
      
      '  KP_PERMISSIONS
      %CRYPT_ENCRYPT           = &h0001  '  Allow encryption
      %CRYPT_DECRYPT           = &h0002  '  Allow decryption
      %CRYPT_EXPORT            = &h0004  '  Allow key To be exported
      %CRYPT_READ              = &h0008  '  Allow parameters To be Read
      %CRYPT_WRITE             = &h0010  '  Allow parameters To be Set
      %CRYPT_MAC               = &h0020  '  Allow MACs To be used With key
      %CRYPT_EXPORT_KEY        = &h0040  '  Allow key To be used For exporting keys
      %CRYPT_IMPORT_KEY        = &h0080  '  Allow key To be used For importing keys
      
      %HP_ALGID                = &h0001  '  Hash algorithm
      %HP_HASHVAL              = &h0002  '  Hash value
      %HP_HASHSIZE             = &h0004  '  Hash value Size
      %HP_HMAC_INFO            = &h0005  '  information For creating an HMAC
      
      '
      '  CryptGetProvParam
      '
      %PP_ENUMALGS             = 1
      %PP_ENUMCONTAINERS       = 2
      %PP_IMPTYPE              = 3
      %PP_NAME                 = 4
      %PP_VERSION              = 5
      %PP_CONTAINER            = 6
      %PP_CHANGE_PASSWORD      = 7
      %PP_KEYSET_SEC_DESCR     = 8       '  Get/Set security descriptor of keyset
      %PP_CERTCHAIN            = 9       '  For retrieving certificates From tokens
      %PP_KEY_TYPE_SUBTYPE     = 10
      %PP_PROVTYPE             = 16
      %PP_KEYSTORAGE           = 17
      %PP_APPLI_CERT           = 18
      %PP_SYM_KEYSIZE          = 19
      %PP_SESSION_KEYSIZE      = 20
      %PP_UI_PROMPT            = 21
      %PP_ENUMALGS_EX          = 22
      
      %CRYPT_FIRST             = 1
      %CRYPT_NEXT              = 2
      
      %CRYPT_IMPL_HARDWARE     = 1
      %CRYPT_IMPL_SOFTWARE     = 2
      %CRYPT_IMPL_MIXED        = 3
      %CRYPT_IMPL_UNKNOWN      = 4
      
      '  key storage flags
      %CRYPT_SEC_DESCR         = &h00000001
      %CRYPT_PSTORE            = &h00000002
      %CRYPT_UI_PROMPT         = &h00000004
      
      '  protocol flags
      %CRYPT_FLAG_PCT1         = &h0001
      %CRYPT_FLAG_SSL2         = &h0002
      %CRYPT_FLAG_SSL3         = &h0004
      %CRYPT_FLAG_TLS1         = &h0008
      
      
      '
      '  STT defined Providers
      '
      %PROV_STT_MER            = 7
      %PROV_STT_ACQ            = 8
      %PROV_STT_BRND           = 9
      %PROV_STT_ROOT           = 10
      %PROV_STT_ISS            = 11
      
      '
      ' Algorithm IDs And Flags
      '
      ' Algorithm classes
      %ALG_CLASS_ANY                   = 0
      %ALG_CLASS_SIGNATURE             = 8192      '(1 << 13)        '8192
      %ALG_CLASS_MSG_ENCRYPT           = 16384     '(2 << 13)        '16384
      %ALG_CLASS_DATA_ENCRYPT          = 24576     '(3 << 13)        '24576
      %ALG_CLASS_HASH                  = 32768     '(4 << 13)        '32768
      %ALG_CLASS_KEY_EXCHANGE          = 40960     '(5 << 13)        '40960
      
      ' Algorithm types
      %ALG_TYPE_ANY                    = 0
      %ALG_TYPE_DSS                    = 512       '(1 << 9)         '512
      %ALG_TYPE_RSA                    = 1024      '(2 << 9)         '1024
      %ALG_TYPE_BLOCK                  = 1536      '(3 << 9)         '1536
      %ALG_TYPE_STREAM                 = 2048      '(4 << 9)         '2048
      %ALG_TYPE_DH                     = 2560      '(5 << 9)         '2560
      %ALG_TYPE_SECURECHANNEL          = 3072      '(6 << 9)         '3072
      
      
      '  Generic Sub-ids
      %ALG_SID_ANY                     = 0
      
      '  Some RSA Sub-ids
      %ALG_SID_RSA_ANY                 = 0
      %ALG_SID_RSA_PKCS                = 1
      %ALG_SID_RSA_MSATWORK            = 2
      %ALG_SID_RSA_ENTRUST             = 3
      %ALG_SID_RSA_PGP                 = 4
      
      '  Some DSS Sub-ids
      '
      %ALG_SID_DSS_ANY                 = 0
      %ALG_SID_DSS_PKCS                = 1
      %ALG_SID_DSS_DMS                 = 2
      
      '  Block cipher Sub ids
      '  DES sub_ids
      %ALG_SID_DES                     = 1
      %ALG_SID_3DES                    = 3
      %ALG_SID_DESX                    = 4
      %ALG_SID_IDEA                    = 5
      %ALG_SID_CAST                    = 6
      %ALG_SID_SAFERSK64               = 7
      %ALG_SID_SAFERSK128              = 8
      %ALG_SID_3DES_112                = 9
      %ALG_SID_CYLINK_MEK              = 12
      %ALG_SID_RC5                     = 13
      
      '  Fortezza Sub-ids
      %ALG_SID_SKIPJACK                = 10
      %ALG_SID_TEK                     = 11
      
      '  KP_MODE
      %CRYPT_MODE_CBCI                 = 6       '  ANSI CBC Interleaved
      %CRYPT_MODE_CFBP                 = 7       '  ANSI CFB Pipelined
      %CRYPT_MODE_OFBP                 = 8       '  ANSI OFB Pipelined
      %CRYPT_MODE_CBCOFM               = 9       '  ANSI CBC + OF Masking
      %CRYPT_MODE_CBCOFMI              = 10      '  ANSI CBC + OFM Interleaved
      
      '  RC2 Sub-ids
      %ALG_SID_RC2                     = 2
      
      '  Stream cipher Sub-ids
      %ALG_SID_RC4                     = 1
      %ALG_SID_SEAL                    = 2
      
      '  Diffie-Hellman Sub-ids
      %ALG_SID_DH_SANDF                = 1
      %ALG_SID_DH_EPHEM                = 2
      %ALG_SID_AGREED_KEY_ANY          = 3
      %ALG_SID_KEA                     = 4
      
      '  Hash Sub ids
      %ALG_SID_MD2                     = 1
      %ALG_SID_MD4                     = 2
      %ALG_SID_MD5                     = 3
      %ALG_SID_SHA                     = 4
      %ALG_SID_SHA1                    = 4
      %ALG_SID_MAC                     = 5
      %ALG_SID_RIPEMD                  = 6
      %ALG_SID_RIPEMD160               = 7
      %ALG_SID_SSL3SHAMD5              = 8
      %ALG_SID_HMAC                    = 9
      
      ' Added [1]
      ' ~~~~~~~~~
      %ALG_SID_SHA_256                 = 12
      %ALG_SID_SHA_384                 = 13
      %ALG_SID_SHA_512                 = 14
      ' ~~~~~~~~~
      
      '  secure channel Sub ids
      %ALG_SID_SSL3_MASTER             = 1
      %ALG_SID_SCHANNEL_MASTER_HASH    = 2
      %ALG_SID_SCHANNEL_MAC_KEY        = 3
      %ALG_SID_PCT1_MASTER             = 4
      %ALG_SID_SSL2_MASTER             = 5
      %ALG_SID_TLS1_MASTER             = 6
      %ALG_SID_SCHANNEL_ENC_KEY        = 7
      
      '  Our silly example Sub-id
      %ALG_SID_EXAMPLE                 = 80
      
      '  algorithm identifier definitions
      %CALG_MD2           = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_MD2
      %CALG_MD4           = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_MD4
      %CALG_MD5           = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_MD5
      %CALG_SHA           = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA
      %CALG_SHA1          = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA1
      
      ' Added [1]
      ' ~~~~~~~~~
      %CALG_SHA_256       = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA_256
      %CALG_SHA_384       = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA_384
      %CALG_SHA_512       = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SHA_512
      ' ~~~~~~~~~
      
      %CALG_MAC           = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_MAC
      %CALG_RSA_SIGN      = %ALG_CLASS_SIGNATURE  Or %ALG_TYPE_RSA Or %ALG_SID_RSA_ANY
      %CALG_DSS_SIGN      = %ALG_CLASS_SIGNATURE Or %ALG_TYPE_DSS Or %ALG_SID_DSS_ANY
      %CALG_RSA_KEYX      = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_RSA Or %ALG_SID_RSA_ANY
      %CALG_DES           = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_DES
      %CALG_3DES_112      = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_3DES_112
      %CALG_3DES          = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_3DES
      %CALG_RC2           = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_RC2
      %CALG_RC4           = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_STREAM Or %ALG_SID_RC4
      %CALG_SEAL          = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_STREAM Or %ALG_SID_SEAL
      %CALG_DH_SF         = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_DH Or %ALG_SID_DH_SANDF
      %CALG_DH_EPHEM      = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_DH Or %ALG_SID_DH_EPHEM
      %CALG_AGREEDKEY_ANY = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_DH Or %ALG_SID_AGREED_KEY_ANY
      %CALG_KEA_KEYX      = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_DH Or %ALG_SID_KEA
      %CALG_HUGHES_MD5    = %ALG_CLASS_KEY_EXCHANGE Or %ALG_TYPE_ANY Or %ALG_SID_MD5
      %CALG_SKIPJACK      = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_SKIPJACK
      %CALG_TEK           = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_TEK
      %CALG_CYLINK_MEK    = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_CYLINK_MEK
      %CALG_SSL3_SHAMD5   = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_SSL3SHAMD5
      %CALG_SSL3_MASTER   = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_SSL3_MASTER
      %CALG_SCHANNEL_MASTER_HASH = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_SCHANNEL_MASTER_HASH
      %CALG_SCHANNEL_MAC_KEY   = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_SCHANNEL_MAC_KEY
      %CALG_SCHANNEL_ENC_KEY   = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_SCHANNEL_ENC_KEY
      %CALG_PCT1_MASTER        = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_PCT1_MASTER
      %CALG_SSL2_MASTER        = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_SSL2_MASTER
      %CALG_TLS1_MASTER        = %ALG_CLASS_MSG_ENCRYPT Or %ALG_TYPE_SECURECHANNEL Or %ALG_SID_TLS1_MASTER
      %CALG_RC5                = %ALG_CLASS_DATA_ENCRYPT Or %ALG_TYPE_BLOCK Or %ALG_SID_RC5
      %CALG_HMAC               = %ALG_CLASS_HASH Or %ALG_TYPE_ANY Or %ALG_SID_HMAC
      
      ' [1] David Roberts

      Comment


      • #4
        Just thought that a dll to do the above may be handy.

        The syntax has been simplified to:

        MSHash( sText, WhichHash )

        sText is either a filepath or text.

        To differentiate 'twixt the two we simply append Chr$(0) to the text string.

        WhichHash is one of MD5, SHA1, SHA256, SHA384 and SHA512.

        The function return is the hash value in hex string format or a null string if a failure.

        The following little test shows it in operation.
        Code:
        #Compile Exe
        #Dim All
         
        %NOMMIDS     = 1
        %NOGDI       = 1
         
        %MD5 = 32771
        %SHA1 = 32772
        %SHA256 = 32780
        %SHA384 = 32781
        %SHA512 = 32782
         
        Declare Function MSHash Lib "MSHash.DLL" Alias "MSHash" (ByVal sText As String, ByVal WhichHash As Long ) As String
         
        Function PBMain
          Local sResult As String
         
          sResult = MSHash("C:\WINDOWS\system32\advapi32.dll", %SHA256)
          If sResult <> "" Then
            MsgBox sResult
          Else
            MsgBox "Failed"
          End If
         
          sResult = MSHash("The quick brown fox jumps over the lazy dog" + Chr$(0), %SHA1)
          If sResult <> "" Then
            MsgBox sResult
          Else
            MsgBox "Failed"
          End If
         
        End Function
        Version 1.0, all of 29KB unzipped, uploaded.

        PS: I should add that the validity checking of the the filepath is your responsibility, so make sure all is well before calling MSHash. A failure here will result in an error 6 in the ReadFile API "The handle is invalid" and this will be trapped and displayed via the SysErrMsg macro. We will get the same error, of course, if we forget to put Chr$(0) at the end of a text string to hash since, without it, MSHash is expecting a filepath.
        Attached Files
        Last edited by David Roberts; 21 Oct 2009, 08:31 PM.

        Comment


        • #5
          I was at a crypto site the other day and a guy was pulling his hair out at not being able to reproduce the standard HMAC test vectors with his code. It makes a nice change to be one step ahead of someone at a crypto site - I'm usually reaching for a crypto dictionary every other line.

          Anyway, the reason is that the CryptDeriveKey API knocks seven bells out of our key in its quest to provide us with a key handle. I used it recently in the AES 128/192/256 thread but there it was being used by both the encrypt and decrypt and never saw the light of day. Passing such a HMAC to HashCalc or my own HashFile would fail.

          The solution was to import a plaintext key via CryptImportKey using a PLAINTEXTKEYBLOB making sure to use CRYPT_IPSEC_HMAC_KEY allowing RC2 to churn out more than 16 bytes and the resulting HMAC will be that which we will all recognize. The answer was under my nose all the time - at the bottom of a 100 foot well. I didn't get a migraine but it was close.

          The new syntax is lResult = Hash( sText, Alg(i), HashHex, Flag, sHMACKey )
          where sHMACKey is either ASCII or binary if wholly hexadecimal and even numbered.
          An empty key is a valid key but in our context it will taken as an ordinary hash only is required.

          All the hard work is done in a new Function Hash when sHMACKey <> "". There are, surprisingly, very few lines there and not indicative of a near migraine - you will have to take my word for it. If I had any strength left I'd attach a new dll but that will have to wait.

          I have added a few more items to WinCrypt.inc. That is getting too big to post so attached is the latest version.

          Instead of posting the whole lot, a couple of changes and additions to post #2 will do.

          Have fun.

          Add:
          Code:
          Type PublicKeyStruc
            bType As Byte
            bVersion As Byte
            Reserved As Word
            ALG_ID As Dword
          End Type
           
          Type KeyBlob
            BlobHeader As PublicKeyStruc
            cbData As Dword
            pbData( 1 To 1024 ) As Byte
          End Type
           
          Type HMAC_Info
            HashAlgid As Dword
            dummy As String * 16 ' Changed from 10 - spotted by José Roca
          End Type
          Add:
          HMACKey as String to PBMain's Local list.

          HMACKey = "2E664237276E5BC4FA7DA0FCBE749F921700BF615333886A6ADAFB20F697B543"
          just before sText = "Whatever" ' Your filepath here

          Add: the following function
          Code:
          ' Returns %True if a string is hexadecimal (A-F,a-f,0-9)
          Function Hex(s As String) As Long
          #Register None
          Local sPtr, sLen As Dword
           
            sPtr = StrPtr(s) - 1
            sLen = StrPtr(s) + Len(s)
            ! mov eax, sPtr ;Ptr To String - 1
            ! mov ecx, sLen ;Addr: End Of String
            StartLoop:
            ! inc eax
            ! cmp eax, ecx
            ! je  EndLoop
            ! mov bl, [eax]
            ! cmp bl, 65
            ! jl  NotAlpha
            ! cmp bl, 102
            ! jg  NotHex
            ! cmp bl, 71
            ! jl  Alpha
            ! cmp bl, 97
            ! jl NotAlpha
            Alpha:
            ! jmp StartLoop
            NotAlpha:
            ! cmp bl, 48
            ! jl NotHex
            ! cmp bl, 57
            ! jg NotHex
            ! jmp StartLoop
          NotHex:
            Exit Function
          EndLoop:
            Function = %True
          End Function
          Change:
          lResult = Hash(sText, %CALG_MD5, HashHex, %File)
          to
          lResult = Hash(sText, %CALG_MD5, HashHex, %File, sHMACKey)

          lResult = Hash( sText, Alg(i), HashHex, Flag )
          to
          lResult = Hash( sText, Alg(i), HashHex, Flag, sHMACKey )

          Replace Function Hash with a new Function Hash
          Code:
          Function Hash( sText As String, WhichHash As Long, sHashHex As String, ByVal Flag As Long, ByVal sHMACKey As String ) As Long
           
            ' Input: sText is the message - text string, binary string, binary file or whatever
            ' WhichHash is %CALG_MD5 and so on.
            ' Flag is either %File or %Text
            ' sHMACKey - may be ASCII or binary if wholly hexadecimal and even numbered
            ' If HMACKey is empty then an ordinary hash will be determined
            ' Output: sHashHex is the computed Hash value as a hex string
           
            Local hHash, WinErr As Long
           
            If sHMACKey = "" Then
           
              If CryptCreateHash( hProv, WhichHash, 0, 0, hHash ) = %False Then
                WinErr = GetLastError : SysErrMsg( "CryptCreateHash", 10 )
                GoTo Failure
              End If
           
            Else
           
              Dim HMACInfo As HMAC_Info
              Dim OurKeyBlob As KeyBlob
              Local i, hKey, KeyLen, ActualKeyBlobLen, NoOfBytes As Long, Dummy As String
           
                OurKeyBlob.BlobHeader.bType = %PLAINTEXTKEYBLOB
                OurKeyBlob.BlobHeader.bVersion = %CUR_BLOB_VERSION
                OurKeyBlob.BlobHeader.ALG_ID = %CALG_RC2
                ' Are we going to use sHMACKey as ascii or binary?
                If ( Len( sHMACKey ) Mod 2 = 0 ) And  IsTrue Hex( sHMACKey ) Then
                  ' Treat as a binary string
                  NoOfBytes = Len( sHMACKey )/2
                  For i = 0 To NoOfBytes - 1
                    Dummy = Dummy + Chr$( Val( "&H" + Mid$( sHMACKey, 2*i+1, 2 ) ) )
                  Next
                  sHMACKey = Dummy
                End If
                KeyLen = Len(sHMACKey)
                OurKeyBlob.cbData = KeyLen
                For i = 1 To Keylen
                  OurKeyBlob.pbdata(i) = Asc(Mid$(sHMACKey, i, 1))
                Next
                ActualKeyBlobLen = SizeOf(OurKeyBlob.BlobHeader) + SizeOf(OurKeyBlob.cbData) + KeyLen      
                If CryptImportKey( hProv, OurKeyBlob, ActualKeyBlobLen, 0, %CRYPT_IPSEC_HMAC_KEY, hKey) = 0 Then
                  WinErr = GetLastError : SysErrMsg( "CryptImportKey", 10 )
                  GoTo Failure
                End If
                ' Now set up HMAC
                If CryptCreateHash( hProv, %CALG_HMAC, hKey, 0, hHash ) = %False Then
                  WinErr = GetLastError : SysErrMsg( "CryptCreateHash", 20 )
                  GoTo Failure
                End If
                HMACInfo.HashAlgid = WhichHash
                If CryptSetHashParam( hHash, %HP_HMAC_INFO, HMACInfo, 0 ) = %False Then
                  WinErr = GetLastError : SysErrMsg( "CryptSetHashParam", 30 )
                  GoTo Failure
                End If
           
            End If ' HMACKey = ""
           
            If Flag = %File Then
              If FileToHash( sText, hHash ) = %False Then GoTo Failure
            Else
              If TextToHash( sText, hHash ) = %False Then GoTo Failure
            End If
            If GetHash( sHashHex, hHash ) = %False Then GoTo Failure
            Function = %True
            Exit Function
           
          Failure:
           
          End Function
          Attached Files
          Last edited by David Roberts; 16 Nov 2009, 12:48 PM. Reason: Corrected WinErr positions - I always forget <smile>

          Comment


          • #6
            Amazing what a cup of tea will do.

            Here is the new library.

            The syntax is as the previous library plus HMACKey which will be treated as binary if wholly hexadecimal and even numbered else ASCII. If HMACKey is an empty string then only an ordinary hash will be calculated.

            Here is an example of usage:
            Code:
            #Compile Exe
            #Dim All
             
            %NOMMIDS     = 1
            %NOGDI       = 1
             
            %MD5 = 32771
            %SHA1 = 32772
            %SHA256 = 32780
            %SHA384 = 32781
            %SHA512 = 32782
             
            Declare Function MSHash Lib "MSHash.DLL" Alias "MSHash" ( ByVal sText As String, _
                             ByVal WhichHash As Long, ByVal HMACKey As String ) As String
             
            Function PBMain
              Local sResult As String
             
              sResult = MSHash("C:\WINDOWS\system32\advapi32.dll", %SHA256, "2E664237276E5BC4FA7DA0FCBE749F921700BF615333886A6ADAFB20F697B543")
              If sResult <> "" Then
                MsgBox sResult
              Else
                MsgBox "Failed"
              End If
             
              sResult = MSHash("The quick brown fox jumps over the lazy dog" + Chr$(0), %MD5, "PowerBASIC")
              If sResult <> "" Then
                MsgBox sResult
              Else
                MsgBox "Failed"
              End If
             
            End Function
            BTW, for test purposes I use HashCalc. I actually wrote HashFile to fill in gaps, for what I wanted, but HashCalc comes into its own for knocking out many hashes for a given data set including text/file H/HMAC with binary or ASCII for the HMAC key.

            MSHash V 1.1 uploaded here.
            Attached Files
            Last edited by David Roberts; 18 Nov 2009, 07:36 PM.

            Comment


            • #7
              I have added a new export to the library. Nothing earth shattering, just a cprng based upon the CryptGenRandom API.

              Declaration:
              Code:
              Declare Function CryptRandom Lib "MSHash.DLL" Alias "CryptRandom" _
                      ( ByVal Number As Long, ByVal lMode As Long ) As String
              where Number is, obviously, the number of random numbers to generate and lMode is 0 for a binary string and 1 for a hex string.

              V 1.2 uploaded above.

              I don't want to tell you how to suck eggs but I have put the following into WinCrypt.inc:
              Code:
              Declare Function AuthDec2 Lib "AuthDec2.DLL" Alias "AuthDec2" _
                    ( ByVal sInFile As String, ByVal WhichAlgorithm As Long, _
                      ByVal sMasterKey As String, Opt EDMode As Long, _
                      sInitialValues As String ) As String
                    
              Declare Function MSHash Lib "MSHash.DLL" Alias "MSHash" _
                    ( ByVal sText As String, ByVal WhichHash As Long, _
                      ByVal HMACKey As String ) As String
                      
              Declare Function CryptRandom Lib "MSHash.DLL" Alias "CryptRandom" _
                    ( ByVal Number As Long, ByVal lMode As Long ) As String
              The first one relates to the AES128 etc thread.

              Example usage:
              Code:
              #Compile Exe
              #Dim All
              
              #Include "WinCrypt.inc"
               
              %Bin = 0
              %Hex = 1
               
              Function PBMain
              Local sResult As String
               
                sResult = CryptRandom( 32, %Hex )
                If sResult <> "" Then
                  MsgBox sResult
                Else
                  MsgBox "Failed"
                End If
                sResult = CryptRandom( 16, %Bin )
                If sResult <> "" Then
                  MsgBox "Length:" + Str$( Len( sResult ) )
                Else
                  MsgBox "Failed"
                End If
               
              End Function
              PS Don't forget that cprngs are really for crypto work only. RND will be at the 19th hole whilst CryptRandom will still be at the first's tee off.
              Last edited by David Roberts; 17 Nov 2009, 02:07 PM.

              Comment


              • #8
                I should add that the following is not the first to gather these high order SHAs. Rick Kelly has done a monumental task - see his post here. It did not dawn on me at that time what was under the bonnet - a cursory glance and I was off like a shot. There are others much better qualified than I who could make good use of Rick's work.
                It's nice that you found some use of that glob of ASM code. I'm currently porting a large Paradox app I wrote years ago that uses that PW32CAPI dll and have cleaned it up a bit. Attached is the PBWIN quickie I wrote to test it out.

                Enjoy!

                Rick

                p.s. It looks like i typed in an extra "zip" in the attachment name...
                Attached Files
                ------------------------------------------------------------
                sigpic

                It has come to my attention that certain dubious forces are interpolating their desires in my search for Mom, apple pie and the girl you left behind. Stop it or I'll scream...

                Comment


                • #9
                  Hi Rick.

                  Comments here.

                  Comment


                  • #10
                    The facility to use a file as a password, a 'passfile', has been added to the library.

                    The MSHash entry point of the library has been converted to a private function, renamed HashRoutine and called from a new entry point so as to hash the passfile, if given, and then HMAC the target object. The new entry point is now as follows:
                    Code:
                    Function MSHash Alias "MSHash" ( ByVal sText As String, ByVal WhichHash As Long, ByVal sHMACKey As String ) Export As String
                    Local Passkey As String, hIn As Long
                     
                    If Right$(sHMACKey,1) = Chr$(0) Then
                      sHMACKey = Left$(sHMACKey, Len(sHMACKey) - 1)
                    Else
                      If Dir$( sHMACKey, 6 ) = "" Then
                        MessageBox 0, "Unable to find passfile '" + sHMACKey + "'", "MSHash.dll", %MB_ICONWARNING + %MB_TOPMOST
                        Function = ""
                        Exit Function
                      End If
                      hIn = FreeFile
                      Open sHMACKey For Binary Lock Shared As hIn
                        If Err Then
                          MessageBox 0, "Error" + Str$(Err) + " opening passfile " + sHMACKey, "MSHash.dll", %MB_ICONERROR + %MB_TOPMOST
                          Function = ""
                          Exit Function
                        End If
                        Get hIn, ,sHMACKey ' Overwrite filepath with file contents
                      Close hIn
                      sHMACKey = HashRoutine( sHMACKey + Chr$(0), WhichHash, "" ) ' Set the key to the Hash of the file contents
                    End If
                     
                    Function = HashRoutine( sText, WhichHash, sHMACKey )
                     
                    End Function
                    To distinguish between text and file the same method is used as with the object being hashed. So, we null terminate the key if it is either ASCII or binary ie text and if not then the key is a file.

                    The file is hashed with the same algorithm that will be used on the object to be hashed so we get a 'full monty' binary key - the best key to use.

                    We have then four permutations of text and file and the text can be either ASCII or binary; although some are not that useful, such as HMAC a string with a passfile.

                    MSHash V 1.3 uploaded above.

                    Examples:
                    Code:
                    #Compile Exe
                    #Dim All
                    
                    #Include "COMDLG32.inc"
                    #Include "WinCrypt.inc"
                     
                    %NOMMIDS     = 1
                    %NOGDI       = 1
                     
                    '%MD5 = 32771
                    '%SHA1 = 32772
                    '%SHA256 = 32780
                    '%SHA384 = 32781
                    '%SHA512 = 32782
                    
                    %OfdStyle = %OFN_FILEMUSTEXIST Or %OFN_FORCESHOWHIDDEN Or %OFN_HIDEREADONLY Or %OFN_ENABLESIZING
                    
                    Function PBMain
                      Local OfdStyle As Dword
                      Local sResult, FileSelect As String, ret As Long
                      
                      FileSelect = ""
                      ret = OpenFileDialog( 0, "Select Key File", FileSelect, "", "All Files (*.*)|*.*", "*", %OfdStyle ) 
                      If ret <> 0 Then   
                        ' HMAC a file using a passfile
                        sResult = MSHash("[COLOR="Red"]********[/COLOR]", %CALG_SHA_256, FileSelect ) ' <--- [COLOR="Red"]Your file here[/COLOR]
                        If sResult <> "" Then
                          MsgBox "HMAC a file using a passfile" + $CrLf + $CrLf + sResult
                        Else
                          MsgBox "Failed"
                        End If
                      Else
                        MsgBox "Aborted"
                      End If
                      
                      ' HMAC a file using an ASCII string password
                      sResult = MSHash("[COLOR="Red"]********"[/COLOR], %CALG_SHA_256, "Password" + Chr$(0) ) ' <--- [COLOR="Red"]Your file here[/COLOR]
                      If sResult <> "" Then
                        MsgBox "HMAC a file using an ASCII string password" + $CrLf + $CrLf + sResult
                      Else
                        MsgBox "Failed"
                      End If
                      
                      ' HMAC a file using a binary string password
                      sResult = MSHash("[COLOR="Red"]********[/COLOR]", %CALG_SHA_256, "12C59C76C9524BC10911409F08A227F5E5DC034B4C4E717075339B357C3845F2" + Chr$(0) ) ' <--- [COLOR="Red"]Your file here[/COLOR]
                      If sResult <> "" Then
                        MsgBox "HMAC a file using a binary string password" + $CrLf + $CrLf + sResult
                      Else
                        MsgBox "Failed"
                      End If
                      
                      ' Hash a file
                      Local t As Single
                      t = Timer
                      sResult = MSHash("[COLOR="Red"]********[/COLOR]", %CALG_SHA_512, Chr$(0) ) ' <--- [COLOR="Red"]Your file here[/COLOR]
                      t = Timer - t
                      If sResult <> "" Then
                        MsgBox "Hash a file" + $CrLf + $CrLf + sResult + " " + Str$(t)
                      Else
                        MsgBox "Failed"
                      End If
                     
                      ' HMAC a string using an ASCII string password
                      sResult = MSHash("The quick brown fox jumps over the lazy dog" + Chr$(0), %CALG_MD5, "Password" + Chr$(0) )
                      If sResult <> "" Then
                        MsgBox "HMAC a string using an ASCII string password" + $CrLf+ $CrLf + sResult
                      Else
                        MsgBox "Failed"
                      End If
                      
                      ' HMAC a string using a binary string password
                      sResult = MSHash("The quick brown fox jumps over the lazy dog" + Chr$(0), %CALG_MD5, "79F783B346C3BC751F5D61FEB66015C1" + Chr$(0) )
                      If sResult <> "" Then
                        MsgBox "HMAC a string using a binary string password" + $CrLf+ $CrLf + sResult
                      Else
                        MsgBox "Failed"
                      End If
                      
                      ' Hash a string
                      sResult = MSHash("The quick brown fox jumps over the lazy dog" + Chr$(0), %CALG_MD5, Chr$(0) )
                      If sResult <> "" Then
                        MsgBox "Hash a string" + $CrLf + $CrLf + sResult
                      Else
                        MsgBox "Failed"
                      End If
                    
                    End Function
                    Last edited by David Roberts; 18 Nov 2009, 08:48 PM. Reason: Better examples.

                    Comment


                    • #11
                      Here is an example of hashing a file to provide a passkey for encryption.

                      You will need, if you want to avoid editing the following, MSHash.dll and AuthDec2.dll in the same directory and the declarations in WinCrypt.inc as in post #7 above. Wadda yer mean you haven't been looking at the other thread? 99.8% of members have no interest in either and the rest have an interest in both.

                      Somewhere along the line I must have had one too many because MSEncDec eventually became AuthDec instead of AuthEnc. Oh dear. Actually, I don't drink from one month to the next - sometimes three or four months - and one day my grocer will notice me looking over at the booze cabinet and say "Captain Morgan?" to which I reply "Aye, why not".

                      For the really paranoid or anyone who works for the intelligence agencies they could use a passfile for MSHash and present AuthDec2 with a HMAC.
                      Code:
                      #Compile Exe
                      #Dim All
                      #Register None
                      #Tools Off
                      
                      %NOMMIDS     = 1
                      %NOGDI       = 1
                      
                      #Include "WIN32API.inc" ' 27 August 2009
                      #Include "WinCrypt.inc"
                      
                      Function PBMain
                      Local sPassFile, sFile As String, WhichHash, WhichAlgorithm, hIn As Long
                      
                        sPassFile = "[COLOR="Red"]??????????[/COLOR]" ' Passfile - will be hashed and used as a passkey
                        
                        sFile = "[COLOR="Red"][COLOR="Red"]??????????[/COLOR][/COLOR]"    ' Target file for encryption
                        
                        WhichAlgorithm = %CALG_AES_128 ' AES128/SHA256 combo will be used
                        WhichHash = %Calg_SHA_256      ' so use SHA256 to hash passfile
                        
                        If Right$(sPassFile,1) = Chr$(0) Then
                          sPassFile = Left$(sPassFile, Len(sPassFile) - 1)
                        Else
                          'sPassFile = MSHash( sPassFile + Chr$(0), WhichHash, Chr$(0) ) ' Set the key to the hex Hash of the file contents [COLOR="Red"]WRONG We are hashing the filepath[/COLOR]
                          sPassFile = MSHash( sPassFile, WhichHash, Chr$(0) ) ' Set the key to the hex Hash of the file contents
                      
                          If sPassFile = "" Then
                            MsgBox "Oh dear, MSHash has thrown a wobbly!"
                            GoTo PullOut
                          End If
                        End If
                        
                        If AuthDec2( sFile, WhichAlgorithm, sPassFile ) = "" Then
                          MsgBox "Encryption failed"
                          GoTo PullOut
                        End If
                        
                        MsgBox "Wait - if you want to check with your file manager"
                        
                        If AuthDec2( sFile + ".enc", WhichAlgorithm, sPassFile ) = "" Then
                          MsgBox "Decryption failed"
                        Else
                          MsgBox "Its turned out nice <smile>"
                        End If
                      
                      PullOut:
                      
                      End Function
                      Last edited by David Roberts; 21 Nov 2009, 02:59 AM. Reason: We were hashing the filepath

                      Comment


                      • #12
                        I am trying to us the mshash.dll and am getting an error.

                        I am using the 11/19/2009 version of the dll.

                        Code follows:

                        %NOMMIDS = 1
                        %NOGDI = 1

                        %MD5 = 32771
                        %SHA1 = 32772
                        %SHA256 = 32780
                        %SHA384 = 32781
                        %SHA512 = 32782

                        DECLARE FUNCTION HashRoutine LIB "MSHash.DLL" ALIAS "MSHash" (BYVAL sText AS STRING, BYVAL WhichHash AS LONG, BYVAL HMACKey AS STRING ) AS STRING

                        ...

                        sResult = HashRoutine("C:\dell.sdr", %SHA256,"")
                        IF sResult <> "" THEN
                        MSGBOX sResult
                        ELSE
                        MSGBOX "Failed"
                        END IF


                        Error: Unable to find passfile ''
                        Then the next dialog says failed.

                        I am just trying to create a hash from a file...

                        Thanks,
                        Rob

                        Comment


                        • #13
                          sResult = HashRoutine("C:\dell.sdr", %SHA256, Chr$(0))

                          See post #10.

                          Robert, discussions are not allowed in the Source Code forum.

                          Comment


                          • #14
                            MSHashLib

                            This is simply MSHash plus the ability to use the hashing object with VBScript by implementing the PowerLib concept.

                            Parameters

                            sText
                            [in] The message to digest as a text string or file. If a text string then it must be null terminated.

                            WhichHash
                            [in] MD5, SHA1, SHA256, SHA384 or SHA512

                            With PB we can use:

                            Code:
                            %MD5 = 32771 OR %CALG_MD5
                            %SHA1 = 32772 OR %CALG_SHA1
                            %SHA256 = 32780 OR %CALG_SHA_256
                            %SHA384 = 32781 OR %CALG_SHA_384
                            %SHA512 = 32782 OR %CALG_SHA_512
                            With VBScript we can use:

                            Code:
                            Const MD5 = 32771
                            Const SHA1 = 32772
                            Const SHA256 = 32780
                            Const SHA384 = 32781
                            Const SHA512 = 32782
                            sHMACKey ie 'password'

                            [in] may be a text string, binary string [if wholly hexadecimal and even numbered] or a file.

                            Similarly with sText if a text or binary string then it must be null terminated.

                            If a file is used then it will be hashed according to WhichHash and the resulting hash used as
                            a binary string password.

                            If empty then an ordinary hash will be determined - but it must still be null terminated so
                            we can use either "" + Chr$(0) or simply Chr$(0).

                            Return Values

                            If the function succeeds, the return value will be a hexadecimal string. If the function fails, the return value is an empty string.

                            For PB we could use

                            Code:
                            Declare Function MSHashLib Lib "MSHashLib.DLL" Alias "MSHashLib" _
                                  ( ByVal sText As String, ByVal WhichHash As Long, _
                                    ByVal HMACKey As String ) As String
                            along with

                            Code:
                            ' HMAC a string using a binary string password
                              sResult = MSHashLib("The quick brown fox jumps over the lazy dog" + Chr$(0), %CALG_MD5, _
                              "79F783B346C3BC751F5D61FEB66015C1" + Chr$(0) )
                              If sResult <> "" Then
                                MsgBox "HMAC a string using a binary string password" + $CrLf+ $CrLf + sResult
                              Else
                                MsgBox "Failed"
                              End If
                            Example full VBScript code; with the operative words highlighted.

                            Code:
                            Dim Hash, Password
                            Const MD5 = 32771
                            Const SHA1 = 32772
                            Const SHA256 = 32780
                            Const SHA384 = 32781
                            Const SHA512 = 32782
                             
                            Set Hash = CreateObject("[COLOR="Blue"]MSHashCom[/COLOR]")
                             
                            Password = "79F783B346C3BC751F5D61FEB66015C1" + Chr(0)
                             
                            MsgBox Hash.[COLOR="Blue"]Result[/COLOR]("The quick brown fox jumps over the lazy dog" + Chr(0), MD5, Password ), _
                            vbOKOnly  + vbInformation, "MSHashLib"
                            MSHashLib.dll needs to be registered via 'regsvr32 Filepath to MSHashLib.dll'

                            Note: I was using the MSHash.dll benchmark against the VBScript and when I changed the benchmark to use MSHashLib I got a name conflict. I also used the MSHash resource as a base. The attached version is properly named and at 1.0.1.

                            Don't forget: >= XP SP3 - no checking done. My MSCrypto GUI checks but not this dll.
                            Attached Files
                            Last edited by David Roberts; 7 Aug 2010, 09:09 AM. Reason: New zip attached

                            Comment


                            • #15
                              I should have created a new folder for MSHashLib. I usually do, but on this occasion I erred.

                              I hadn't changed

                              Method = MSHash( sText, WhichHash, sMasterkey ) ... [1]

                              to

                              Method = MSHashLib( sText, WhichHash, sMasterkey ) ... [2]

                              MSHash is declared in my cryptographic include file and in the same folder as MSHashLib so [1] was using MSHash's export instead of MSHashLib's export.

                              If you have both MSHash and MSHashLib in the same folder then MSHashLib will work. If not then MSHashLib will fail.

                              A corrected version [1.02], ie using [2], is uploaded above.

                              Comment


                              • #16
                                A natural progression is to go beyond VBScript. The Method 'Return' expects Unicode parameters.

                                'Return' has been replaced with 'Unicode' and the Method 'ANSI' has been added.

                                VBScript
                                Code:
                                Dim Hash
                                Const MD5 = 32771
                                 
                                Set Hash = CreateObject("MSHashCom")
                                 
                                MsgBox Hash.[COLOR="Blue"]Unicode[/COLOR]("The quick brown fox jumps over the lazy dog" + Chr(0), MD5, _
                                "79F783B346C3BC751F5D61FEB66015C1" + Chr(0)), _
                                vbSystemModal, "VBScript"
                                PowerBASIC
                                Code:
                                #Compile  Exe
                                #Register None
                                #Dim All
                                 
                                %MD5 = 32771
                                 
                                $PROGID_MSHashTLB_MSHASHCOM = "MSHASHCOM"
                                $CLSID_MSHashTLB_MSHASHCOM = Guid$("{6AB816A7-9E8F-430E-9774-AE247DDE4E12}")
                                $IID_MSHashTLB_MSHashTLB = Guid$("{678522FF-2E9C-4577-BBBD-BF48F4656169}")
                                 
                                Interface MSHashTLB $IID_MSHashTLB_MSHashTLB
                                  Inherit IDispatch
                                 
                                  Method Unicode <257> (ByVal STEXT As String, ByVal WHICHHASH As Long, ByVal SMASTERKEY As String) As Variant
                                  Method ANSI <258> (ByVal STEXT As String, ByVal WHICHHASH As Long, ByVal SMASTERKEY As String) As String
                                End Interface
                                 
                                Function PBMain () As Long
                                Local Hash As MSHashTLB
                                 
                                  Hash = NewCOM CLSID $CLSID_MSHashTLB_MSHASHCOM Lib "MSHashLib.Dll"
                                 
                                  MsgBox Hash.[COLOR="Blue"]ANSI[/COLOR]("The quick brown fox jumps over the lazy dog" + Chr$(0), %MD5, _
                                  "79F783B346C3BC751F5D61FEB66015C1" + Chr$(0)), _
                                  %MB_SYSTEMMODAL
                                 
                                End Function
                                Where the equates were got from the PowerBASIC COM browser.

                                Here is the output from the above. "Oh, look Ma - they are the same." "You would have gotten a clip around the ear if they hadn't been." "Yes, Ma"

                                So, if you have a language which supports COM DLLs the question is whether it passes string parameters in Unicode or ANSI.

                                V1.03 uploaded above
                                Attached Files
                                Last edited by David Roberts; 7 Aug 2010, 09:24 AM.

                                Comment


                                • #17
                                  PBWin/PBCC SHA256/384/512 in XP SP3 (For old Compiler)

                                  The best way I've been able to get your code to work on an old PBCC compiler. No #includes are active as the new style includes need a lot of tweaking to work. Also I noted that when getting the parameter for size is used before getting the actual hash results there is no actual results available. Using your hint I dropped it and then it worked. So now it is relocated in an initialization process instead.


                                  Code:
                                  'David ROBERTS'
                                  
                                  #COMPILE EXE "MsHashFn.exe"
                                  #DIM ALL
                                  '#REGISTER NONE
                                  #TOOLS OFF
                                  
                                  '%PB_WIN32       'Compiler supplied?
                                  ':: %PB_CC32 = 1 'Compiler supplied?
                                  
                                  %NOMMIDS     = 1
                                  %NOGDI       = 1
                                  
                                  '#INCLUDE "C:\Documents and Settings\All Users\Documents\Computer Programming\PowerBasic\PB_Forum (INC & APIs)\Win32API\WIN32API.inc" ' 27 August 2009
                                  '#INCLUDE "C:\Documents and Settings\All Users\Documents\Computer Programming\PowerBasic\PB_Forum (INC & APIs)\Win32API\WinCrypt.inc"
                                  
                                  
                                  
                                  'Declare Function zTrace Lib "zTrace.DLL" Alias "zTrace" (zMessage As Asciiz) As Long
                                  
                                                      'WinUser.inc, Ln 6210
                                  %MB_ICONHAND               = &H00000010
                                                      'WinUser.inc, Ln 6218
                                  %MB_ICONERROR              = %MB_ICONHAND
                                                      'WinUser.inc, Ln 6243
                                  %MB_TOPMOST                = &H00040000
                                                      'WinUser.inc, Ln 6365
                                  DECLARE FUNCTION MessageBoxA LIB "User32.dll" ALIAS "MessageBoxA" _
                                      (BYVAL hWnd AS DWORD, lpText AS ASCIIZ, lpCaption AS ASCIIZ, _
                                      BYVAL dwType AS DWORD) AS LONG
                                  '========================================
                                  
                                                      'Winbase.inc, Ln 22
                                  :: %INVALID_HANDLE_VALUE     = &HFFFFFFFF
                                                      'Winbase.inc, Ln 102
                                  :: %FILE_FLAG_NO_BUFFERING        = &H020000000
                                  '  %FILE_FLAG_RANDOM_ACCESS       = &H010000000
                                  :: %FILE_FLAG_SEQUENTIAL_SCAN     = &H008000000
                                                      'Winbase.inc, Ln 114
                                  :: %OPEN_EXISTING     = 3
                                                      'Winbase.inc, Ln 2984
                                  :: %FORMAT_MESSAGE_ALLOCATE_BUFFER= &H00000100
                                  :: %FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
                                  ''' %FORMAT_MESSAGE_FROM_STRING    = &H00000400
                                  ''' %FORMAT_MESSAGE_FROM_HMODULE   = &H00000800
                                  :: %FORMAT_MESSAGE_FROM_SYSTEM    = &H00001000
                                  ''' %FORMAT_MESSAGE_ARGUMENT_ARRAY = &H00002000
                                  ''' %FORMAT_MESSAGE_MAX_WIDTH_MASK = &H000000FF
                                                      'Winbase.inc, Ln 226
                                  :: TYPE OVERLAPPED_type
                                  ::    Offset     AS DWORD
                                  ::    OffsetHigh AS DWORD
                                  :: END TYPE
                                  
                                  :: UNION OVERLAPPED_union
                                  ::    OVERLAPPED_type
                                  ::    pPointer AS DWORD
                                  ::END UNION
                                  
                                  :: TYPE OVERLAPPED
                                  ::    Internal     AS DWORD
                                  ::    InternalHigh AS DWORD
                                  ::    OVERLAPPED_union
                                  ::    hEvent       AS DWORD
                                  ::END TYPE
                                                      'Winbase.inc. Ln 251
                                  TYPE SECURITY_ATTRIBUTES
                                      nLength              AS DWORD
                                      lpSecurityDescriptor AS DWORD
                                      bInheritHandle       AS LONG
                                  END TYPE
                                                      'WinBase.inc, Ln 2216
                                  DECLARE FUNCTION GetLastError LIB "Kernel32.dll" ALIAS "GetLastError" () AS LONG
                                                      'WinBase.inc, Ln 1436
                                  DECLARE FUNCTION LocalFree LIB "Kernel32.dll" ALIAS "LocalFree" _
                                      (BYVAL hMem AS DWORD) AS DWORD
                                                      'WinBase.inc, Ln 1483
                                  DECLARE FUNCTION VirtualAlloc LIB "Kernel32.dll" ALIAS "VirtualAlloc" _
                                      (BYVAL lpAddress AS DWORD, BYVAL dwSize AS DWORD, _
                                      BYVAL flAllocationType AS DWORD, BYVAL flProtect AS DWORD) AS DWORD
                                                      'WinBase.inc, Ln 1498
                                  DECLARE FUNCTION VirtualFree LIB "Kernel32.dll" ALIAS "VirtualFree" _
                                      (BYVAL lpAddress AS DWORD, BYVAL dwSize AS DWORD, _
                                      BYVAL dwFreeType AS DWORD) AS LONG
                                                      'Winbase.inc, Ln 8438
                                  DECLARE FUNCTION QueryPerformanceCounter LIB "Kernel32.dll" _
                                      ALIAS "QueryPerformanceCounter" (lpPerformanceCount AS QUAD) AS LONG
                                                      'Winbase.inc, Ln 8441
                                  DECLARE FUNCTION QueryPerformanceFrequency LIB "Kernel32.dll" _
                                      ALIAS "QueryPerformanceFrequency" (lpFrequency AS QUAD) AS LONG
                                                      'Winbase.inc, Ln 5497
                                  DECLARE FUNCTION CreateFileA LIB "Kernel32.dll" ALIAS "CreateFileA" _
                                      (lpFileName AS ASCIIZ, BYVAL dwDesiredAccess AS DWORD, _
                                      BYVAL dwShareMode AS DWORD, lpSecurityAttributes AS SECURITY_ATTRIBUTES, _
                                      BYVAL dwCreationDisposition AS DWORD, _
                                      BYVAL dwFlagsAndAttributes AS DWORD, BYVAL hTemplateFile AS DWORD) _
                                      AS DWORD
                                                      'Winbase.inc, Ln 2567
                                  DECLARE FUNCTION ReadFile LIB "Kernel32.dll" ALIAS "ReadFile" _
                                      (BYVAL hFile AS DWORD, BYVAL lpBuffer AS DWORD, _
                                      BYVAL nNumberOfBytesToRead AS DWORD, lpNumberOfBytesRead AS DWORD, _
                                      lpOverlapped AS OVERLAPPED) AS LONG
                                                      'Winbase.inc, Ln 2643
                                  DECLARE FUNCTION CloseHandle LIB "Kernel32.dll" ALIAS "CloseHandle" _
                                      (BYVAL hObject AS DWORD) AS LONG
                                                      'Winbase.inc, Ln 2958
                                  DECLARE FUNCTION FormatMessageA LIB "Kernel32.dll" ALIAS "FormatMessageA" _
                                      (BYVAL dwFlags AS DWORD, BYVAL lpSource AS DWORD, _
                                      BYVAL dwMessageId AS DWORD, BYVAL dwLanguageId AS DWORD, _
                                      lpBuffer AS ASCIIZ, BYVAL nSize AS DWORD, BYVAL Arguments AS DWORD) _
                                      AS DWORD
                                  '========================================
                                  
                                                      'WinNT.inc
                                  :: %GENERIC_READ                   = (&H80000000)
                                  '========================================
                                  
                                                      'WinCrypt.inc, Ln 430
                                  :: %HP_ALGID              = &H0001  ' Hash algorithm
                                  :: %HP_HASHVAL            = &H0002  ' Hash value
                                  :: %HP_HASHSIZE           = &H0004  ' Hash value size
                                                      'WinCrypt.inc, Ln 979
                                  DECLARE FUNCTION CryptAcquireContextA LIB "AdvAPI32.dll" _
                                     ALIAS "CryptAcquireContextA" (phProv AS DWORD, szContainer AS ASCIIZ, _
                                      szProvider AS ASCIIZ, BYVAL dwProvType AS DWORD, BYVAL dwFlags AS DWORD) AS LONG
                                                      'WinCrypt.inc, Ln 1036 & 1044
                                  DECLARE FUNCTION CryptReleaseContext LIB "AdvAPI32.dll" _
                                      ALIAS "CryptReleaseContext" (BYVAL hProv AS DWORD, BYVAL dwFlags AS DWORD) _
                                      AS LONG
                                                      'WinCrypt.inc, Ln 1143
                                  DECLARE FUNCTION CryptCreateHash LIB "AdvAPI32.dll" ALIAS "CryptCreateHash" _
                                      (BYVAL hProv AS DWORD, BYVAL Algid AS DWORD, BYVAL hKey AS DWORD, _
                                      BYVAL dwFlags AS DWORD, phHash AS DWORD) AS LONG
                                                      'WinCrypt.inc, Ln 1147
                                  DECLARE FUNCTION CryptHashData LIB "AdvAPI32.dll" ALIAS "CryptHashData" _
                                      (BYVAL hHash AS DWORD, BYVAL pbData AS BYTE PTR, BYVAL dwDataLen AS DWORD, _
                                      BYVAL dwFlags AS DWORD) AS LONG
                                                      'WinCrypt.inc, Ln 1097
                                  DECLARE FUNCTION CryptGetHashParam LIB "AdvAPI32.dll" ALIAS "CryptGetHashParam" _
                                      (BYVAL hHash AS DWORD, BYVAL dwParam AS DWORD, BYVAL pbData AS BYTE PTR, _
                                      pdwDataLen AS DWORD, BYVAL dwFlags AS DWORD) AS LONG
                                                      'WinCrypt.inc, Ln 1155
                                  DECLARE FUNCTION CryptDestroyHash LIB "AdvAPI32.dll" ALIAS "CryptDestroyHash" _
                                      (BYVAL hHash AS DWORD) AS LONG
                                  
                                  
                                  
                                  ::: %TRUE  = 1
                                  ::: %Null  = 0
                                  ::: %FALSE = 0
                                  
                                  %BufferSize   = 65536
                                  %Text = 0
                                  %File = 1
                                  ::%Ini = -1
                                  
                                  :: %MEM_COMMIT           =&H1000
                                  '%MEM_RESERVE          =&H2000
                                  '%MEM_DECOMMIT         =&H4000
                                  :: %MEM_RELEASE          =&H8000 '?? was &H80000??
                                  '%MEM_FREE            =&H10000
                                  '%MEM_PRIVATE         =&H20000
                                  '%MEM_MAPPED          =&H40000
                                  ';%MEM_RESET           =&H80000
                                  :: %MEM_TOP_DOWN       =&H100000
                                  :: %PAGE_READWRITE         =&H04
                                  'WinCrypt
                                  :: %PROV_RSA_AES          = 24
                                  :: $MS_ENH_RSA_AES_PROV_A   = "Microsoft Enhanced RSA and AES Cryptographic Provider"
                                  '''' $$MS_ENH_RSA_AES_PROV_W  = "Microsoft Enhanced RSA and AES Cryptographic Provider"$$
                                  :: $MS_ENH_RSA_AES_PROV_XP_A  = "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)"
                                  '''' $$MS_ENH_RSA_AES_PROV_XP_W = "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)"$$
                                  :: %CRYPT_VERIFYCONTEXT   = &HF0000000
                                  
                                  GLOBAL App AS STRING
                                  :: $App = "MsHashFn.exe"
                                  GLOBAL hProv AS LONG
                                  GLOBAL ReadBuffer AS DWORD PTR
                                  :: GLOBAL sO AS STRING
                                  :: GLOBAL WinErr AS LONG
                                  :: GLOBAL i AS LONG
                                  :: GLOBAL bAlgSz() AS LONG
                                                                          
                                  
                                  ' Macros [Moved and made a sub-routine
                                  'MACRO SysErrMsg( API, Number ) = MessageBox 0, SystemErrorMessage( WinErr, API, FUNCNAME$, Number ), BYVAL STRPTR(App), %MB_ICONERROR + %MB_TOPMOST
                                  
                                  GLOBAL qFreq     AS QUAD
                                  GLOBAL qStart()  AS QUAD
                                  GLOBAL qStop()   AS QUAD
                                  GLOBAL qOverhead AS QUAD
                                  
                                  '::: DECLARE SUB InitializeTimer
                                  
                                  
                                  
                                  'Was 'MACRO'
                                  MACRO InitializeTimer
                                    DIM qStart( 0 TO 15) AS GLOBAL QUAD
                                    DIM qStop( 0 TO 15 ) AS GLOBAL QUAD
                                    QueryPerformanceFrequency qFreq
                                    QueryPerformanceCounter qStart(0) ' Intel suggestion. First use may be suspect
                                    QueryPerformanceCounter qStart(0) ' So, wack it twice <smile>
                                    QueryPerformanceCounter qStop(0)
                                    qOverhead = qStop(0) - qStart(0)  ' Relatively small
                                  END MACRO
                                  
                                  MACRO StartTimer(i) = QueryPerformanceCounter qStart(i)
                                  MACRO StopTimer(i) = QueryPerformanceCounter qStop(i)
                                  
                                  ' In the following i is the ith timer and 0 <= j <= 3 For 0 To 3 decimal places
                                  MACRO sTimeTaken( i, j ) = USING$(CHOOSE$(j+1,"####","####.#", "####.##","####.###"), (qStop(i) - qStart(i) - qOverhead)*1000/qFreq) + "ms"
                                  MACRO nTimeTaken(i) = (qStop(i) - qStart(i) - qOverhead)*1000/qFreq
                                  ' End Macros
                                  
                                  
                                  DECLARE FUNCTION crGetDefaultRSAHandle AS LONG
                                  
                                  DECLARE FUNCTION TestCryptAquired( WhichHash AS LONG ) AS LONG
                                  DECLARE FUNCTION Hash( sText AS STRING, WhichHash AS LONG, HashHex AS STRING, BYVAL Flag AS LONG ) AS LONG
                                  
                                  DECLARE FUNCTION FileToHash( sFile AS STRING, hHash AS LONG ) AS LONG
                                  DECLARE FUNCTION TextToHash( sText AS STRING, hHash AS LONG ) AS LONG
                                  DECLARE FUNCTION GetHash( HashHex AS STRING, hHash AS LONG ) AS LONG
                                  DECLARE FUNCTION TestGetHashSize( hHash AS LONG ) AS LONG
                                  DECLARE FUNCTION SystemErrorMessage( BYVAL WinErr AS LONG, API AS STRING, sFunction AS STRING, BYVAL Number AS LONG ) AS STRING
                                  
                                  DECLARE SUB SysErrMsg( API AS STRING , Number AS LONG )
                                                                                             
                                  ' was Macros
                                  'MACRO SysErrMsg( API, Number ) = MessageBox 0, SystemErrorMessage( WinErr, API, FUNCNAME$, Number ), BYVAL STRPTR(App), %MB_ICONERROR + %MB_TOPMOST
                                  SUB SysErrMsg( API AS STRING, Number AS LONG )
                                  LOCAL sT AS ASCIIZ * ( 32 * 1024 - 10 )
                                      sT = SystemErrorMessage( BYVAL WinErr, API, FUNCNAME$, Number )
                                      MessageBoxA 0, sT, BYVAL STRPTR(App), %MB_ICONERROR + %MB_TOPMOST
                                  END SUB
                                  
                                  
                                  ' ~~~~~~~~~~~~~
                                  
                                  FUNCTION PBMAIN
                                  
                                    LOCAL Message AS STRING
                                    LOCAL sText   AS STRING
                                    LOCAL HashHex AS STRING
                                    '' LOCAL WinErr  AS LONG  [now Global]
                                    'LOCAL i       AS LONG  [now Global]
                                    LOCAL lResult AS LONG
                                    LOCAL Flag    AS LONG
                                    LOCAL L       AS LONG
                                  
                                    ' Initialize
                                      DIM Alg( 1 TO 5 ) AS LONG
                                      Alg(1) = &H00008003  '%CALG_MD5
                                      Alg(2) = &H00008004  '%CALG_SHA1  Same as %CALG_SHA
                                      Alg(3) = &H0000800C  '%CALG_SHA_256
                                      Alg(4) = &H0000800D  '%CALG_SHA_384
                                      Alg(5) = &H0000800E  '%CALG_SHA_512
                                  
                                      DIM sAlg( 1 TO 5 ) AS STRING
                                      sAlg(1) = "MD5"
                                      sAlg(2) = "SHA1"
                                      sAlg(3) = "SHA256"
                                      sAlg(4) = "SHA384"
                                      sAlg(5) = "SHA512"
                                  
                                  ::    DIM bAlgSz( 1 TO 5 ) AS GLOBAL LONG
                                  ::    bAlgSz(1) = 128  'for %CALG_MD5
                                  ::    bAlgSz(2) = 160  'for %CALG_SHA1  Same as %CALG_SHA
                                  ::    bAlgSz(3) = 256  'for %CALG_SHA_256
                                  ::    bAlgSz(4) = 384  'for %CALG_SHA_384
                                  ::    bAlgSz(5) = 512  'for %CALG_SHA_512
                                  
                                  
                                  
                                      hProv = crGetDefaultRSAHandle
                                      IF hProv = 0 THEN EXIT FUNCTION 'We have already been advised of a failure
                                      
                                      
                                  
                                      ReadBuffer = VirtualAlloc( BYVAL %Null, %BufferSize, %MEM_COMMIT OR %MEM_TOP_DOWN, %PAGE_READWRITE )
                                      ' Buffer addresses for read and write operations should be sector aligned when using FILE_FLAG_NO_BUFFERING
                                      IF ISFALSE ReadBuffer THEN
                                        WinErr = GetLastError
                                        'SysErrMsg( "VirtualAlloc", 10 )
                                        PRINT "VirtualAlloc Errored:"; WinErr: LINE INPUT sO
                                        EXIT FUNCTION
                                      END IF
                                  
                                      InitializeTimer
                                  
                                  '    App = Exe.Name$ ' For the SysErrMsg macro
                                    ' End of initialization
                                  
                                    'sText = "Whatever" ' Your filepath here
                                    :: sText = "C:\TestHashThis.txt
                                  
                                    i = 1: Flag = %Ini
                                    
                                    #IF %DEF(%PB_CC32)
                                      PRINT "Initialization Test of the ~RSA Context~ acquired" : PRINT
                                    #ENDIF
                                    FOR i = 1 TO 5
                                      StartTimer(0)
                                        '''PRINT "Testing Crypt function's Acquired Context: ";
                                        lResult = TestCryptAquired( Alg( i ) )
                                        IF lResult = 0 THEN PRINT "FUNCTION FAILED tests for "; sAlg( i ); "." ELSE _
                                          PRINT "FUNCTION PASSES tests for "; sAlg( i ); "."
                                      StopTimer(0)
                                      GOSUB DisplayTime_Hash
                                    NEXT i
                                    
                                    PRINT "Execute a dummy run so File accessing tests likely make no more calls on the drive and ~level the playing field~.
                                    PRINT "Text tests are likely more accurate of the Hashing Speed's ratios of the various types of Checksums used.
                                    PRINT
                                    :: i = 1
                                    :: Flag = %File
                                    StartTimer(0)
                                    lResult = Hash( sText, Alg( i ), HashHex, Flag )
                                    StopTimer(0)
                                    GOSUB DisplayTime_Hash
                                    '---------------------
                                    
                                    Message = "File" + $TAB + sText + $CRLF + $CRLF
                                    #IF %DEF(%PB_CC32)
                                      PRINT "File" : PRINT
                                    #ENDIF
                                    Flag = %File
                                    GOSUB HashForResults
                                    '---------------------
                                  
                                    sText = "The quick brown fox jumps over the lazy dog.  "
                                    FOR L = 1 TO 9: sText = sText & sText: NEXT L
                                    PRINT "LEN( sText ) ="; LEN( sText ) * 32000
                                    
                                    Message = Message + $CRLF + "Text" + $CRLF + $CRLF
                                    #IF %DEF(%PB_CC32)
                                      PRINT : PRINT "Text" : PRINT
                                    #ENDIF
                                    Flag = %Text
                                    GOSUB HashForResults
                                    '---------------------
                                  
                                    #IF %DEF(%PB_WIN32)
                                      'MsgBox Message, , App
                                      'Box, , App
                                    #ELSE
                                      PRINT: PRINT "Press a key to exit"
                                      WAITKEY$
                                    #ENDIF
                                  
                                    ' Tidy up
                                    CryptReleaseContext hProv, 0
                                    VirtualFree BYVAL ReadBuffer, %Null, %MEM_RELEASE
                                  
                                    EXIT FUNCTION
                                  
                                  HashForResults:
                                  
                                    FOR i = 1 TO 5
                                      StartTimer(0)
                                        lResult = Hash( sText, Alg(i), HashHex, Flag )
                                      StopTimer(0)
                                      GOSUB DisplayTime_Hash
                                    NEXT i
                                  
                                    RETURN
                                    
                                  
                                  DisplayTime_Hash:
                                        IF lResult = %TRUE THEN
                                          #IF %DEF(%PB_WIN32)
                                            IF i < 4 THEN
                                              IF ABS( Flag ) = %File THEN
                                                Message = Message + sAlg(i) + $TAB + sTimeTaken(0,2) + "    " + HashHex + $CRLF + $CRLF
                                              ELSE
                                                Message = Message + sAlg(i) + $TAB + HashHex + $CRLF + $CRLF
                                              END IF
                                            ELSE
                                              IF ABS( Flag ) = %File THEN
                                                Message = Message + sAlg(i) + $TAB + sTimeTaken(0,2) + "    "
                                              ELSE
                                                Message = Message + sAlg(i) + $TAB
                                              END IF
                                              L = LEN( HashHex ) \ 2
                                              Message = Message + LEFT$(HashHex, L-4) + $CRLF + $TAB + MID$(HashHex, L-3) + $CRLF + $CRLF
                                            END IF
                                          #ELSE
                                            IF i < 4 THEN
                                              IF Flag > %Ini THEN
                                                PRINT sAlg(i); " "; sTimeTaken(0,2);" ";HashHex
                                                PRINT
                                              ELSE
                                                'PRINT sAlg(i); " ";HashHex
                                                PRINT sAlg(i);sTimeTaken(0,2)
                                                PRINT
                                              END IF
                                            ELSE
                                              IF Flag > %Ini  THEN
                                                PRINT sAlg(i); " ";sTimeTaken(0,2)
                                              L = LEN(HashHex)\2
                                              :: PRINT "  ";LEFT$(HashHex, L)
                                              :: PRINT "  ";RIGHT$(HashHex, L)
                                              :: PRINT
                                              ELSE
                                                'PRINT sAlg(i)
                                                PRINT sAlg(i); " ";sTimeTaken(0,2)
                                              END IF
                                              'L = LEN(HashHex)\2
                                              'PRINT "  ";LEFT$(HashHex, L)
                                              'PRINT "  ";RIGHT$(HashHex, L)
                                              'PRINT
                                            END IF
                                          #ENDIF
                                        ELSE
                                          #IF %DEF(%PB_WIN32)
                                            Message = Message + sAlg(i) + " Failed" + $CRLF + $CRLF
                                          #ELSE
                                            PRINT sAlg(i);" Failed"
                                          #ENDIF
                                      END IF
                                  
                                    RETURN
                                  
                                  END FUNCTION
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION TestCryptAquired( WhichHash AS LONG ) AS LONG
                                  
                                    ' Input: sText is the message - text string, binary string, binary file or whatever
                                    ' WhichHash is %CALG_MD5 and so on.
                                    ' Flag is either %File or %Text
                                    ' Output: HashHex is the computed Hash value as a hex string
                                  
                                    LOCAL hHash  AS LONG
                                    LOCAL WinErr AS LONG
                                    LOCAL dwX AS LONG
                                  
                                    dwX = CryptCreateHash( hProv, WhichHash, 0, 0, hHash )
                                    IF NOT dwX = %TRUE THEN
                                      WinErr = GetLastError
                                       : SysErrMsg( "TestingCrypt Acquired: CryptCreateHash Result =" & STR$(dwX) , 10 )
                                      PRINT "TestingCrypt Acquired: CryptCreateHash Result ("; dwX; " ), System Err";  WinErr: LINE INPUT sO
                                      GOTO Failure
                                    END IF
                                  '----
                                    LOCAL Chunk     AS LONG
                                    DIM ChunkText  AS STRING * %BufferSize
                                      ::: ChunkText = "Test with this text, even if it is quite short."
                                      ::: Chunk = LEN( ChunkText )
                                      dwX = CryptHashData( hHash, VARPTR( ChunkText ), Chunk, 0 )
                                      IF NOT dwX = %TRUE THEN
                                        WinErr = GetLastError
                                        : SysErrMsg( "TestingCrypt Acquired: CryptHasData Result =" & STR$(dwX) , 10 )
                                        PRINT "TestingCrypt Acquired: CryptHasData Result ("; dwX; " ), System Err"; WinErr: LINE INPUT sO
                                        EXIT FUNCTION
                                      END IF
                                  '----
                                    IF TestGetHashSize( hHash ) = %False THEN GOTO Failure
                                    FUNCTION = %True
                                    EXIT FUNCTION
                                  
                                  Failure:
                                  
                                  END FUNCTION
                                  
                                  
                                  
                                  
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION Hash( sText AS STRING, WhichHash AS LONG, HashHex AS STRING, BYVAL Flag AS LONG ) AS LONG
                                  
                                    ' Input: sText is the message - text string, binary string, binary file or whatever
                                    ' WhichHash is %CALG_MD5 and so on.
                                    ' Flag is either %File or %Text
                                    ' Output: HashHex is the computed Hash value as a hex string
                                  
                                    LOCAL hHash  AS LONG
                                    LOCAL WinErr AS LONG
                                  
                                    IF NOT CryptCreateHash( hProv, WhichHash, 0, 0, hHash ) = %TRUE THEN
                                      WinErr = GetLastError
                                       : SysErrMsg( "CryptCreateHash", 10 )
                                      PRINT "CryptCreateHash Errored:" WinErr: LINE INPUT sO
                                      GOTO Failure
                                    END IF
                                    IF Flag = %File THEN
                                      IF FileToHash( sText, hHash ) = %False THEN GOTO Failure
                                    ELSE
                                      IF TextToHash( sText, hHash ) = %False THEN GOTO Failure
                                    END IF
                                    IF GetHash( HashHex, hHash ) = %False THEN GOTO Failure
                                    FUNCTION = %True
                                    EXIT FUNCTION
                                  
                                  Failure:
                                  
                                  END FUNCTION
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION crGetDefaultRSAHandle AS LONG
                                    LOCAL WinErr AS LONG
                                  
                                    IF NOT CryptAcquireContextA( hProv, BYVAL %Null, BYVAL %Null, %PROV_RSA_AES, 0 ) = %TRUE THEN
                                      IF NOT CryptAcquireContextA( hProv, BYVAL %Null, $MS_ENH_RSA_AES_PROV_A, %PROV_RSA_AES, %CRYPT_VERIFYCONTEXT ) = %TRUE THEN
                                        WinErr = GetLastError
                                         : SysErrMsg( "CryptAcquireContext", 10 )
                                        PRINT "CryptAcquireContext ERROR ="; WinErr: LINE INPUT sO
                                      ELSE
                                        FUNCTION = hProv
                                      END IF
                                    ELSE
                                      FUNCTION = hProv
                                    END IF
                                  
                                  END FUNCTION
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION FileToHash( sFile AS STRING, hHash AS LONG ) AS LONG
                                  
                                    LOCAL hFile   AS LONG
                                    LOCAL WinErr  AS LONG
                                    LOCAL zFile  AS ASCIIZ * 256
                                    LOCAL nbLoaded AS DWORD
                                  
                                    zFile = sFile
                                    hFile = CreateFileA( zFile, %GENERIC_READ, 0, BYVAL 0, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN OR %FILE_FLAG_NO_BUFFERING, BYVAL 0 )
                                    IF hFile = %INVALID_HANDLE_VALUE THEN
                                      WinErr = GetLastError
                                       : SysErrMsg( "CreateFile", 10 )
                                      PRINT "CreateFile Errored:"; WinErr: LINE INPUT sO
                                      EXIT FUNCTION
                                    END IF
                                    DO
                                      IF NOT ReadFile( hFile, BYVAL ReadBuffer, %BufferSize, nbLoaded, BYVAL 0 ) = %TRUE THEN
                                        WinErr = GetLastError
                                         : SysErrMsg( "ReadFile", 20 )
                                        PRINT "Read File Errored:"; WinErr: LINE INPUT sO
                                        CloseHandle( hFile )
                                        EXIT FUNCTION
                                      END IF
                                      IF nbLoaded = 0 THEN EXIT LOOP
                                      IF NOT CRYPTHASHDATA( hHash, BYVAL ReadBuffer, nbLoaded, 0 ) = %TRUE THEN
                                        WinErr = GetLastError
                                         : SysErrMsg( "CryptHashData", 30 )
                                        PRINT "CryptHashData Errored:"; WinErr: LINE INPUT sO
                                        CloseHandle( hFile )
                                        EXIT FUNCTION
                                      END IF
                                    LOOP UNTIL nbLoaded < %BufferSize
                                    CloseHandle( hFile )
                                    FUNCTION = %True
                                  
                                  END FUNCTION
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION TextToHash( sText AS STRING, hHash AS LONG ) AS LONG
                                    LOCAL WinErr    AS LONG
                                    LOCAL Chunk     AS LONG
                                    LOCAL NextChunk AS LONG
                                    LOCAL Balance   AS LONG
                                    LOCAL Completed AS LONG
                                    LOCAL dummy     AS LONG
                                    DIM ChunkText  AS STRING * %BufferSize
                                    'LOCAL psChunkText AS STRING POINTER
                                    LOCAL dwX AS DWORD
                                  
                                  ::FOR dwX = 1 TO 32000
                                  
                                    Chunk = %BufferSize
                                    dummy = LEN( sText )
                                    Balance = dummy MOD Chunk
                                    Completed = %False
                                    NextChunk = 1
                                    DO
                                      ChunkText = MID$( sText, NextChunk, Chunk )
                                      IF NextChunk + Chunk >= dummy THEN
                                        IF Balance = 0 THEN EXIT LOOP
                                        Chunk = Balance
                                        Completed = %TRUE
                                      END IF
                                      
                                      IF NOT CryptHashData( hHash, VARPTR( ChunkText ), Chunk, 0 ) = %TRUE THEN
                                        WinErr = GetLastError
                                        : SysErrMsg( "CryptHasData", 10 )
                                        PRINT "CryptHasData Errored:"; WinErr: LINE INPUT sO
                                        EXIT FUNCTION
                                      END IF
                                      NextChunk = NextChunk + Chunk
                                    LOOP UNTIL completed
                                  
                                  :: NEXT dwX
                                  
                                    FUNCTION = %TRUE
                                  
                                  END FUNCTION
                                               
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION GetHash( HashHex AS STRING, hHash AS LONG ) AS LONG
                                    '#REGISTER NONE
                                    'REGISTER i AS LONG
                                    REGISTER x AS LONG
                                    LOCAL hSize  AS LONG
                                    LOCAL WinErr AS LONG
                                  ':: DIM bAlgSz( 1 TO 5 ) AS GLOBAL LONG
                                    DIM hByte( )  AS BYTE
                                    DIM hByteHex( )  AS STRING * 2
                                  
                                    '::: PRINT "GetHash:"; i; bAlgSz( i );
                                  
                                    'IF CryptGetHashParam( hHash, %HP_HASHSIZE, hSize, 4, 0 ) = %False THEN
                                    '  WinErr = GetLastError
                                    '  : SysErrMsg( "CryptGetHashParam", 10 )
                                    '  PRINT "CryptGetHashParam Errored getting HashSize:"; WinErr: LINE INPUT sO
                                    '  EXIT FUNCTION
                                    'END IF
                                    ::: hSize = bAlgSz( i ) / 8
                                    '::: PRINT hSize
                                    REDIM hByte( hSize - 1 ) AS BYTE
                                    x = CryptGetHashParam( hHash, %HP_HASHVAL, VARPTR( hByte( 0 ) ), hSize, 0 )
                                    IF NOT x = %TRUE THEN
                                      WinErr = GetLastError
                                  
                                        : SysErrMsg( "Testing Crypt Acquired: CryptHasData Result =" & STR$( x ) , 10 )
                                        PRINT "Testing Crypt Acquired: CryptHasData Result ("; x; " ), System Err"; WinErr: LINE INPUT sO
                                  
                                  
                                      : SysErrMsg( "Get Hash: CryptGetHashParam Result =" & STR$( x ) , 20 )
                                      PRINT "Get Hash: CryptGetHashParam Result ("; x; " ), System Err"; WinErr: LINE INPUT sO
                                      EXIT FUNCTION
                                    END IF
                                  
                                    HashHex = SPACE$( 2 * hSize )
                                    REDIM hByteHex( hSize - 1 ) AS STRING * 2 AT STRPTR( HashHex )
                                    FOR x = 0 TO hSize - 1
                                      hByteHex( x ) = HEX$( hByte( x ), 2 )
                                    NEXT
                                  
                                    ' hHash is rendered useless after CryptGetHashParam so we may as well destroy it here
                                    CryptDestroyHash hHash
                                  
                                    FUNCTION = %TRUE
                                  
                                  END FUNCTION
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION TestGetHashSize( hHash AS LONG ) AS LONG
                                    LOCAL hSize  AS LONG
                                    LOCAL WinErr AS LONG
                                  ':: DIM bAlgSz( 1 TO 5 ) AS GLOBAL LONG
                                    DIM hByte( 3 )  AS BYTE
                                    DIM hByteHex( )  AS STRING * 2
                                   
                                    ::DIM iX AS INTEGER
                                  
                                  
                                    '::: PRINT "GetHash:"; i; bAlgSz( i );
                                    
                                    '''IF NOT CryptGetHashParam( hHash, %HP_ALGID, VARPTR( hByte() ), hSize, 0 ) = %TRUE THEN
                                  
                                    IF NOT CryptGetHashParam( hHash, %HP_HASHSIZE, VARPTR( hByte(0) ), 4, 0 ) = %TRUE THEN
                                      WinErr = GetLastError
                                      : SysErrMsg( "CryptGetHashParam", 10 )
                                      PRINT "CryptGetHashParam Errored getting HashSize:"; WinErr: LINE INPUT sO
                                      EXIT FUNCTION
                                    END IF
                                  
                                    ' hHash is rendered useless after CryptGetHashParam so we may as well destroy it here
                                    CryptDestroyHash hHash
                                    '::FOR iX = 0 TO 3:
                                    '::: PRINT " hByte:"; hByte( 0 );  ': NEXT iX
                                    '::: PRINT " hSize:"; hSize
                                    'Does hSize = bAlgSz( i ) / 8?
                                    ::: IF hByte( 0 ) = bAlgSz( i ) / 8 THEN FUNCTION = %TRUE ELSE FUNCTION = %FALSE
                                  
                                  END FUNCTION
                                  
                                  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
                                  
                                  FUNCTION SystemErrorMessage( BYVAL WinErr AS LONG, API AS STRING, sFunction AS STRING, BYVAL Number AS LONG ) AS STRING
                                    LOCAL pBuffer AS ASCIIZ PTR, ncbBuffer AS DWORD
                                    LOCAL sText AS STRING
                                  
                                    ncbBuffer = FormatMessageA( %FORMAT_MESSAGE_ALLOCATE_BUFFER OR %FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS, _
                                      BYVAL %Null, WinErr, %Null, BYVAL VARPTR( pBuffer ), 0, BYVAL %Null )
                                    IF ncbBuffer THEN
                                      sText = PEEK$( pBuffer, ncbBuffer )
                                      sText = REMOVE$( sText, ANY CHR$( 13 ) + CHR$( 10 ) )
                                      FUNCTION = $CRLF + "Error" + FORMAT$( WinErr, " #####" ) + " during " + API + $CRLF + $CRLF + _
                                        CHR$(34) + sText + CHR$(34) + $CRLF + $CRLF + "Location : " + sFunction + IIF$( Number, FORMAT$( Number, " ###" ), "" )
                                      LocalFree pBuffer
                                    ELSE
                                      FUNCTION = "Unknown error - Code:" + FORMAT$( WinErr, " #####" )
                                    END IF
                                  
                                  END FUNCTION
                                  Also Yours Sincerely, Gregory D. MELLOTT
                                  Last edited by Gregory D. MELLOTT; 29 Aug 2012, 04:08 AM. Reason: Text length printout error

                                  Comment


                                  • #18
                                    PBWin/PBCC SHA256/384/512 in XP SP3

                                    For those struggling to find the latest include files for constants equates and declarations of Windows APIs; try this link and use IE's menu 'Edit'/'Find on this page' and type in 'API'. There is also help documentation to download there also.

                                    http://www.powerbasic.com/support/do...umentation.htm

                                    Best wishes to happy PB coders.
                                    Sincerely, Gregory D. MELLOTT

                                    Comment

                                    Working...
                                    X