CryptoFox.prg

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