Sub crypt(PASS As String, strg As String)
a = 1
For I = 1 To Len(strg)
b = Asc(Mid$(PASS, a, 1)): a = a + 1: If a > Len(PASS) Then a = 1
Mid$(strg, I, 1) = Chr$(Asc(Mid$(strg, I, 1)) Xor b)
Next
End Sub
Function PW_Encript(PASS As String, strg As String) As String
' Debug.Print "Encrypted = "; strg
'When writing an encrypted password to a sequential access file like the
'INI files, you need to convert the resultant encrypted file to hex data.
'This is because you can end up with an encrypted password that contains
'characters which cannot be properly read using sequential access. So,
'before saving your encrypted password, use this routine:
h = ""
For I = 1 To Len(strg)
j$ = Hex$(Asc(Mid$(strg, I, 1)))
If Len(j$) = 1 Then j$ = "0" + j$
h = h + j$
Next
' Debug.Print "Hex = "; h
'This will create a string like "0EF31105" or some such. Save that to
'the INI file.
'Store the LENGTH of the password string as 2 bytes and concatenate
h = Format$(Len(h), "00") + h
'x% = WritePrivateProfileString("SECURITY", "PASSWORD", h, App.Path & "\sms.dat")
PW_Encript = h
End Function
Function Encript(PASS As String, strg As String) As String
'pass = "PASSWORD"
'strg = "You won't crack this easily"
' Debug.Print "Original = "; strg
Call crypt(PASS, strg)
' Debug.Print "Encrypted = "; strg
'When writing an encrypted password to a sequential access file like the
'INI files, you need to convert the resultant encrypted file to hex data.
'This is because you can end up with an encrypted password that contains
'characters which cannot be properly read using sequential access. So,
'before saving your encrypted password, use this routine:
h = ""
For I = 1 To Len(strg)
j$ = Hex$(Asc(Mid$(strg, I, 1)))
If Len(j$) = 1 Then j$ = "0" + j$
h = h + j$
Next
' Debug.Print "Hex = "; h
'This will create a string like "0EF31105" or some such. Save that to
'the INI file.
'Store the LENGTH of the password string as 2 bytes and concatenate
h = Format$(Len(h), "00") + h
x% = WritePrivateProfileString("SECURITY", "PASSWORD", h, App.Path & "\sms.dat")
End Function
Function PW_Decript(PASS As String, strg As String) As String
'To read it back in,
h = strg
'x% = GetPrivateProfileString(SectionName, KeyName, "", h, Len(h), App.Path & "\sms.dat")
'Debug.Print "After INI read = "; h
'PASSWORD=160000000000000000
h = Mid$(h, 3, Val(Left$(h, 2)))
'Debug.Print "Before hex conversion = "; h
strg = ""
For I = 1 To Len(h) Step 2
j$ = Mid$(h, I, 2)
strg = strg + Chr$(Val("&H" + j$))
Next
'Debug.Print "After hex conversion = "; strg
'strg would then contain the encrypted string, which you can now
'decrypt.
Call crypt(PASS, strg)
'Debug.Print "Decrypted = "; strg
PW_Decript = strg
End Function
Function Decript(PASS As String, strg As String, SectionName As String, KeyName As String) As String
'To read it back in,
h = Space$(254)
x% = GetPrivateProfileString(SectionName, KeyName, "", h, Len(h), App.Path & "\sms.dat")
'Debug.Print "After INI read = "; h
'PASSWORD=160000000000000000
h = Mid$(h, 3, Val(Left$(h, 2)))
strg = ""
For I = 1 To Len(h) Step 2
j$ = Mid$(h, I, 2)
strg = strg + Chr$(Val("&H" + j$))
Next
Call crypt(PASS, strg)
'Debug.Print "Decrypted = "; strg
Decript = strg
End Function
|
No responses found. Be the first to respond and make money from revenue sharing program.
|