makeing a password
working on a program, needs a password.
what I want to do is just have the users put in their name, and their password in, and then have the program encrypt the password and write it to a file.
I'm ok with all the programming on haveing the user enter the data, and to writing it to a file, but I want to be able to have the file name that the passwords are kept in, NOT findable in the .EXE code when looked at in any kind of HEX editator, and I am after any kind of encodeing algorithm that can be used on the passwords.
Any help is greatly appreciated. Thanks
what I want to do is just have the users put in their name, and their password in, and then have the program encrypt the password and write it to a file.
I'm ok with all the programming on haveing the user enter the data, and to writing it to a file, but I want to be able to have the file name that the passwords are kept in, NOT findable in the .EXE code when looked at in any kind of HEX editator, and I am after any kind of encodeing algorithm that can be used on the passwords.
Any help is greatly appreciated. Thanks
Another solution is keeping the pwd file in a known directory :
-> \System32
-> Windir
.
But be careful that other applications won't delete items in those folders.
Here is a function to get the path of special folders :
Option Explicit
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Enum Special_Folder
CSIDL_DESKTOP = 0 'Windows Desktop—virtual folder at the root of the namespace.
CSIDL_INTERNET 'Virtual folder representing the Internet.
CSIDL_PROGRAMS 'File system directory that contains the user's program groups (which are also file system directories).
CSIDL_CONTROLS 'Virtual folder containing icons for the Control Panel applications.
CSIDL_PRINTERS 'Virtual folder containing installed printers.
CSIDL_PERSONAL 'File system directory that serves as a common repository for documents.
CSIDL_FAVORITES 'File system directory that serves as a common repository for the user's favorite items.
CSIDL_STARTUP 'File system directory that corresponds to the user's Startup program group. The system starts these programs whenever any user logs onto Windows NT or starts Windows 95.
CSIDL_RECENT 'File system directory that contains the user's most recently used documents.
CSIDL_SENDTO 'File system directory that contains Send To menu items.
CSIDL_BITBUCKET 'File system directory containing file objects in the user's Recycle Bin. The location of this directory is not in the registry; it is marked with the hidden and system attributes to prevent the user from moving or deleting it.
CSIDL_STARTMENU 'File system directory containing Start menu items.
CSIDL_DESKTOPDIRECTORY 'File system directory used to physically store file objects on the desktop (not to be confused with the desktop folder itself).
CSIDL_DRIVES 'My Computer—virtual folder containing everything on the local computer: storage devices, printers, and Control Panel. The folder may also contain mapped network drives.
CSIDL_NETWORK 'Network Neighborhood Folder—virtual folder representing the top level of the network hierarchy.
CSIDL_NETHOOD 'File system directory containing objects that appear in the network neighborhood.
CSIDL_FONTS 'Virtual folder containing fonts.
CSIDL_TEMPLATES 'File system directory that serves as a common repository for document templates.
CSIDL_COMMON_STARTMENU 'File system directory that contains the programs and folders that appear on the Start menu for all users.
CSIDL_COMMON_PROGRAMS 'File system directory that contains the directories for the common program groups that appear on the Start menu for all users.
CSIDL_COMMON_STARTUP 'File system directory that contains the programs that appear in the Startup folder for all users.
CSIDL_COMMON_DESKTOPDIRECT
CSIDL_APPDATA 'File system directory that serves as a common repository for application-specific data.
CSIDL_PRINTHOOD 'File system directory that serves as a common repository for printer links.
CSIDL_ALTSTARTUP 'File system directory that corresponds to the user's nonlocalized Startup program group.
CSIDL_COMMON_ALTSTARTUP 'File system directory that corresponds to the nonlocalized Startup program group for all users.
CSIDL_COMMON_FAVORITES 'File system directory that serves as a common repository for all users' favorite items.
CSIDL_INTERNET_CACHE 'File system directory that serves as a common repository for temporary Internet files.
CSIDL_COOKIES 'File system directory that serves as a common repository for Internet cookies.
CSIDL_HISTORY 'File system directory that serves as a common repository for Internet history items.
End Enum
Private Declare Function SHGetSpecialFolderLocation
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
' *** Windows and system directory
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function GetSpecialFolder(ByVal CSIDL As Long) As String
' *** Return the path to special folders
Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260
' *** Get the special folder
r = SHGetSpecialFolderLocation
If r = NOERROR Then
' *** Get the special folder using the IDL
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
If r Then
GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End If
End Function
-> \System32
-> Windir
.
But be careful that other applications won't delete items in those folders.
Here is a function to get the path of special folders :
Option Explicit
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Enum Special_Folder
CSIDL_DESKTOP = 0 'Windows Desktop—virtual folder at the root of the namespace.
CSIDL_INTERNET 'Virtual folder representing the Internet.
CSIDL_PROGRAMS 'File system directory that contains the user's program groups (which are also file system directories).
CSIDL_CONTROLS 'Virtual folder containing icons for the Control Panel applications.
CSIDL_PRINTERS 'Virtual folder containing installed printers.
CSIDL_PERSONAL 'File system directory that serves as a common repository for documents.
CSIDL_FAVORITES 'File system directory that serves as a common repository for the user's favorite items.
CSIDL_STARTUP 'File system directory that corresponds to the user's Startup program group. The system starts these programs whenever any user logs onto Windows NT or starts Windows 95.
CSIDL_RECENT 'File system directory that contains the user's most recently used documents.
CSIDL_SENDTO 'File system directory that contains Send To menu items.
CSIDL_BITBUCKET 'File system directory containing file objects in the user's Recycle Bin. The location of this directory is not in the registry; it is marked with the hidden and system attributes to prevent the user from moving or deleting it.
CSIDL_STARTMENU 'File system directory containing Start menu items.
CSIDL_DESKTOPDIRECTORY 'File system directory used to physically store file objects on the desktop (not to be confused with the desktop folder itself).
CSIDL_DRIVES 'My Computer—virtual folder containing everything on the local computer: storage devices, printers, and Control Panel. The folder may also contain mapped network drives.
CSIDL_NETWORK 'Network Neighborhood Folder—virtual folder representing the top level of the network hierarchy.
CSIDL_NETHOOD 'File system directory containing objects that appear in the network neighborhood.
CSIDL_FONTS 'Virtual folder containing fonts.
CSIDL_TEMPLATES 'File system directory that serves as a common repository for document templates.
CSIDL_COMMON_STARTMENU 'File system directory that contains the programs and folders that appear on the Start menu for all users.
CSIDL_COMMON_PROGRAMS 'File system directory that contains the directories for the common program groups that appear on the Start menu for all users.
CSIDL_COMMON_STARTUP 'File system directory that contains the programs that appear in the Startup folder for all users.
CSIDL_COMMON_DESKTOPDIRECT
CSIDL_APPDATA 'File system directory that serves as a common repository for application-specific data.
CSIDL_PRINTHOOD 'File system directory that serves as a common repository for printer links.
CSIDL_ALTSTARTUP 'File system directory that corresponds to the user's nonlocalized Startup program group.
CSIDL_COMMON_ALTSTARTUP 'File system directory that corresponds to the nonlocalized Startup program group for all users.
CSIDL_COMMON_FAVORITES 'File system directory that serves as a common repository for all users' favorite items.
CSIDL_INTERNET_CACHE 'File system directory that serves as a common repository for temporary Internet files.
CSIDL_COOKIES 'File system directory that serves as a common repository for Internet cookies.
CSIDL_HISTORY 'File system directory that serves as a common repository for Internet history items.
End Enum
Private Declare Function SHGetSpecialFolderLocation
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
' *** Windows and system directory
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function GetSpecialFolder(ByVal CSIDL As Long) As String
' *** Return the path to special folders
Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260
' *** Get the special folder
r = SHGetSpecialFolderLocation
If r = NOERROR Then
' *** Get the special folder using the IDL
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
If r Then
GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End If
End Function
for the file name you could do a number of things.
1) Store pieces of the filename in strings, then concat the strings together when you want the file name. You could create a function to do the concat.
2) In conjunction with #1, encrypt the filename strings, so a HEX editor will not show the pieces
But, you can't hide the file on the disk. If someone wants it they can find the file that contains the passwords.
1) Store pieces of the filename in strings, then concat the strings together when you want the file name. You could create a function to do the concat.
2) In conjunction with #1, encrypt the filename strings, so a HEX editor will not show the pieces
But, you can't hide the file on the disk. If someone wants it they can find the file that contains the passwords.
They are variety of encrypting ways
The one I most like is combination of two
The first method says:
“Change the changes”, let give an example:
I assume you’re your password contain 4 digits:
for the first char make bit Xor with “A” ,
for the second one character assci value decrease 123
for the third add 100 and
for the last one, again add 100, but this time save the string itself, so it will take three characters
in this way you can go away with your imagination.
Now we are at stage 2:
In my example, your 4 characters password take 6 places, that OK, but you will not save just 6 characters
You will save 20
The first digit you will put at the third place, the second in the forth one, the third character in offset of 11 and the last three characters you will put in 15, 16 and 19
The others characters you will choose randomly with rnd() function, so any one that will try to see what chars are change, will see all of them change each time.
Well this is the idea
If you need for some more explanation please don’t hesitate for a moment, just send a comment and I will answer you
Good Luck
Schild
The one I most like is combination of two
The first method says:
“Change the changes”, let give an example:
I assume you’re your password contain 4 digits:
for the first char make bit Xor with “A” ,
for the second one character assci value decrease 123
for the third add 100 and
for the last one, again add 100, but this time save the string itself, so it will take three characters
in this way you can go away with your imagination.
Now we are at stage 2:
In my example, your 4 characters password take 6 places, that OK, but you will not save just 6 characters
You will save 20
The first digit you will put at the third place, the second in the forth one, the third character in offset of 11 and the last three characters you will put in 15, 16 and 19
The others characters you will choose randomly with rnd() function, so any one that will try to see what chars are change, will see all of them change each time.
Well this is the idea
If you need for some more explanation please don’t hesitate for a moment, just send a comment and I will answer you
Good Luck
Schild
They are variety of encrypting ways
The one I most like is combination of two
The first method says:
“Change the changes”, let give an example:
I assume you’re your password contain 4 digits:
for the first char make bit Xor with “A” ,
for the second one character assci value decrease 123
for the third add 100 and
for the last one, again add 100, but this time save the string itself, so it will take three characters
in this way you can go away with your imagination.
Now we are at stage 2:
In my example, your 4 characters password take 6 places, that OK, but you will not save just 6 characters
You will save 20
The first digit you will put at the third place, the second in the forth one, the third character in offset of 11 and the last three characters you will put in 15, 16 and 19
The others characters you will choose randomly with rnd() function, so any one that will try to see what chars are change, will see all of them change each time.
Well this is the idea
If you need for some more explanation please don’t hesitate for a moment, just send a comment and I will answer you
Good Luck
Schild
The one I most like is combination of two
The first method says:
“Change the changes”, let give an example:
I assume you’re your password contain 4 digits:
for the first char make bit Xor with “A” ,
for the second one character assci value decrease 123
for the third add 100 and
for the last one, again add 100, but this time save the string itself, so it will take three characters
in this way you can go away with your imagination.
Now we are at stage 2:
In my example, your 4 characters password take 6 places, that OK, but you will not save just 6 characters
You will save 20
The first digit you will put at the third place, the second in the forth one, the third character in offset of 11 and the last three characters you will put in 15, 16 and 19
The others characters you will choose randomly with rnd() function, so any one that will try to see what chars are change, will see all of them change each time.
Well this is the idea
If you need for some more explanation please don’t hesitate for a moment, just send a comment and I will answer you
Good Luck
Schild
ASKER
Waty, how do I use the encryption class you posted, I didn't understand it all that well. sorry.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
sorry waty, the thing is great, i just cant work out how to call the class and what objects i need on the form or whatever...does it also decrypt?
No, but I will add this function now. and post it.
Add a comment, so it will remind me to add as comment here.
Add a comment, so it will remind me to add as comment here.
Here is the class with the decrypt.
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 6/10/98
' * Time : 15:06
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' **************************
' * Comments : Class used for encryption
' *
' * Sample
' * Dim cEnrypt As New class_Encryption
' * Dim sEncrypt As String
' *
' * cEnrypt.KeyString = Date
' * sEncrypt = cEnrypt.Encrypt("Thierry Waty")
' *
' * Debug.Print sEncrypt
' * Debug.Print cEnrypt.Decrypt(sEncrypt)
' *
' **************************
Option Explicit
Private LCW As Integer ' Length of sCodeWord
Private LS2E As Integer ' Length of String to be Encrypted
Private LAM As Integer ' Length of Array sMatrix
Private MP As Integer ' Matrix Position
Private sMatrix As String ' Starting sMatrix
Private sMov1 As String ' First Part of Replacement String
Private sMov2 As String ' Second Part of Replacement String
Private sCodeWord As String ' CodeWord
Private CWL As String ' CodeWord Letter
Private sEncryptedString As String ' String to Return for Encrypt or String to UnEncrypt for UnEncrypt
Private sEncryptedLetter As String ' Storage Variable for Character just Encrypted
Private sCryptMatrix(97) As String ' Matrix Array
Public Property Let KeyString(sKeyString As String)
sCodeWord = sKeyString
End Property
Public Function Encrypt(sToEncrypt As String) As String
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:22
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Encrypt
' * Parameters :
' * sToEncrypt As String
' **************************
' * Comments : Encrypt a string using the key
' *
' *
' **************************
Dim x As Integer ' Loop Counter
Dim y As Integer ' Loop Counter
Dim Z As Integer ' Loop Counter
Dim C2E As String ' Character to Encrypt
Dim Str2Encrypt As String ' Text from TextBox
Str2Encrypt = sToEncrypt
LS2E = Len(sToEncrypt)
LCW = Len(sCodeWord)
sEncryptedLetter = ""
sEncryptedString = ""
y = 1
For x = 1 To LS2E
C2E = Mid(Str2Encrypt, x, 1)
MP = InStr(1, sMatrix, C2E, 0)
CWL = Mid(sCodeWord, y, 1)
For Z = 1 To LAM
If Mid(sCryptMatrix(Z), MP, 1) = CWL Then
sEncryptedLetter = Left(sCryptMatrix(Z), 1)
sEncryptedString = sEncryptedString + sEncryptedLetter
Exit For
End If
Next
y = y + 1
If y > LCW Then y = 1
Next
Encrypt = sEncryptedString
End Function
Public Function Decrypt(sToDecrypt As String) As String
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:22
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Decrypt
' * Parameters :
' * sToDecrypt As String
' **************************
' * Comments : Decrypt a string using the key
' *
' *
' **************************
Dim x As Integer ' Loop Counter
Dim y As Integer ' Loop Counter
Dim Z As Integer ' Loop Counter
Dim C2E As String ' Character to Encrypt
Dim Str2Encrypt As String ' Text from TextBox
Str2Encrypt = sToDecrypt
LS2E = Len(sToDecrypt)
LCW = Len(sCodeWord)
sEncryptedLetter = ""
sEncryptedString = ""
y = 1
For x = 1 To LS2E
C2E = Mid(Str2Encrypt, x, 1)
MP = InStr(1, sMatrix, C2E, 0)
CWL = Mid(sCodeWord, y, 1)
For Z = 1 To LAM
If Mid(sCryptMatrix(Z), MP, 1) = CWL Then
sEncryptedLetter = Left(sCryptMatrix(Z), 1)
sEncryptedString = sEncryptedString + sEncryptedLetter
Exit For
End If
Next
y = y + 1
If y > LCW Then y = 1
Next
Decrypt = sEncryptedString
End Function
Private Sub Class_Initialize()
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:23
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Class_Initialize
' * Parameters :
' **************************
' * Comments : Initialise the class
' *
' *
' **************************
Dim W As Integer ' Loop Counter to set up sMatrix
Dim x As Integer ' Loop through sMatrix
sMatrix = "8x3p5Beabcdfghijklmnoqrst
sMatrix = sMatrix + Chr(13) ' Add Carriage Return to sMatrix
sMatrix = sMatrix + Chr(10) ' Add Line Feed to sMatrix
sMatrix = sMatrix + Chr(34) ' Add "
' Unique String used to make sMatrix - 8x3p5Be
' Unique String can be any combination that has a character only ONCE.
' EACH Letter in the sMatrix is Input ONLY once.
W = 1
LAM = Len(sMatrix)
sCryptMatrix(1) = sMatrix
For x = 2 To LAM - 1 ' LAM = Length of Array sMatrix
sMov1 = Left(sCryptMatrix(W), 1) ' First Character of sCryptMatrix
sMov2 = Right(sCryptMatrix(W), (LAM - 1)) ' All but First Character of sCryptMatrix
sCryptMatrix(x) = sMov2 + sMov1 ' Makes up each row of the Array
W = W + 1
Next
End Sub
Dim cEnrypt As New class_Encryption
Dim sEncrypt As String
cEnrypt.KeyString = Date
sEncrypt = cEnrypt.Encrypt("Thierry Waty")
Debug.Print sEncrypt
Debug.Print cEnrypt.Decrypt(sEncrypt)
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 6/10/98
' * Time : 15:06
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' **************************
' * Comments : Class used for encryption
' *
' * Sample
' * Dim cEnrypt As New class_Encryption
' * Dim sEncrypt As String
' *
' * cEnrypt.KeyString = Date
' * sEncrypt = cEnrypt.Encrypt("Thierry Waty")
' *
' * Debug.Print sEncrypt
' * Debug.Print cEnrypt.Decrypt(sEncrypt)
' *
' **************************
Option Explicit
Private LCW As Integer ' Length of sCodeWord
Private LS2E As Integer ' Length of String to be Encrypted
Private LAM As Integer ' Length of Array sMatrix
Private MP As Integer ' Matrix Position
Private sMatrix As String ' Starting sMatrix
Private sMov1 As String ' First Part of Replacement String
Private sMov2 As String ' Second Part of Replacement String
Private sCodeWord As String ' CodeWord
Private CWL As String ' CodeWord Letter
Private sEncryptedString As String ' String to Return for Encrypt or String to UnEncrypt for UnEncrypt
Private sEncryptedLetter As String ' Storage Variable for Character just Encrypted
Private sCryptMatrix(97) As String ' Matrix Array
Public Property Let KeyString(sKeyString As String)
sCodeWord = sKeyString
End Property
Public Function Encrypt(sToEncrypt As String) As String
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:22
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Encrypt
' * Parameters :
' * sToEncrypt As String
' **************************
' * Comments : Encrypt a string using the key
' *
' *
' **************************
Dim x As Integer ' Loop Counter
Dim y As Integer ' Loop Counter
Dim Z As Integer ' Loop Counter
Dim C2E As String ' Character to Encrypt
Dim Str2Encrypt As String ' Text from TextBox
Str2Encrypt = sToEncrypt
LS2E = Len(sToEncrypt)
LCW = Len(sCodeWord)
sEncryptedLetter = ""
sEncryptedString = ""
y = 1
For x = 1 To LS2E
C2E = Mid(Str2Encrypt, x, 1)
MP = InStr(1, sMatrix, C2E, 0)
CWL = Mid(sCodeWord, y, 1)
For Z = 1 To LAM
If Mid(sCryptMatrix(Z), MP, 1) = CWL Then
sEncryptedLetter = Left(sCryptMatrix(Z), 1)
sEncryptedString = sEncryptedString + sEncryptedLetter
Exit For
End If
Next
y = y + 1
If y > LCW Then y = 1
Next
Encrypt = sEncryptedString
End Function
Public Function Decrypt(sToDecrypt As String) As String
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:22
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Decrypt
' * Parameters :
' * sToDecrypt As String
' **************************
' * Comments : Decrypt a string using the key
' *
' *
' **************************
Dim x As Integer ' Loop Counter
Dim y As Integer ' Loop Counter
Dim Z As Integer ' Loop Counter
Dim C2E As String ' Character to Encrypt
Dim Str2Encrypt As String ' Text from TextBox
Str2Encrypt = sToDecrypt
LS2E = Len(sToDecrypt)
LCW = Len(sCodeWord)
sEncryptedLetter = ""
sEncryptedString = ""
y = 1
For x = 1 To LS2E
C2E = Mid(Str2Encrypt, x, 1)
MP = InStr(1, sMatrix, C2E, 0)
CWL = Mid(sCodeWord, y, 1)
For Z = 1 To LAM
If Mid(sCryptMatrix(Z), MP, 1) = CWL Then
sEncryptedLetter = Left(sCryptMatrix(Z), 1)
sEncryptedString = sEncryptedString + sEncryptedLetter
Exit For
End If
Next
y = y + 1
If y > LCW Then y = 1
Next
Decrypt = sEncryptedString
End Function
Private Sub Class_Initialize()
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 7/10/98
' * Time : 16:23
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' * Procedure Name : Class_Initialize
' * Parameters :
' **************************
' * Comments : Initialise the class
' *
' *
' **************************
Dim W As Integer ' Loop Counter to set up sMatrix
Dim x As Integer ' Loop through sMatrix
sMatrix = "8x3p5Beabcdfghijklmnoqrst
sMatrix = sMatrix + Chr(13) ' Add Carriage Return to sMatrix
sMatrix = sMatrix + Chr(10) ' Add Line Feed to sMatrix
sMatrix = sMatrix + Chr(34) ' Add "
' Unique String used to make sMatrix - 8x3p5Be
' Unique String can be any combination that has a character only ONCE.
' EACH Letter in the sMatrix is Input ONLY once.
W = 1
LAM = Len(sMatrix)
sCryptMatrix(1) = sMatrix
For x = 2 To LAM - 1 ' LAM = Length of Array sMatrix
sMov1 = Left(sCryptMatrix(W), 1) ' First Character of sCryptMatrix
sMov2 = Right(sCryptMatrix(W), (LAM - 1)) ' All but First Character of sCryptMatrix
sCryptMatrix(x) = sMov2 + sMov1 ' Makes up each row of the Array
W = W + 1
Next
End Sub
Dim cEnrypt As New class_Encryption
Dim sEncrypt As String
cEnrypt.KeyString = Date
sEncrypt = cEnrypt.Encrypt("Thierry Waty")
Debug.Print sEncrypt
Debug.Print cEnrypt.Decrypt(sEncrypt)
ASKER
thanks for the decrypt waty, unfortunatly I still havnen't made the encrypt work yet, can u give instructions on how to make it work?
Did you tried the following code :
Dim cEnrypt As New class_Encryption
Dim sEncrypt As String
cEnrypt.KeyString = Date
sEncrypt = cEnrypt.Encrypt("Thierry Waty")
Debug.Print sEncrypt
Debug.Print cEnrypt.Decrypt(sEncrypt)
Dim cEnrypt As New class_Encryption
Dim sEncrypt As String
cEnrypt.KeyString = Date
sEncrypt = cEnrypt.Encrypt("Thierry Waty")
Debug.Print sEncrypt
Debug.Print cEnrypt.Decrypt(sEncrypt)
ASKER
Thankyou Waty, you've been a great help!
Here is a class to encrypt
' #VBIDEUtils#**************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 6/10/98
' * Time : 15:06
' * Module Name : class_Encryption
' * Module Filename : Encryption.cls
' **************************
' * Comments : Class used for encryption
' *
' *
' **************************
Option Explicit
Private LCW As Integer ' Length of CodeWord
Private LS2E As Integer ' Length of String to be Encrypted
Private LAM As Integer ' Length of Array Matrix
Private MP As Integer ' Matrix Position
Private Matrix As String ' Starting Matrix
Private mov1 As String ' First Part of Replacement String
Private mov2 As String ' Second Part of Replacement String
Private CodeWord As String ' CodeWord
Private CWL As String ' CodeWord Letter
Private EncryptedString As String ' String to Return for Encrypt or String to UnEncrypt for UnEncrypt
Private EncryptedLetter As String ' Storage Variable for Character just Encrypted
Private strCryptMatrix(97) As String ' Matrix Array
Public Property Let KeyString(sKeyString As String)
CodeWord = sKeyString
End Property
Public Function Encrypt(mstext As String) As String
Dim x As Integer ' Loop Counter
Dim y As Integer ' Loop Counter
Dim Z As Integer ' Loop Counter
Dim C2E As String ' Character to Encrypt
Dim Str2Encrypt As String ' Text from TextBox
Str2Encrypt = mstext
LS2E = Len(mstext)
LCW = Len(CodeWord)
EncryptedLetter = ""
EncryptedString = ""
y = 1
For x = 1 To LS2E
C2E = Mid(Str2Encrypt, x, 1)
MP = InStr(1, Matrix, C2E, 0)
CWL = Mid(CodeWord, y, 1)
For Z = 1 To LAM
If Mid(strCryptMatrix(Z), MP, 1) = CWL Then
EncryptedLetter = Left(strCryptMatrix(Z), 1)
EncryptedString = EncryptedString + EncryptedLetter
Exit For
End If
Next
y = y + 1
If y > LCW Then y = 1
Next
Encrypt = EncryptedString
End Function
Private Sub Class_Initialize()
Dim W As Integer ' Loop Counter to set up Matrix
Dim x As Integer ' Loop through Matrix
Matrix = "8x3p5Beabcdfghijklmnoqrst
Matrix = Matrix + Chr(13) ' Add Carriage Return to Matrix
Matrix = Matrix + Chr(10) ' Add Line Feed to Matrix
Matrix = Matrix + Chr(34) ' Add "
' Unique String used to make Matrix - 8x3p5Be
' Unique String can be any combination that has a character only ONCE.
' EACH Letter in the Matrix is Input ONLY once.
W = 1
LAM = Len(Matrix)
strCryptMatrix(1) = Matrix
For x = 2 To LAM ' LAM = Length of Array Matrix
mov1 = Left(strCryptMatrix(W), 1) ' First Character of strCryptMatrix
mov2 = Right(strCryptMatrix(W), (LAM - 1)) ' All but First Character of strCryptMatrix
strCryptMatrix(x) = mov2 + mov1 ' Makes up each row of the Array
W = W + 1
Next
End Sub