Code: Select all
' ########################################################################################
' With regard Afx material:
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' This CODE And INFORMATION Is PROVIDED "As Is" WITHOUT WARRANTY OF Any KIND, EITHER
' EXPRESSED Or IMPLIED, INCLUDING BUT Not LIMITED To THE IMPLIED WARRANTIES OF
' MERCHANTABILITY And/Or FITNESS For A PARTICULAR PURPOSE.
'
' ########################################################################################
#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "Afx/CWindow.inc"
#Include Once "Afx/CFileSys.inc"
#Inclib "bcrypt"
#Inclib "crypt32"
#Include Once "windows.bi"
#Include Once "String.bi"
Using Afx
Const HashLen = 256 ' Corresponds To SHA256
' Only ever use a HashLen of 256, 384 Or 521
Const STATUS_SUCCESS = 0
Const STATUS_INVALID_SIGNATURE = &HC000A000
Const IDC_GROUPBOX = 1001
Const IDC_OPTION1 = 1002
Const IDC_OPTION2 = 1003
Const IDC_OPTION3 = 1004
Const IDC_OPTION4 = 1005
Const IDC_OPTION5 = 1006
Const IDC_OPTION6 = 1007
Const IDC_OPTION7 = 1008
Const IDC_OPTION8 = 1009
Const ID_OK = 1010
Const ID_DR = 1011
Const EncAES = 1
Const DecAES = 2
Const Enc = 3
Const Dec = 4
Const Sig = 5
Const Ver = 6
Const HashFile = 7
Const HashCompare = 8
Const Enc_File = 9
Const Sig_File = 10
Const Hash_File = 11
Const All_Files1 = 12
Const All_Files2 = 13
Const AES128 = 128
Const AES192 = 192
Const AES256 = 256
const BlockSize = 16
const BufferSize = 256 * 1024
#Define CrLf Chr(10) + Chr(13)
' Following courtesy of Mr Swiss
#Define IsFalse(e) ( Not CBool(e) )
#Define IsTrue(e) ( CBool(e) )
Declare Function WinMain (Byval hInstance As HINSTANCE, _
Byval hPrevInstance As HINSTANCE, _
Byval szCmdLine As Zstring Ptr, _
Byval nCmdShow As Long) As Long
End WinMain(GetModuleHandleW(NULL), NULL, Command(), SW_NORMAL)
' // Forward declaration
Declare Function WndProc (Byval hwnd As HWND, Byval uMsg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
Declare Function AfxIFileOpenDialog (Byval hwndOwner As HWND, Byval DisplyType As Long, _
Byval sigdnName As SIGDN = SIGDN_FILESYSPATH) As Wstring Ptr
Declare Function IsHex( As String ) As Long
Declare Function Hash( As lpcwstr, As String, As Long, As Long, As Long, As String = Chr(0)) As String
Declare Function GetFileHashEx( As String, As Long ) As String
Declare Sub TDWrapper( As HWND, As PCWSTR, As PCWSTR, As PCWSTR )
declare Function AES( As Long, As String, As String, As Long ) As Long
Dim Shared As Long xWindow, yWindow
Dim shared pFileSys As CFileSys
' Main
Function WinMain (Byval hInstance As HINSTANCE, _
Byval hPrevInstance As HINSTANCE, _
Byval szCmdLine As Zstring Ptr, _
Byval nCmdShow As Long) As Long
Dim As Long f
' // Set process DPI aware
AfxSetProcessDPIAware
' // Create the main Window
Dim pWindow As CWindow
'
pWindow.SetFont("Tahoma", 10, FW_NORMAL, , , , DEFAULT_CHARSET)
pWindow.Create(NULL, "AES-RSA-ECDSA", @WndProc, ,,,, WS_SYSMENU Or WS_CAPTION, WS_EX_TOPMOST)
pWindow.SetClientSize(250, 360)
' Open at last position
If pFileSys.Fileexists("Position.dat") Then
f = Freefile
Open "Position.dat" For Binary As #f
Get #f, , xWindow
Get #f, , yWindow
Close #f
Dim hwnd As Hwnd = pWindow.hWindow
SetWindowPos( HWnd, HWND_NOTOPMOST, xWindow, yWindow, 0, 0, SWP_NOSIZE )
Else
pWindow.Center
End If
' Get small icon For titlebar
pWindow.SmallIcon = LoadImage(hInstance, MAKEINTRESOURCE(100), IMAGE_ICON, 32, 32, LR_SHARED)
' // Add a group box control
Dim As Long h
h = 60
pWindow.AddControl("GroupBox", , IDC_GROUPBOX, "Choose one of the following tasks", 20, 12, 210, 224+h)
' // Add radio buttons (the first one should have the WS_GROUP style)
pWindow.AddControl("RadioButton", , IDC_OPTION1, "Encrypt a file AES", 64, 48, 120, 16, WS_GROUP)
pWindow.AddControl("RadioButton", , IDC_OPTION2, "Decrypt a .aes file", 64, 78, 120, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION3, "Encrypt a key RSA", 64, 48+h, 120, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION4, "Decrypt a .enc file", 64, 78+h, 130, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION5, "Sign a hash", 64, 108+h, 130, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION6, "Verify a .sig file", 64, 138+h, 130, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION7, "Hash a file", 64, 168+h, 130, 16)
pWindow.AddControl("RadioButton", , IDC_OPTION8, "Verify hashes", 64, 198+h, 130, 16)
' // Add OK button
pWindow.AddControl("Button", , ID_OK, "OK", 80, 250+h, 88, 38)
'Get dialog image
LoadImage(hInstance, MAKEINTRESOURCE(101), IMAGE_BITMAP, 0, 0, LR_SHARED)
pWindow.AddControl("BitMapButton", , ID_DR, "#101", 223, 266+h, 26, 33)
LoadImage(hInstance, MAKEINTRESOURCE(102), IMAGE_ICON, 0, 0, LR_SHARED)
' // Check the first radio button
'CheckDlgButton pWindow.hWindow, IDC_OPTION1, BST_CHECKED
' // Dispatch Windows messages
Function = pWindow.DoEvents(nCmdShow)
End Function
' Window procedure
Function WndProc (Byval hwnd As HWND, Byval uMsg As UINT, Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
Dim As Boolean FirstPass = True
Static As BCRYPT_ALG_HANDLE hRSAHandle, hECDSAHandle
Static As Long lChoice = Enc
Static As Long dllIsLoaded
'Static As Any Ptr AES
Dim As BCRYPT_KEY_HANDLE hKeyHandle
Dim As String sInFile, sOutFile, sInputFile, sHash, sSigFile, sHashFile, EncMainMessage, sDummy
Dim As Long lError, f, MaxFileSize
Dim As Ulong dwstatus, cbInput, dummy, cbOutPut, pcbResult, Stretch
Dim pbOutput() As Byte
Dim Blob() As Byte
Dim ptrBlob As Ulong Ptr
Dim pwszName As Wstring Ptr
Dim As Double t
Dim pFileSys As CFileSys
Dim As string PassKey, AESName
If FirstPass = True Then
If BCryptOpenAlgorithmProvider( @hRSAHandle, BCRYPT_RSA_ALGORITHM, "", 0 ) <> STATUS_SUCCESS Then
TDWrapper 0, "Error", "Unable To Open RSA algorithm provider.", TD_ERROR_ICON
End
End If
If BCryptOpenAlgorithmProvider( @hECDSAHandle, Wstr( "ECDSA_P" + Str(HashLen) ), "", 0 ) <> STATUS_SUCCESS Then
TDWrapper 0, "Error", "Unable To Open ECDSA algorithm provider.", TD_ERROR_ICON
End
End If
FirstPass = False
End If
Select Case uMsg
Case WM_COMMAND
Select Case Loword(wParam)
Case IDC_OPTION1
lChoice = EncAES
Case IDC_OPTION2
lChoice = DecAES
Case IDC_OPTION3
lChoice = Enc
Case IDC_OPTION4
lChoice = Dec
Case IDC_OPTION5
lChoice = Sig
Case IDC_OPTION6
lChoice = Ver
Case IDC_OPTION7
lChoice = HashFile
Case IDC_OPTION8
lChoice = HashCompare
Case ID_OK
Select Case lChoice
Case EncAES, DecAES
if lChoice = EncAES then
pwszName = AfxIFileOpenDialog(hwnd, All_Files2)
else
pwszName = AfxIFileOpenDialog(hwnd, DecAES )
end if
If pwszName Then
AESName = *pwszName
CoTaskMemFree(pwszName)
Dim rc As RECT
GetWindowRect( hWnd, @rc )
dim as long x, y
x = rc.Left - 36
y = rc.Top + 110
PassKey = AfxInputBox( Hwnd, x, y, "AES", "Please provide password/passkey", , , True )
if PassKey = "" Then exit function
If ( Len( Passkey ) Mod 2 <> 0 ) orelse ( Len( Passkey ) < 64 ) orelse IsHex( Passkey ) = 0 then
sDummy = right( Passkey, 2 )
Stretch = valint( sDummy )
If Stretch >= 32 Then Stretch = 24
End If
BlockInput True
' Remove Close button
EnableMenuItem GetSystemMenu(hWnd, False), SC_CLOSE, MF_BYCOMMAND or MF_DISABLED
t = timer
dwStatus = AES( AES256, AESName, PassKey, Stretch )
t = timer - t
' Restore Close button
EnableMenuItem GetSystemMenu(hWnd, False), SC_CLOSE, MF_BYCOMMAND or MF_ENABLED
BlockInput False
if dwStatus <> 0 then
select case dwStatus
case -5
TDWrapper Hwnd, AfxGetFileNameX(AESName) + " is a zero byte file.", "", TD_ERROR_ICON
case -6
TDWrapper Hwnd, "Password/Passkey verification failed", "", TD_ERROR_ICON
end select
exit function
end if
if lChoice = EncAES Then
TDWrapper Hwnd, "AES256 encryption", AfxGetFileNameX(AESName) + CrLf + CrLf + "Time taken: " _
+ Format(t*1000, "0.0") + "ms", TD_INFORMATION_ICON
Else
TDWrapper Hwnd, "AES256 decryption", AfxGetFileNameX(AESName) + CrLf + CrLf + "Time taken: " _
+ Format(t*1000, "0.0") + "ms", TD_INFORMATION_ICON
End If
End If
Case Enc, Dec, Sig, Ver
' Get task Blob
pwszName = AfxIFileOpenDialog(hwnd, lChoice)
If pwszName Then
sInfile = *pwszName
CoTaskMemFree(pwszName)
f = Freefile
Open sInFile For Binary As #f
cbInput = Lof(f)
Redim Blob(1 To cbInput) As Byte
Get #f, , Blob()
Close #f
Else
Exit Function
End If
If lChoice = Enc Then
pwszName = AfxIFileOpenDialog(hwnd, All_Files1)
Elseif lChoice = Dec Then
pwszName = AfxIFileOpenDialog(hwnd, Enc_File)
Else
pwszName = AfxIFileOpenDialog(hwnd, Hash_File)
End If
If pwszName = 0 Then Exit Function
sInfile = *pwszName
CoTaskMemFree(pwszName)
Dim pFileSys As CFileSys
Dim sExtn As CWSTR = pFileSys.GetExtensionName(sInFile)
If sExtn <> "enc" And sExtn <> "sig" Then
If lChoice = Enc Then
sOutFile = sInFile & ".enc"
Elseif lChoice = Sig Then
sOutFile = sInFile & ".sig"
End If
Else
sOutFile = Left( sInFile, Len( sInFile ) - 4 )
End If
' Get target file And make sure it Is a valid size For RSA encryption
f = Freefile
Open sInFile For Binary As #f
sInputFile = String(Lof(f), 0)
Get #f, , sInputFile
If lChoice = Enc Then
' 2nd Dword of header Is Bit strength
ptrBlob = Cast( Ulong Ptr, @Blob(5) )
MaxFileSize = Peek(Ulong, ptrBlob)\8 -2 - 2*HashLen\8
If Lof(f) > MaxFileSize Then
TDWrapper Hwnd, "RSA message size", "Target file must be less than Or equal To " _
+ Str( MaxFileSize ) + " bytes.", TD_ERROR_ICON
Close #f
Exit Function
End If
End If
Close #f
Dim paddinginfo As BCRYPT_OAEP_PADDING_INFO
Dim algo As Wstring * 8
Dim buffer As String
algo = "SHA" + Str(HashLen)
buffer = String(HashLen, 0)
paddinginfo.pszAlgid = Varptr(algo)
paddinginfo.pblabel = Strptr(buffer)
paddinginfo.cblabel = HashLen
If lChoice = Enc Then
t = Timer
dwStatus = BCryptImportKeyPair( hRSAHandle, Null, BCRYPT_RSAPublic_BLOB, @hKeyHandle, _
@Blob(1), cbInput, 0 )
If dwStatus <> STATUS_SUCCESS Then lError = 10 : Goto ErrorTrap
' Get Output length in pcbResult
dwStatus = Bcryptencrypt( hKeyhandle, Strptr(sInputFile), Len(sInputFile), @paddinginfo, _
Null, dummy, null, 0, @pcbResult, BCRYPT_PAD_OAEP)
If dwStatus <> STATUS_SUCCESS Then lError = 20 : Goto ErrorTrap
Redim pbOutput( 1 To pcbResult) As Byte
cbOutput = pcbResult
dwStatus = Bcryptencrypt( hKeyhandle, Strptr(sInputFile), Len(sInputFile), @paddinginfo, _
Null, dummy, @pbOutput(1), cbOutput, @pcbResult, BCRYPT_PAD_OAEP)
If dwStatus <> STATUS_SUCCESS Then lError = 30 : Goto ErrorTrap
t = Timer - t
Elseif lChoice = Dec Then
t = Timer
dwStatus = BCryptImportKeyPair( hRSAHandle, Null, BCRYPT_RSAPrivate_BLOB, @hKeyHandle, _
@Blob(1), cbInput, 0 )
If dwStatus <> STATUS_SUCCESS Then lError = 40 : Goto ErrorTrap
' Get Output length in pcbResult
dwStatus = Bcryptdecrypt( hKeyhandle, Strptr(sInputFile), Len(sInputFile), @paddinginfo, _
Null, dummy, null, 0, @pcbResult, BCRYPT_PAD_OAEP)
If dwStatus <> STATUS_SUCCESS Then lError = 50 : Goto ErrorTrap
Redim pbOutput( 1 To pcbResult) As Byte
cbOutput = pcbResult
dwStatus = Bcryptdecrypt( hKeyhandle, Strptr(sInputFile), Len(sInputFile), @paddinginfo, _
Null, dummy, @pbOutput(1), cbOutPut, @pcbResult, BCRYPT_PAD_OAEP)
If dwStatus <> STATUS_SUCCESS Then lError = 60 : Goto ErrorTrap
t = Timer - t
Elseif lChoice = Sig Then
t = Timer
dwStatus = BCryptImportKeyPair( hECDSAHandle, Null, BCRYPT_ECCPRIVATE_BLOB, @hKeyHandle, _
@Blob(1), cbInput, 0 )
If dwStatus <> STATUS_SUCCESS Then lError = 70 : Goto ErrorTrap
' Get Output length in pcbResult
dwStatus = BCryptSignHash( hKeyhandle, null, Strptr(sInputFile), Len(sInputFile), null, _
0, @pcbResult, 0)
If dwStatus <> STATUS_SUCCESS Then lError = 80 : Goto ErrorTrap
Redim pbOutput( 1 To pcbResult) As Byte
cbOutput = pcbResult
dwStatus = BcryptSignhash( hKeyhandle, null, Strptr(sInputFile), Len(sInputFile), _
@pbOutput(1), cbOutput, @pcbResult, 0)
If dwStatus <> STATUS_SUCCESS Then lError = 90 : Goto ErrorTrap
t = Timer - t
Else
pwszName = AfxIFileOpenDialog(hwnd, Sig_File)
If pwszName Then
sInfile = *pwszName
CoTaskMemFree(pwszName)
t = Timer
f = Freefile
Open sInFile For Binary As #f
sSigFile = String(Lof(f), 0)
Get #f, , sSigFile
Close #f
dwStatus = BCryptImportKeyPair( hECDSAHandle, Null, BCRYPT_ECCPUBLIC_BLOB, @hKeyHandle, @Blob(1), cbInput, 0 )
If dwStatus <> STATUS_SUCCESS Then lError = 100 : Goto ErrorTrap
' Get Output length in pcbResult
dwStatus = BCryptVerifySignature( hKeyhandle, 0, Strptr(sInputFile), Len(sInputFile),_
Strptr(sSigFile), Len(sSigFile), 0)
t = Timer - t
If dwStatus = STATUS_SUCCESS Then
TDWrapper Hwnd, "Signature verification", AfxGetFileNameX(sInFile) + " has been verified." + _
CrLf + CrLf + "Time taken: " + Format(t*1000, "0.0") + "ms", TD_INFORMATION_ICON
Elseif dwStatus = STATUS_INVALID_SIGNATURE Then
TDWrapper Hwnd, "Signature verification", AfxGetFileNameX(sInFile) + " was Not verified." + _
CrLf + CrLf + "Time taken: " + Format(t*1000, "0.0") + "ms", TD_WARNING_ICON
Else
lError = 110 : Goto ErrorTrap
End If
Else
Exit Function
End If
End If
If lChoice <> Ver Then
If pFileSys.Fileexists(sOutFile) Then Kill sOutfile
f = Freefile
Open sOutFile For Binary As #f
Put #f, , pbOutput()
Close #f
TDWrapper Hwnd, "File creation", AfxGetFileNameX(sOutFile) + " has been created." + _
CrLf + CrLf + "Time taken: " + Format(t*1000, "0.0") + "ms", TD_INFORMATION_ICON
End If
Goto TidyUp
ErrorTrap:
TDWrapper Hwnd, "Error", "Error at Position " + Str(lError) + " " + Hex(dwStatus), TD_ERROR_ICON
TidyUp:
If hKeyHandle <> 0 Then BCryptDestroyKey hKeyHandle
Case HashFile
' Get encrypted message
pwszName = AfxIFileOpenDialog(hwnd, All_Files2)
If pwszName Then
sInfile = *pwszName
CoTaskMemFree(pwszName)
t = Timer
sHash = GetFileHashEx( sInFile, False )
t = Timer - t
f = Freefile
sHashFile = AfxGetFilenameX( sInFile ) + "_Hash.dat"
Open sHashFile For Binary As #f
Put #f, , sHash
Close #f
TDWrapper Hwnd, "Hash file", sHashFile + " has been created." + _
CrLf + CrLf + "Time taken: " + Format(t*1000, "0.0") + "ms", TD_INFORMATION_ICON
Else
Exit Function
End If
Case HashCompare
' Get encrypted message
pwszName = AfxIFileOpenDialog(hwnd, All_Files2)
If pwszName Then
sInfile = *pwszName
EncMainMessage = AfxGetFileNameX(sInFile)
CoTaskMemFree(pwszName)
sHash = GetFileHashEx( sInFile, False )
pwszName = AfxIFileOpenDialog(hwnd, Hash_File)
If pwszName Then
sInfile = *pwszName
CoTaskMemFree(pwszName)
f = Freefile
Open sInfile For Binary As #f
Dim As String sGetHash = String(Lof(f),0)
Get #f, , sGetHash
Close #f
If sHash = sGetHash Then
TDWrapper Hwnd, "Hash comparison", "Hash of " + EncMainMessage + " And given hash match.",_
TD_INFORMATION_ICON
Else
TDWrapper Hwnd, "Hash comparison", "Hash of " + EncMainMessage + " And given hash Do Not match.",_
TD_WARNING_ICON
End If
Else
Exit Function
End If
Else
Exit Function
End If
End Select
Case ID_DR
Dim nClickedButton As Long
TaskDialog( hWnd, GetModuleHandle(NULL), "AES-RSA-ECDSA", "Written in FreeBASIC With José Roca's WinFBX", "by deltarho[1859]", 0, "#102", @nClickedButton)
End Select
Case WM_DESTROY
' Clean up
If hRSAHandle <> 0 Then BCryptCloseAlgorithmProvider(hRSAHandle, 0)
If hECDSAHandle <> 0 Then BCryptCloseAlgorithmProvider(hECDSAHandle, 0)
PostQuitMessage(0)
Exit Function
Case WM_SYSCOMMAND
If Loword(wParam) = SC_CLOSE Then ' Close message
Dim As Long x, y, f
Dim rc As RECT
GetWindowRect( hWnd, @rc )
' If Window has moved Then save current position
If xWindow <> rc.Left Orelse yWindow <> rc.top Then
If pFileSys.Fileexists("Position.dat") Then Kill "Position.dat"
f = Freefile
Open "Position.dat" For Binary As #f
Put #f, , rc.Left
Put #f, , rc.top
Close #f
End If
End If
End Select
' // Default processing of Windows messages
Function = DefWindowProcW(hWnd, uMsg, wParam, lParam)
End Function
' Display the File Open Dialog
' The returned Pointer must be freed With CoTaskMemFree
' Adapted by deltarho[1859]
Function AfxIFileOpenDialog ( hwndOwner As HWND, DisplayType As Long, sigdnName As SIGDN = SIGDN_FILESYSPATH) As Wstring Ptr
' // Create an instance of the FileOpenDialog interface
Dim hr As Long
Dim pofd As IFileOpenDialog Ptr
hr = CoCreateInstance(@CLSID_FileOpenDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @pofd)
If pofd = NULL Then Return NULL
Dim rgFileTypes As COMDLG_FILTERSPEC
Select Case DisplayType
case DecAES
rgFileTypes.pszName = @Wstr("Decryption AES")
rgFileTypes.pszSpec = @Wstr("*.aes")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select encrypted file")
Case Enc
rgFileTypes.pszName = @Wstr("Encryption")
rgFileTypes.pszSpec = @Wstr("*RSAPublicKey*.dat")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select encrypted task file")
Case Dec
rgFileTypes.pszName = @Wstr("Decryption RSA")
rgFileTypes.pszSpec = @Wstr("*RSAPrivateKey*.dat")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select RSA decryption task file")
Case Sig
rgFileTypes.pszName = @Wstr("Signing")
rgFileTypes.pszSpec = @Wstr("*ECDSAPrivateKey*.dat")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select signing task file")
Case Ver
rgFileTypes.pszName = @Wstr("Verifying")
rgFileTypes.pszSpec = @Wstr("*ECDSAPublicKey*.dat")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select verifying task file")
Case Enc_File
rgFileTypes.pszName = @Wstr("Encrypted file")
rgFileTypes.pszSpec = @Wstr("*.enc")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select an encrypted key/password file")
Case Sig_File
rgFileTypes.pszName = @Wstr("Signed file")
rgFileTypes.pszSpec = @Wstr("*.sig")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select a signed hash file")
Case Hash_File
rgFileTypes.pszName = @Wstr("Hash files")
rgFileTypes.pszSpec = @Wstr("*Hash.dat")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select a hash file")
Case All_Files1
rgFileTypes.pszName = @Wstr("All files")
rgFileTypes.pszSpec = @Wstr("*.*")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select a key/password")
Case All_Files2
rgFileTypes.pszName = @Wstr("All files")
rgFileTypes.pszSpec = @Wstr("*.*")
pofd->lpVtbl->SetFileTypes(pofd, 1, @rgFileTypes)
hr = pofd->lpVtbl->SetTitle(pofd, "Select a message")
End Select
' // Display the dialog
hr = pofd->lpVtbl->Show(pofd, hwndOwner)
' // Set the default folder
Dim pFolder As IShellItem Ptr
SHCreateItemFromParsingName (Curdir, NULL, @IID_IShellItem, @pFolder)
If pFolder Then
pofd->lpVtbl->SetDefaultFolder(pofd, pFolder)
pFolder->lpVtbl->Release(pFolder)
End If
' // Get the result
Dim pItem As IShellItem Ptr
Dim pwszName As Wstring Ptr
If SUCCEEDED(hr) Then
hr = pofd->lpVtbl->GetResult(pofd, @pItem)
If SUCCEEDED(hr) Then
hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
Function = pwszName
End If
End If
' // Cleanup
If pItem Then pItem->lpVtbl->Release(pItem)
If pofd Then pofd->lpVtbl->Release(pofd)
End Function
' Check If a String Is wholly hexadecimal Or Not, returns True If so
Function IsHex(s As String) As Long
Dim i As Long
For i = 0 To Len(s) - 1
Select Case s[i]
Case 48 To 57, 65 To 70, 97 To 102
Case Else
Return False
End Select
Next i
Return true
End Function
' General Hash Function. See https://freebasic.net/forum/viewtopic.php?f=7&t=25320 For full details
Function Hash( hashalg As lpcwstr, stext As String, index As Long, mode As Long, final As Long, _
pbsecret As String = Chr(0)) As String
Static phalg(1 To 8) As Byte Ptr
Static phhash(1 To 8) As Byte Ptr
Dim sbinary As String
Dim shex As String
Dim nlength As Long
' Initialize section
If phhash(index) = 0 Then ' will be the Case On, And perhaps only, first pass
If pbsecret = Chr(0) Then ' Not hmac
BcryptOpenAlgorithmprovider @phalg(index), hashalg, 0, 0 ' we want phalg(index)
BcryptCreatehash phalg(index), @phhash(index), null, 0, 0, 0, 0 ' we want phhash(index)
Else ' Is hmac
' We want phalg(index)
BcryptOpenAlgorithmprovider @phalg(index), hashalg, 0, bcrypt_alg_handle_hmac_flag' we want phalg(index)
If Right( pbsecret, 1 ) <> Chr(0) Then ' ascii Not forced
' are we going To use pbsecret As ascii Or Binary?
If ( Len( pbsecret ) Mod 2 = False ) And IsHex( pbsecret ) = true Then
nlength = Len(pbsecret)\2
sbinary = Space( nlength )
CryptStringToBinarya Strptr(pbsecret), Len(pbsecret), crypt_string_hexraw, Strptr(sbinary), @nlength, 0, 0
pbsecret = sbinary
End If
Else
pbsecret = Left( pbsecret, Len(pbsecret) - 1)
End If
' We want phhash(index)
BcryptCreatehash phalg(index), @phhash(index), null, 0, Strptr( pbsecret ), Len( pbsecret ), 0
End If
End If
' update section
BcryptHashData( phhash(index), Strptr( stext), Len( stext ), 0 )
' finalization section
If final = true Then ' finalize hash
Dim As Ulong lhashlength
Dim As Ulong lresult
Dim sbinhash As String
BcryptGetProperty phalg(index), bcrypt_hash_length, Cast( Puchar, @lhashlength ), 4, Varptr(lresult), 0
sbinhash = String( lhashlength, 0 )
BcryptFinishHash phhash(index), Strptr( sbinhash ), lhashlength, 0
BcryptDestroyHash phhash(index)
BcryptCloseAlgorithmprovider phalg(index), 0
phhash(index) = 0 ' ensures a New hash Is created On another pass of hash() With This index
If mode = 0 Then
Return sbinhash
Else
nlength = Len(sbinhash)*2 + 1 ' + 1 To accomodate a null terminator
shex = Space( nlength )
CryptBinaryToStringa Strptr(sbinhash), Len(sbinhash), crypt_string_hexraw + crypt_string_nocrlf, _
Strptr(shex), @nlength ' at msdn nlength 'Out' Is Len(sbinhash) * 2, so
Return Ucase( Left( shex, nlength ) )
End If
End If
End Function
' Hash a file - specific For AES-RSA-ECDSA
Function GetFileHashEx( sFile As String, Flag As Long ) As String
' If Flag Is 0 Then Binary Is returned Else hexadecimal
Dim As String * 262144 sBuffer
Dim As String sHash
Dim As Ulong f
Dim As Uinteger BytesRead
' Prepend message With blocksize of zeros - security measure
' SHA512 Is used And reduced according To HashLen
Hash Wstr("SHA512"), String(128,0), 1, Flag, False
f = Freefile
Open sFile For Binary As #f
While Not Eof(f)
Get #f, , sBuffer, , BytesRead
Hash Wstr("SHA512"), Left( sBuffer, BytesRead ), 1, Flag, False
Wend
Close #f
' The hash has Not been finalized so employ hash() again With an empty String.
sHash = Hash( "", "", 1, Flag, true )
Return Left(sHash, Len(sHash)*HashLen\512)
End Function
' Digest of TaskDialog
Sub TDWrapper( hWndParent As HWND, pszMainInstruction As PCWSTR, pszContent As PCWSTR, pszIcon As PCWSTR )
Dim nClickedButton As Long
TaskDialog( hWndParent, NULL, "AES-RSA-ECDSA", pszMainInstruction, pszContent, TDCBF_OK_BUTTON, pszIcon, @nClickedButton)
End Sub
Function AES( AESstrength As Long, sInFile As String, sPassword As String, lStretch As Long ) As Long
' If sInFile has an aes extension Then decrypt Else encrypt
Dim As BCRYPT_ALG_HANDLE Ptr hRand, hAESAlg
Dim As BCRYPT_KEY_HANDLE Ptr hKey
Dim OutText() As Byte
Dim As Long i, Final, lFileLen, FinalSection, SectionCount, IsInputEncrypted, LenInText, LenOutText, nLength
Dim As Ulong ntStatus, lError, dwResult, phHashAES, hIn, hOut
Dim sIV As String * 16
Dim sSalt As String * 32
Dim As String sBinary, sOutFile, sDummy, sKey
Dim As String*32 sKeyVerify, sSavedKeyVerify
Dim As String * 262144 pbdata
Dim As Uinteger nbloaded
AESstrength /= 8
lStretch += 2
' File Input/Output section
If pFileSys.FileExists( sInfile ) = False Then ' Unable To find file
Function = -1
Goto TidyUp
End If
hIn = Freefile
Open sInfile For Binary As #hIn
lFilelen = Lof( hIn )
If lFileLen = 0 Then ' Zer0 Byte file
Close #hIn
Function = -5
Goto TidyUp
End If
If Lcase( Right( sInFile, 4 ) ) <> ".aes" Then
sOutFile = sInFile & ".aes"
' eg f:\folder\myapp.Exe ==> f:\folder\myapp.Exe.aes
IsInputEncrypted = False
Else
sOutFile = Left$( sInFile, Len( sInFile ) - 4 )
' eg f:\folder\myapp.Exe.aes ==> f:\folder\myapp.Exe
IsInputEncrypted = True
End If
' Read Or generate header items
If IsInputEncrypted = True Then
Get #hIn,, sIV
Get #hIn,, sSalt
Get #hIn,, sSavedKeyVerify
Else
ntStatus = BCryptOpenAlgorithmProvider(@hRand, BCRYPT_RNG_ALGORITHM, "", 0) ' Prepare For Random number generation
If ntStatus <> STATUS_SUCCESS Then lError = 120 : Goto ErrorTrap
ntStatus = BCryptGenRandom(hRand, Strptr(sIV), BlockSize, 0)
If ntStatus <> STATUS_SUCCESS Then lError = 130 : Goto ErrorTrap
ntStatus = BCryptGenRandom(hRand, Strptr(sSalt), 32, 0)
If ntStatus <> STATUS_SUCCESS Then lError = 140 : Goto ErrorTrap
ntStatus = BCryptCloseAlgorithmProvider(hRand, 0)
If ntStatus <> STATUS_SUCCESS Then lError = 150 : Goto ErrorTrap
End If
' Are we going To use sPassword As ascii Or Binary?
If ( sPassword <> "" ) And ( Len( sPassword ) Mod 2 = 0 ) And ( Len( sPassword ) >= 2 * AESStrength ) And IsHex( sPassword ) <> 0 Then
' Treat As a Binary String
nLength = Len(sPassword)\2
sBinary = Space$( nlength )
CryptStringToBinarya Strptr(sPassword), Len(sPassword), crypt_string_hexraw, Strptr(sBinary), @nLength, 0, 0
sPassword = sBinary
End If
' Use SHA256 And stretch sPassword
' Algorithm employed x0 = 0 : xi = Hash( xi-1 + sPassword + sSalt ) For i = 1 To 2^lStretch
' From Cryptography Engineering: ISBN 978-0-470-47424-2
' Calculate 2^lStretch - 1 hashes
For i = 1 To 2^lStretch - 1
sDummy = sKey + sPassword + sSalt
sKey = Hash( Wstr("SHA256"), sDummy, 1, False, False )
Next
' Calculate password verification Data
sDummy = String$(64,0) + sKey + sPassword + sSalt
sKeyVerify = Hash( Wstr("SHA256"), sDummy, 1, False, True )
If IsTrue( IsInputEncrypted ) Then
If sSavedKeyVerify <> sKeyVerify Then ' Password failed
Function = -6
Goto TidyUp
End If
End If
' Now calculate final iterate
sDummy = sKey + sPassword + sSalt
sKey = Hash( Wstr("SHA256"), sDummy, 1, False, True )
' Set up Output file
If IsTrue( pFileSys.Fileexists(sOutFile) ) Then
Kill sOutFile
End If
hOut = Freefile
Open sOutFile For Binary As hOut
If Err Then
Function = Err
Goto TidyUp
End If
If IsFalse( IsInputEncrypted ) Then ' Save Header items
Put #hOut, , sIV
Put #hOut, , sSalt
Put #hOut, , sKeyVerify
End If
' AES section
ntStatus = BCryptOpenAlgorithmProvider( @hAESAlg, BCRYPT_AES_ALGORITHM, "", 0 ) ' We want hAESAlg
If ntStatus <> STATUS_SUCCESS Then lError = 160 : Goto ErrorTrap
ntStatus = BCryptGenerateSymmetricKey( hAESAlg, @hKey, 0, 0, Strptr(sKey), AESstrength, 0 ) ' We want hKey
If ntStatus <> STATUS_SUCCESS Then lError = 170 : Goto ErrorTrap
' Encryption/Decryption section
Redim OutText( 1 To BufferSize ) As Byte
LenOutText = BufferSize
LenInText = BufferSize
If IsTrue( IsInputEncrypted ) Then
lFileLen -= 80 ' To account For sIV, sSalt And sSavedKeyVerify
End If
FinalSection = lFileLen\BufferSize
If lFileLen > FinalSection*BufferSize Then FinalSection += 1
' Encryption/Decryption Loop
Do
SectionCount += 1
Get #hIn,, pbdata, , nbLoaded
If SectionCount = FinalSection Then
Final = BCRYPT_BLOCK_PADDING
End If
If IsFalse( IsInputEncrypted ) Then ' Encrypt
If Final = BCRYPT_BLOCK_PADDING Then
ntStatus = BCryptEnCrypt( hKey, Strptr(pbData), nbLoaded, 0, Cast( Byte Ptr, @sIV ), BlockSize, 0, 0, @LenOutText, Final ) 'We want LenOutText
If ntStatus <> 0 Then lError = 180 : Goto ErrorTrap
' If we are On blocksize boundary we will need BufferSize + BlockSize otherwise GPF
If IsFalse( LenOutText Mod BlockSize ) Then Redim OutText( 1 To BufferSize + BlockSize) As Byte
LenInText = nbLoaded
End If
' LenOutText = BufferSize unless revised above
ntStatus = BCryptEnCrypt( hKey, Strptr(pbData), LenInText, 0, Cast( Byte Ptr, @sIV ), BlockSize, @OutText(1), LenOutText, @dwResult, Final )
If ntStatus <> 0 Then lError = 190 : Goto ErrorTrap
Else ' Decrypt
If Final = BCRYPT_BLOCK_PADDING Then
ntStatus = BCryptDecrypt( hKey, Strptr(pbData), nbLoaded, 0, Cast( Byte Ptr, @sIV ), BlockSize, 0, 0, @LenOutText, Final ) ' We want LenOutText
If ntStatus <> 0 Then lError = 200 : Goto ErrorTrap
If IsFalse( LenOutText Mod BlockSize ) Then Redim OutText( 1 To BufferSize + BlockSize) As Byte
LenInText = nbLoaded
End If
ntStatus = BCryptDecrypt( hKey, Strptr(pbData), LenInText, 0, Cast( Byte Ptr, @sIV ), BlockSize, @OutText(1), LenOutText, @dwResult, Final )
If ntStatus <> 0 Then lError = 210 : Goto ErrorTrap
End If
' If Output file Is an exact multiple of bufferSize
' Then dwResult will be zero And we have nothing To dump
If dwResult > 0 Then
If IsTrue( Final ) Then
Redim Preserve OutText(1 To dwResult) As Byte
End If
Put #hOut, , OutText()
End If
Loop Until Final
Goto TidyUp
ErrorTrap:
MessageBox ( 0, "Error at Position " + Str(lError) + " " + Hex(ntStatus), "EncDec", MB_OK )
TidyUp:
If hAESAlg <> 0 Then BCryptCloseAlgorithmProvider( hAESAlg, 0 )
If hKey <> 0 Then BCryptDestroyKey( hKey )
Close hIn
Close hOut
End Function
You are more than welcome to edit the last two bas files for your own needs but if you do then the following rc file will need to be edited to remove 'yours truly' before handy the exe to anyone else. If you compile the above as is then stay with the rc file as is. I will never publish cryptographic code for financial gain but I will also not publish the same anonymously. <smile>
After you have created your keys create a key/password file. Use your name for a password, for example, and call the file Key.dat
Run RSA-ECDSA and chose 'Encrypt a key'. You should get Key.dat.enc created. Now delete Key.dat and then chose 'Decrypt a .enc file'. You should get your Key.dat back in all its glory.
Now chose 'Hash a file'. Hash RSA-ECDSA.exe, for example. You should get RSA-ECDSA.exe_Hash.dat created. Normally the file to hash would be your AES, or whatever, encrypted message.
Now chose 'Sign a hash'. You should get 'RSA-ECDSA.exe_Hash.dat.sig created.
Now chose 'verify a .sig file'. Work your way through that and you should get a successful verification.
Now chose 'Verify hashes' and you get a hash match.