I've seen other encryption snippets around, but I think none uses teh Windows API to do it. The API allows you to use several encryption algorithm. This example uses RC4.
Code: Select all
Procedure Error(message$)
wError = GetLastError_()
If wError
*ErrorBuffer = AllocateMemory(1024)
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, wError, 0, *ErrorBuffer, 1024, 0)
message$+Chr(10)+PeekS(*ErrorBuffer)
FreeMemory(*ErrorBuffer)
EndIf
MessageRequester("Error", message$)
EndProcedure
#PROV_RSA_FULL = 1
#ALG_SID_MD5 = 3
#ALG_SID_RC4 = 1
#ALG_CLASS_DATA_ENCRYPT = 3<<13
#ALG_CLASS_HASH = 4<<13
#ALG_TYPE_ANY = 0
#ALG_TYPE_STREAM = 4<<9
#CALG_MD5 = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_MD5
;
; Valid hashing algorithms:
;
; #ALG_SID_HMAC = 9
; #ALG_SID_MAC = 5
; #ALG_SID_MD2 = 1
; #ALG_SID_SHA = 4
; #ALG_SID_SHA1 = 4
; #ALG_SID_SSL3SHAMD5 = 8
; #CALG_HMAC = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_HMAC
; #CALG_MAC = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_MAC
; #CALG_MD2 = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_MD2
; #CALG_SHA = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_SHA
; #CALG_SHA1 = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_SHA1
; #CALG_SSL3_SHAMD5 = #ALG_CLASS_HASH|#ALG_TYPE_ANY|#ALG_SID_SSL3SHAMD5
#CALG_RC4 = #ALG_CLASS_DATA_ENCRYPT|#ALG_TYPE_STREAM|#ALG_SID_RC4
#CRYPT_EXPORTABLE = 1
#CRYPT_NEWKEYSET = 8
Procedure Encrypt(*lpData, DataLength, password$)
If CryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, 0)=0
CryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, #CRYPT_NEWKEYSET)
EndIf
If hProv
; Hashing algorithms defined in the Windows API (constants commented above):
;
; #CALG_HMAC HMAC, a keyed hash algorithm
; #CALG_MAC Message Authentication Code
; #CALG_MD2 MD2
; #CALG_MD5 MD5
; #CALG_SHA US DSA Secure Hash Algorithm
; #CALG_SHA1 Same as CALG_SHA
; #CALG_SSL3_SHAMD5 SSL3 client authentication
;
CryptCreateHash_(hProv, #CALG_MD5, 0, 0, @hHash)
If hHash
CryptHashData_(hHash, password$, Len(password$), 0)
;
; For a list of valid encryption algorithms, check:
;
; http://msdn.microsoft.com/library/en-us/seccrypto/security/alg_id.asp
;
; The constant values can be found in the Platform SDK include file: WinCrypt.h
;
; Here we're using RC4
;
CryptDeriveKey_(hProv, #CALG_RC4, hHash, #CRYPT_EXPORTABLE, @hKey)
If hKey
If CryptEncrypt_(hKey, 0, #TRUE, #NULL, *lpData, @DataLength, DataLength)
result = #TRUE
Else
Error("CryptEncrypt_() failed")
EndIf
CryptDestroyKey_(hKey)
Else
Error("CryptDeriveKey_() failed")
EndIf
CryptDestroyHash_(hHash)
Else
Error("CryptCreateHash_() failed")
EndIf
CryptReleaseContext_(hProv, 0)
Else
Error("CryptAcquireContext_() failed")
EndIf
ProcedureReturn result
EndProcedure
Procedure Decrypt(*lpData, DataLength, password$)
If CryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, 0)=0
CryptAcquireContext_(@hProv, #NULL, #NULL, #PROV_RSA_FULL, #CRYPT_NEWKEYSET)
EndIf
If hProv
CryptCreateHash_(hProv, #CALG_MD5, 0, 0, @hHash)
If hHash
CryptHashData_(hHash, password$, Len(password$), 0)
CryptDeriveKey_(hProv, #CALG_RC4, hHash, #CRYPT_EXPORTABLE, @hKey)
If hKey
If CryptDecrypt_(hKey, 0, #TRUE, 0, *lpData, @DataLength)
result = #TRUE
Else
Error("CryptDecrypt_() failed")
EndIf
CryptDestroyKey_(hKey)
Else
Error("CryptDeriveKey_() failed")
EndIf
CryptDestroyHash_(hHash)
Else
Error("CryptCreateHash_() failed")
EndIf
CryptReleaseContext_(hProv, 0)
Else
Error("CryptAcquireContext_() failed")
EndIf
ProcedureReturn result
EndProcedure
mydata$ = "This a string to test the encryption/decryption code"
pwd$ = "my password"
If Encrypt(@mydata$, Len(mydata$), pwd$)
Debug "Encrypted data:"
Debug mydata$
If Decrypt(@mydata$, Len(mydata$), pwd$)
Debug ""
Debug "Decrypted data:"
Debug mydata$
EndIf
EndIf