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

  • Gregory D. MELLOTT
    replied
    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

    Leave a comment:


  • Gregory D. MELLOTT
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    sResult = HashRoutine("C:\dell.sdr", %SHA256, Chr$(0))

    See post #10.

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

    Leave a comment:


  • Robert Kantor
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    Hi Rick.

    Comments here.

    Leave a comment:


  • Rick Kelly
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    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>

    Leave a comment:


  • David Roberts
    replied
    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.

    Leave a comment:


  • David Roberts
    replied
    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

    Leave a comment:


  • David Roberts
    replied
    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

    Leave a comment:


  • David Roberts
    started a topic PBWin/PBCC SHA256/384/512 in XP SP3

    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.
Working...
X