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.
Best wishes to happy PB coders.
Sincerely, Gregory D. MELLOTT
-
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.
Also Yours Sincerely, Gregory D. MELLOTTCode:'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 FUNCTIONLeave a comment:
-
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
PowerBASICCode: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"
Where the equates were got from the PowerBASIC COM browser.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
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 aboveAttached FilesLast edited by David Roberts; 7 Aug 2010, 09:24 AM.Leave a comment:
-
-
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:
-
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:
With VBScript 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
sHMACKey ie 'password'Code:Const MD5 = 32771 Const SHA1 = 32772 Const SHA256 = 32780 Const SHA384 = 32781 Const SHA512 = 32782
[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
along withCode:Declare Function MSHashLib Lib "MSHashLib.DLL" Alias "MSHashLib" _ ( ByVal sText As String, ByVal WhichHash As Long, _ ByVal HMACKey As String ) As String
Example full VBScript code; with the operative words highlighted.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
MSHashLib.dll needs to be registered via 'regsvr32 Filepath to MSHashLib.dll'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"
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.
Leave a comment:
-
sResult = HashRoutine("C:\dell.sdr", %SHA256, Chr$(0))
See post #10.
Robert, discussions are not allowed in the Source Code forum.Leave a comment:
-
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,
RobLeave a comment:
-
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 FunctionLeave a comment:
-
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:
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.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
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 FunctionLeave a comment:
-
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.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.
Enjoy!
Rick
p.s. It looks like i typed in an extra "zip" in the attachment name...
Leave a comment:
-
I have added a new export to the library. Nothing earth shattering, just a cprng based upon the CryptGenRandom API.
Declaration:
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.Code:Declare Function CryptRandom Lib "MSHash.DLL" Alias "CryptRandom" _ ( ByVal Number As Long, ByVal lMode As Long ) As 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:
The first one relates to the AES128 etc thread.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
Example usage:
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.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
Last edited by David Roberts; 17 Nov 2009, 02:07 PM.Leave a comment:
-
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:
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.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
MSHash V 1.1 uploaded here.Last edited by David Roberts; 18 Nov 2009, 07:36 PM.Leave a comment:
-
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:
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
HMACKey as String to PBMain's Local list.
HMACKey = "2E664237276E5BC4FA7DA0FCBE749F921700BF615333886A6ADAFB20F697B543"
just before sText = "Whatever" ' Your filepath here
Add: the following function
Change: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
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 FunctionLast edited by David Roberts; 16 Nov 2009, 12:48 PM. Reason: Corrected WinErr positions - I always forget <smile>Leave a comment:
-
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.
Version 1.0, all of 29KB unzipped, uploaded.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
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.
Last edited by David Roberts; 21 Oct 2009, 08:31 PM.Leave a comment:
-
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 RobertsLeave a comment:
-
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 FunctionLast edited by David Roberts; 19 Oct 2009, 07:51 PM. Reason: Used a wrong counter in one of the SysErrMsg linesLeave a comment:
-
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.
Leave a comment: