Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
MD5 encryption 15
- Thread starter elibb
- Start date
The MD5 algorythm is not for encrypting data. Its basic function is a non reversable checksum to make sure that data has not changed. Meaning when you create a file and save it and use the MD5 against it it will come up with a 32 bit word that uniquely describes the file. You can then later run the MD5 against the file and see if it matches the origional. If it does not then your file has been altered. Specific functions of the MD5 is for transmission of data using it as a checksum to ensure that none of the data has been lost or corrupted. Another use for the MD5 is for finding duplicates on a hard disk.
So in short, yes you can use it to see if the encrypted data has changed, but you cannot use it to encrypt data.
Good Luck
- Thread starter
- #3
-
1
- #4
There have been a number of threads dealing with this - do an advanced search on this forum using 'encryption encrypt', ' 'any words', 'any date' and you will find several, including thread222-356859 which contains many further links.
You may find it useful to read faq222-2244, as I notice that your quests for answers seem to have been very unsuccessful for you in the past.
You have asked over 140 questions, and only ackowledged about 40 answers and of those you only found
*** ONE *** to be either helpful or expert.
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first
'People who live in windowed environments shouldn't cast pointers.'
You may find it useful to read faq222-2244, as I notice that your quests for answers seem to have been very unsuccessful for you in the past.
You have asked over 140 questions, and only ackowledged about 40 answers and of those you only found
*** ONE *** to be either helpful or expert.
________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first
'People who live in windowed environments shouldn't cast pointers.'
-
9
- #5
Erm...MD5 produces a 128-bit fingerprint, and is somewhat more complex than a simple checksum. But, as you say, it is not an encryption algorithm.
Oddly, the thread (Thread222-333505) in which I gave code on using Window' built-in cryptography features (the CryptoAPI) appears to have been deleted for some reason. The original is on my PC at home, so I'll try to remember to post it later.
Oddly, the thread (Thread222-333505) in which I gave code on using Window' built-in cryptography features (the CryptoAPI) appears to have been deleted for some reason. The original is on my PC at home, so I'll try to remember to post it later.
strongm,
Oh yes you are so right that it is a 128 bit fingerprint that for some reason I confused with the 32 characters (bits) that you recieve back from calling the MD5.
From the executive summary...
[tt]
The MD5 algorithm is intended for digital signature applications, where a large file must be "compressed" in a secure manner before being encrypted with a private secret) key under a public-key cryptosystem such as RSA.
[/tt]
So then to infer, at the end of transmission of the file and any operations upon it depending upon the scheme of the program, you can run the MD5 against it as a checksum comparison to the origional MD5 to see if any data has changed.
Just one possibility of its use.
And, yes I am interested. Been having some trouble getting the crypto API to work on a target machine.
here we go. You'll need a form with three text boxes and a command button. Oh, and I use an MD5 hash, just to stay on topic...
[tt]
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, pbData As Any, pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, pbData As Any, pdwDataLen As Long) As Long
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_TYPE_RSA As Long = 1024
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const CALG_MD5 As Long = &H8003& ' Hashing algorithm
Private Const CALG_RC4 As Long = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4)
Private Const MS_DEFAULT_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Public Enum EncryptionMode
Encrypt
Decrypt
End Enum
Public Function vbEncrypt(strText As String, strPassword As String) As Byte()
vbEncrypt = CoreCrypto(strText, strPassword, Encrypt)
End Function
Public Function vbDecrypt(strText As String, strPassword As String) As Byte()
vbDecrypt = CoreCrypto(strText, strPassword, Decrypt)
End Function
Private Function CoreCrypto(strText As String, strPassword As String, Mode As EncryptionMode) As Byte()
Dim hProv As Long
Dim ByteBuffer() As Byte
Dim strprovider As String
Dim hHash As Long
Dim hKey As Long
Dim datalen As Long
ByteBuffer = strText
' Grab an RSA-based cryptoapi context using Microsoft's base provider
strprovider = MS_DEFAULT_PROVIDER & vbNullChar
Call CryptAcquireContext(hProv, vbNullString, strprovider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) ' final param could be 0&
' Generate a hash of the password
Call CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash)
Call CryptHashData(hHash, strPassword, Len(strPassword), 0)
' Derive a key symmetric key based on hashed password
Call CryptDeriveKey(hProv, CALG_RC4, hHash, 0&, hKey)
' Apply decryption or encryption using derived key
datalen = UBound(ByteBuffer)
Select Case Mode
Case Encrypt
Call CryptEncrypt(hKey, 0, 1, 0, ByteBuffer(0), datalen, UBound(ByteBuffer))
Case Decrypt
Call CryptDecrypt(hKey, 0, 1, 0, ByteBuffer(0), UBound(ByteBuffer))
End Select
CoreCrypto = ByteBuffer
' Clean up
CryptDestroyKey hKey
CryptReleaseContext hProv, 0&
End Function
Private Sub Command1_Click()
' result is really just a buffer, NOT a real VB string
Dim result As String
result = vbEncrypt(Text1.Text, "secret" ' remember that we are casting a byte array to a string to fill out buffer
Text2.Text = result ' text2.text ends up just with the displayable characters, not the entire buffer. As a result text2.text cannot be used as the source for decryption
Text3.Text = vbDecrypt(result, "secret"
End Sub
[tt]
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, pbData As Any, pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, pbData As Any, pdwDataLen As Long) As Long
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_TYPE_RSA As Long = 1024
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const CALG_MD5 As Long = &H8003& ' Hashing algorithm
Private Const CALG_RC4 As Long = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_RC4)
Private Const MS_DEFAULT_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Public Enum EncryptionMode
Encrypt
Decrypt
End Enum
Public Function vbEncrypt(strText As String, strPassword As String) As Byte()
vbEncrypt = CoreCrypto(strText, strPassword, Encrypt)
End Function
Public Function vbDecrypt(strText As String, strPassword As String) As Byte()
vbDecrypt = CoreCrypto(strText, strPassword, Decrypt)
End Function
Private Function CoreCrypto(strText As String, strPassword As String, Mode As EncryptionMode) As Byte()
Dim hProv As Long
Dim ByteBuffer() As Byte
Dim strprovider As String
Dim hHash As Long
Dim hKey As Long
Dim datalen As Long
ByteBuffer = strText
' Grab an RSA-based cryptoapi context using Microsoft's base provider
strprovider = MS_DEFAULT_PROVIDER & vbNullChar
Call CryptAcquireContext(hProv, vbNullString, strprovider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) ' final param could be 0&
' Generate a hash of the password
Call CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash)
Call CryptHashData(hHash, strPassword, Len(strPassword), 0)
' Derive a key symmetric key based on hashed password
Call CryptDeriveKey(hProv, CALG_RC4, hHash, 0&, hKey)
' Apply decryption or encryption using derived key
datalen = UBound(ByteBuffer)
Select Case Mode
Case Encrypt
Call CryptEncrypt(hKey, 0, 1, 0, ByteBuffer(0), datalen, UBound(ByteBuffer))
Case Decrypt
Call CryptDecrypt(hKey, 0, 1, 0, ByteBuffer(0), UBound(ByteBuffer))
End Select
CoreCrypto = ByteBuffer
' Clean up
CryptDestroyKey hKey
CryptReleaseContext hProv, 0&
End Function
Private Sub Command1_Click()
' result is really just a buffer, NOT a real VB string
Dim result As String
result = vbEncrypt(Text1.Text, "secret"
' remember that we are casting a byte array to a string to fill out bufferText2.Text = result ' text2.text ends up just with the displayable characters, not the entire buffer. As a result text2.text cannot be used as the source for decryption
Text3.Text = vbDecrypt(result, "secret"
End Sub
-
1
- #10
Wow, i didnt think it would be that simple!!
If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @
If somethings hard to do, its not worth doing - Homer Simpson
------------------------------------------------------------------------
A General Guide To Excel in VB FAQ222-3383
File Formats Galore @
Thank you,but i managed to to develop myself an algorim that encrypts the text from a text file.I read the text line by line and character by character. I am modifying the ascii code of each letter, by adding a value to it. After a encrypt all the text, a rewrite the text file.]
To decrypt i folow the same steps, but i extract the value from the ascii code.
That's all . . .
To decrypt i folow the same steps, but i extract the value from the ascii code.
That's all . . .
-
2
- #13
There is one fault for your approach. If you are taking chars one by one from a large file and encrypt it by doing some calculations with the ASCII code, it may take some time..
I use the CryptAPI. It helps me encrypt/decrypt a text file, (1 MB) in seconds. Pls respond if you wud like to see it.
I use the CryptAPI. It helps me encrypt/decrypt a text file, (1 MB) in seconds. Pls respond if you wud like to see it.
- Thread starter
- #14
Add a class module to your project..
'##########################################################
Option Explicit
Private m_Key As String
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal Hkey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal Hkey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal Hkey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Const SERVICE_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const KEY_CONTAINER As String = "OLEOLE"
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_NEWKEYSET As Long = 8
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 As Long = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM As Long = CALG_RC4
Public Sub EncryptByte(ByteArray() As Byte, Optional Password As String)
'Convert the array into a string, encrypt it
'and then convert it back to an array
ByteArray() = StrConv(EncryptString(StrConv(ByteArray(), vbUnicode), Password), vbFromUnicode)
End Sub
Public Function EncryptString(Text As String, Optional Password As String) As String
'Set the new key if any was sent to the function
If (Len(Password) > 0) Then Key = Password
'Return the encrypted data
EncryptString = EncryptDecrypt(Text, True)
End Function
Public Sub DecryptByte(ByteArray() As Byte, Optional Password As String)
'Convert the array into a string, decrypt it
'and then convert it back to an array
ByteArray() = StrConv(DecryptString(StrConv(ByteArray(), vbUnicode), Password), vbFromUnicode)
End Sub
Public Function DecryptString(Text As String, Optional Password As String) As String
'Set the new key if any was sent to the function
If (Len(Password) > 0) Then Key = Password
'Return the decrypted data
DecryptString = EncryptDecrypt(Text, False)
End Function
Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist)."
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to pass onto encryption
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Encrypt the bytearray
Call EncryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the encrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist)."
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to decrypt
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Decrypt the bytearray
Call DecryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the decrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Private Function EncryptDecrypt(ByVal Text As String, Encrypt As Boolean) As String
Dim Hkey As Long
Dim hHash As Long
Dim lLength As Long
Dim hCryptProv As Long
'Get handle to CSP
If (CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0) Then
If (CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0) = 0) Then
Call Err.Raise(vbObjectError, , "Error during CryptAcquireContext for a new key container." & vbCrLf & "A container with this name probably already exists."
End If
End If
'Create a hash object to calculate a session
'key from the password (instead of encrypting
'with the actual key)
If (CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash) = 0) Then
Call Err.Raise(vbObjectError, , "Could not create a Hash Object (CryptCreateHash API)"
End If
'Hash the password
If (CryptHashData(hHash, m_Key, Len(m_Key), 0) = 0) Then
Call Err.Raise(vbObjectError, , "Could not calculate a Hash Value (CryptHashData API)"
End If
'Derive a session key from the hash object
If (CryptDeriveKey(hCryptProv, ENCRYPT_ALGORITHM, hHash, 0, Hkey) = 0) Then
Call Err.Raise(vbObjectError, , "Could not create a session key (CryptDeriveKey API)"
End If
'Encrypt or decrypt depending on the Encrypt parameter
lLength = Len(Text)
If (Encrypt) Then
If (CryptEncrypt(Hkey, 0, 1, 0, Text, lLength, lLength) = 0) Then
Call Err.Raise(vbObjectError, , "Error during CryptEncrypt."
End If
Else
If (CryptDecrypt(Hkey, 0, 1, 0, Text, lLength) = 0) Then
' Call Err.Raise(vbObjectError, , "Error during CryptDecrypt."
End If
End If
'Return the encrypted/decrypted data
EncryptDecrypt = Left$(Text, lLength)
'Destroy the session key
If (Hkey <> 0) Then Call CryptDestroyKey(Hkey)
'Destroy the hash object
If (hHash <> 0) Then Call CryptDestroyHash(hHash)
'Release provider handle
If (hCryptProv <> 0) Then Call CryptReleaseContext(hCryptProv, 0)
End Function
Public Property Let Key(New_Value As String)
'Do nothing if no change was made
If (m_Key = New_Value) Then Exit Property
'Set the new key
m_Key = New_Value
End Property
'End Class Module
###########################################################
and I use it like this..
Public GL_SourceFileNameDC As String
Public GL_SourceFileNameEN As String
Public GL_blnShowDesignerOnly As Boolean
Private EncryptionKey As String
Public Function EncryptFile()
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
Call EncryptCryptAPI.EncryptFile (GL_SourceFileNameEN, GL_SourceFileNameDC, EncryptionKey)
End Function
Public Function DecryptFile()
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
Call EncryptCryptAPI.DecryptFile(GL_SourceFileNameEN, GL_SourceFileNameDC, EncryptionKey)
End Function
Public Function EncryptString(toConvert As String) As String
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
EncryptString = EncryptCryptAPI.EncryptString(toConvert, EncryptionKey)
End Function
Public Function DecryptString(toConvert As String) As String
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
DecryptString = EncryptCryptAPI.DecryptString(toConvert, EncryptionKey)
End Function
============================================================
The filename is a global variable in my project, you can change the utility functions to accept the file path and send out the status.
Hope it helps someone..
'##########################################################
Option Explicit
Private m_Key As String
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal Hkey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal Hkey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal Hkey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Const SERVICE_PROVIDER As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const KEY_CONTAINER As String = "OLEOLE"
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_NEWKEYSET As Long = 8
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_TYPE_STREAM As Long = 2048
Private Const ALG_SID_RC4 As Long = 1
Private Const ALG_SID_MD5 As Long = 3
Private Const CALG_MD5 As Long = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC4 As Long = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
Private Const ENCRYPT_ALGORITHM As Long = CALG_RC4
Public Sub EncryptByte(ByteArray() As Byte, Optional Password As String)
'Convert the array into a string, encrypt it
'and then convert it back to an array
ByteArray() = StrConv(EncryptString(StrConv(ByteArray(), vbUnicode), Password), vbFromUnicode)
End Sub
Public Function EncryptString(Text As String, Optional Password As String) As String
'Set the new key if any was sent to the function
If (Len(Password) > 0) Then Key = Password
'Return the encrypted data
EncryptString = EncryptDecrypt(Text, True)
End Function
Public Sub DecryptByte(ByteArray() As Byte, Optional Password As String)
'Convert the array into a string, decrypt it
'and then convert it back to an array
ByteArray() = StrConv(DecryptString(StrConv(ByteArray(), vbUnicode), Password), vbFromUnicode)
End Sub
Public Function DecryptString(Text As String, Optional Password As String) As String
'Set the new key if any was sent to the function
If (Len(Password) > 0) Then Key = Password
'Return the decrypted data
DecryptString = EncryptDecrypt(Text, False)
End Function
Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist)."
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to pass onto encryption
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Encrypt the bytearray
Call EncryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the encrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
Dim Filenr As Integer
Dim ByteArray() As Byte
'Make sure the source file do exist
If (Not FileExist(SourceFile)) Then
Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist)."
Exit Sub
End If
'Open the source file and read the content
'into a bytearray to decrypt
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
'Decrypt the bytearray
Call DecryptByte(ByteArray(), Key)
'If the destination file already exist we need
'to delete it since opening it for binary use
'will preserve it if it already exist
If (FileExist(DestFile)) Then Kill DestFile
'Store the decrypted data in the destination file
Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Private Function EncryptDecrypt(ByVal Text As String, Encrypt As Boolean) As String
Dim Hkey As Long
Dim hHash As Long
Dim lLength As Long
Dim hCryptProv As Long
'Get handle to CSP
If (CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) = 0) Then
If (CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0) = 0) Then
Call Err.Raise(vbObjectError, , "Error during CryptAcquireContext for a new key container." & vbCrLf & "A container with this name probably already exists."
End If
End If
'Create a hash object to calculate a session
'key from the password (instead of encrypting
'with the actual key)
If (CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash) = 0) Then
Call Err.Raise(vbObjectError, , "Could not create a Hash Object (CryptCreateHash API)"
End If
'Hash the password
If (CryptHashData(hHash, m_Key, Len(m_Key), 0) = 0) Then
Call Err.Raise(vbObjectError, , "Could not calculate a Hash Value (CryptHashData API)"
End If
'Derive a session key from the hash object
If (CryptDeriveKey(hCryptProv, ENCRYPT_ALGORITHM, hHash, 0, Hkey) = 0) Then
Call Err.Raise(vbObjectError, , "Could not create a session key (CryptDeriveKey API)"
End If
'Encrypt or decrypt depending on the Encrypt parameter
lLength = Len(Text)
If (Encrypt) Then
If (CryptEncrypt(Hkey, 0, 1, 0, Text, lLength, lLength) = 0) Then
Call Err.Raise(vbObjectError, , "Error during CryptEncrypt."
End If
Else
If (CryptDecrypt(Hkey, 0, 1, 0, Text, lLength) = 0) Then
' Call Err.Raise(vbObjectError, , "Error during CryptDecrypt."
End If
End If
'Return the encrypted/decrypted data
EncryptDecrypt = Left$(Text, lLength)
'Destroy the session key
If (Hkey <> 0) Then Call CryptDestroyKey(Hkey)
'Destroy the hash object
If (hHash <> 0) Then Call CryptDestroyHash(hHash)
'Release provider handle
If (hCryptProv <> 0) Then Call CryptReleaseContext(hCryptProv, 0)
End Function
Public Property Let Key(New_Value As String)
'Do nothing if no change was made
If (m_Key = New_Value) Then Exit Property
'Set the new key
m_Key = New_Value
End Property
'End Class Module
###########################################################
and I use it like this..
Public GL_SourceFileNameDC As String
Public GL_SourceFileNameEN As String
Public GL_blnShowDesignerOnly As Boolean
Private EncryptionKey As String
Public Function EncryptFile()
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
Call EncryptCryptAPI.EncryptFile (GL_SourceFileNameEN, GL_SourceFileNameDC, EncryptionKey)
End Function
Public Function DecryptFile()
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
Call EncryptCryptAPI.DecryptFile(GL_SourceFileNameEN, GL_SourceFileNameDC, EncryptionKey)
End Function
Public Function EncryptString(toConvert As String) As String
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
EncryptString = EncryptCryptAPI.EncryptString(toConvert, EncryptionKey)
End Function
Public Function DecryptString(toConvert As String) As String
Dim EncryptCryptAPI As New clsCryptAPI
EncryptionKey = Chr(118) & Chr(98) & Chr(115) & Chr(117) & Chr(110)
DecryptString = EncryptCryptAPI.DecryptString(toConvert, EncryptionKey)
End Function
============================================================
The filename is a global variable in my project, you can change the utility functions to accept the file path and send out the status.
Hope it helps someone..
-
1
- #18
I tried using strongm's example of the above encryption method and everything worked fine. The only problem is that I want to save the encryption out to a file and be able to recall it at a later time and decrypt it. This is where the problem is posed due to the fact that characters that can not be displayed are not written out to the file, or so I think. Any ideas anyone?? here is my code for the part that I am attempting to read from the file and decrypt.
result = vbEncrypt(txtstring, "secret") ' remember that we are casting a byte array to a string to fill out buffer
Text2.Text = result ' text2.text ends up just with the displayable characters, not the entire buffer. As a result text2.text cannot be used as the source for decryption
MsgBox vbDecrypt(result, "secret") ''this part works fine
'****************************************
'save encrypted file to the txtfile
f = FreeFile 'get free file int
destfile = App.Path & "\cycencr.txt"
Open destfile For Output As #f
Print #f, result
Close #f
'*****************************************
'******open the file
f = FreeFile
Open destfile For Input As #f
Do Until EOF(f)
Line Input #f, nextline
txtstring_d = txtstring_d + nextline
Loop
'**********************************************************************
'after getting the text back from the file into a string the decrypt will no longer
'work????
result = vbDecrypt(txtstring_d, "secret") 'this one does not work fine
Text3.Text = result
result = vbEncrypt(txtstring, "secret") ' remember that we are casting a byte array to a string to fill out buffer
Text2.Text = result ' text2.text ends up just with the displayable characters, not the entire buffer. As a result text2.text cannot be used as the source for decryption
MsgBox vbDecrypt(result, "secret") ''this part works fine
'****************************************
'save encrypted file to the txtfile
f = FreeFile 'get free file int
destfile = App.Path & "\cycencr.txt"
Open destfile For Output As #f
Print #f, result
Close #f
'*****************************************
'******open the file
f = FreeFile
Open destfile For Input As #f
Do Until EOF(f)
Line Input #f, nextline
txtstring_d = txtstring_d + nextline
Loop
'**********************************************************************
'after getting the text back from the file into a string the decrypt will no longer
'work????
result = vbDecrypt(txtstring_d, "secret") 'this one does not work fine
Text3.Text = result
I've figured it out in case anyone is wondering what was wrong. I just made sure that the encryption didnt have any CR or LF characters. This way writing it to the file was no problem. (by the way incase you dont know CR and LF stand for carriage return and line feed)
I have a question about all of this...
It is known that adding a single value to every letter in a text file is easy to crack, since there are only 256 different variations...
But If You were to take a password and blend it with a file, would that make it any more secure?
Such as:
That way the ONLY way you can decrypt the file is with the Password, and the password has to be the right length or it will just make it more cryptic...
This method might totally suck, but I would like to see why it would...
It's short and sweet, and it looks like it would work to me...
And there would be over 32 * 256^2 possible passwords (2,097,152)... in other words you could even generate a file with 8192 random characters and use that for your password... ;-)
Have Fun, Be Young... Code BASIC
-Josh
PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.
It is known that adding a single value to every letter in a text file is easy to crack, since there are only 256 different variations...
But If You were to take a password and blend it with a file, would that make it any more secure?
Such as:
Code:
Private Sub FileEncrypt(InFile As String, Outfile As String, Pass As String)
Open InFile For Input As #1
Open Outfile For Output As #2
a3 = Len(Pass)
For i = 0 To LOF(1) - 1
a1 = Asc(Input(1, #1))
a2 = Asc(Mid(Pass, i Mod Len(Pass) + 1, 1))
Print #2, Chr((a1 + a2 + a3) Mod 256);
Next
Close #2
Close #1
End Sub
Private Sub FileDecrypt(InFile As String, Outfile As String, Pass As String)
Open InFile For Input As #1
Open Outfile For Output As #2
a3 = Len(Pass)
For i = 0 To LOF(1) - 1
a1 = Asc(Input(1, #1))
a2 = Asc(Mid(Pass, i Mod Len(Pass) + 1, 1))
Print #2, Chr(((a1 - a2 - a3) + 8448) Mod 256);
Next
Close #2
Close #1
End SubThat way the ONLY way you can decrypt the file is with the Password, and the password has to be the right length or it will just make it more cryptic...
This method might totally suck, but I would like to see why it would...
It's short and sweet, and it looks like it would work to me...
And there would be over 32 * 256^2 possible passwords (2,097,152)... in other words you could even generate a file with 8192 random characters and use that for your password... ;-)
Have Fun, Be Young... Code BASIC
-Josh
PROGRAMMER:
Red-eyed, mumbling mammal capable of conversing with inanimate objects.- Status
Similar threads
- Locked
- Question
