Created
June 12, 2024 08:33
-
-
Save Irwin1985/83ff8ee7d1eba86c6ff3d21794f3409a to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Clear | |
Local loCrypto | |
loCrypto = CreateObject("CryptoFox") | |
?loCrypto.ComputeHash("VfpRocks!") | |
Release loCrypto | |
return | |
Define Class CryptoFox As Custom | |
Hidden cAlgTyp, oLogger, cLastErrorText | |
cAlgTyp = "SHA256" | |
Procedure GetDigestValue(tcData) | |
Declare Long BCryptOpenAlgorithmProvider In BCrypt; | |
LONG @phAlgorithm,; | |
STRING pszAlgId,; | |
STRING pszImplementation,; | |
LONG dwFlags | |
Declare Long BCryptGetProperty In BCrypt; | |
LONG hObject,; | |
STRING pszProperty,; | |
LONG @pbOutput,; | |
LONG cbOutput,; | |
LONG @pcbResult,; | |
LONG dwFlags | |
Declare Long BCryptCreateHash In BCrypt; | |
LONG hAlgorithm,; | |
LONG @phHash,; | |
STRING @pbHashObject,; | |
LONG cbHashObject,; | |
STRING pbSecret,; | |
LONG cbSecret,; | |
LONG dwFlags | |
Declare Long BCryptHashData In BCrypt; | |
LONG hHash,; | |
STRING pbInput,; | |
LONG cbInput,; | |
LONG dwFlags | |
Declare Long BCryptFinishHash In BCrypt; | |
LONG hHash,; | |
STRING @pbOutput,; | |
LONG cbOutput,; | |
LONG dwFlags | |
Declare Long BCryptDestroyHash In BCrypt; | |
LONG hHash | |
Declare Long BCryptDestroyKey In BCrypt; | |
LONG hKey | |
Declare Long BCryptCloseAlgorithmProvider In BCrypt; | |
LONG hAlgorithm,; | |
LONG dwFlags | |
Local lnAlg, nRespBCOAP, lnSizeObj, lnData, nRespNCGP, lnSizeHash, lnHash, lcHashObj, ; | |
nLenData, nRespBCHD | |
lnAlg = 0 | |
nRespBCOAP = BCryptOpenAlgorithmProvider(@lnAlg, Strconv(this.cAlgTyp,5)+Chr(0), Null, 0) | |
If nRespBCOAP<>0 | |
this.log("ERROR AL ABRIR ALGORITMO") | |
Return "" | |
Endif | |
*----- Determinamos cuántos bytes necesitamos para almacenar el objeto hash | |
lnSizeObj = 0 | |
lnData = 0 | |
nRespNCGP = BCryptGetProperty(lnAlg, Strconv("ObjectLength",5)+Chr(0), @lnSizeObj, 4, @lnData, 0) | |
If nRespNCGP<>0 | |
this.log("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION") | |
Return "" | |
Endif | |
*----- Determinamos la longitud de valor hash | |
lnSizeHash = 0 | |
nRespNCGP = BCryptGetProperty(lnAlg, Strconv("HashDigestLength",5)+Chr(0), @lnSizeHash, 4, @lnData, 0) | |
If nRespNCGP<>0 | |
this.log("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION") | |
Return "" | |
Endif | |
*----- Creamos un objeto Hash | |
lnHash = 0 | |
lcHashObj = Space(lnSizeObj) | |
nRespBCCH = BCryptCreateHash(lnAlg, @lnHash, @lcHashObj, lnSizeObj, Null, 0, 0) | |
If nRespBCCH<>0 | |
this.log("ERROR AL CREAR OBJETO HASH") | |
Return "" | |
Endif | |
*----- Para crear el valor hash agregamos datos al objeto hash. Puede repetir este paso según sea necesario | |
nLenData = Len(tcData) | |
nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0) | |
If nRespBCHD<>0 | |
nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0) | |
If nRespBCHD<>0 | |
=GetMensajeError(nRespBCHD) | |
Return "" | |
Endif | |
Endif | |
*----- Indicamos al objeto hash que hemos terminado. El algoritmo ahora calcula el valor de hash y lo devuelve. | |
lcHash = Space(lnSizeHash) | |
=BCryptFinishHash(lnHash, @lcHash, lnSizeHash, 0) | |
If lnAlg<>0 | |
BCryptCloseAlgorithmProvider(lnAlg, 0) | |
Endif | |
If lnHash<>0 | |
BCryptDestroyHash(lnHash) | |
Endif | |
Clear Dlls BCryptOpenAlgorithmProvider, BCryptGetProperty, BCryptCreateHash, BCryptHashData, ; | |
BCryptFinishHash, BCryptDestroyHash, BCryptDestroyKey, BCryptCloseAlgorithmProvider | |
Return Transform(Strconv(lcHash,15)) | |
Endproc | |
Procedure GetMensajeError(tcNumError) | |
#ifndef FORMAT_MESSAGE_FROM_SYSTEM | |
#Define FORMAT_MESSAGE_FROM_SYSTEM 0x00001000 | |
#endif | |
Declare Long FormatMessage In Kernel32; | |
LONG dwFlags,; | |
STRING @lpSource,; | |
LONG dwMessageId,; | |
LONG dwLanguageId,; | |
STRING @lpBuffer,; | |
LONG nSize,; | |
LONG Arguments | |
Declare Integer GetLastError In Kernel32 | |
If Vartype(tcNumError)=="N" | |
lnErrorCode = tcNumError | |
Else | |
lnErrorCode = GetLastError() | |
Endif | |
lpBuffer = Space(128) | |
=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 'WINERROR.H', lnErrorCode, 0, @lpBuffer, 128 , 0) | |
this.log(Textmerge('ERROR:<<Transform(lnErrorCode,"@0")>><<lpBuffer>>')) | |
Clear Dlls FormatMessage, GetLastError | |
EndProc | |
Procedure setHashType(tcHashType) | |
this.cAlgTyp = tcHashType | |
EndProc | |
Function getHashType | |
Return this.cAlgTyp | |
EndFunc | |
Procedure SetLogger(toLogger) | |
this.oLogger = oLogger | |
EndProc | |
Hidden Procedure Log(tcText) | |
If Vartype(this.oLogger) == 'O' | |
this.oLogger.Log(tcText) | |
Else | |
this.cLastErrorText = tcText | |
endif | |
EndProc | |
Hidden Procedure LogFromException(toEx) | |
If Vartype(this.oLogger) == 'O' | |
this.oLogger.LogFromException(toEx) | |
Else | |
Text to this.cLastErrorText noshow textmerge | |
ERROR: <<Alltrim(Str(toEx.ErrorNo))>> | |
LINE: <<Alltrim(Str(toEx.Lineno))>> | |
MESSAGE: "<<Alltrim(toEx.Message)>>" | |
WHERE: "<<Alltrim(toEx.Procedure)>>" | |
endtext | |
endif | |
EndProc | |
Function GetLastError | |
Return this.cLastErrorText | |
EndFunc | |
Procedure ComputeHash(tcStream) | |
Return this.GetDigestValue(tcStream) | |
EndProc | |
Enddefine |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment