a6106a
asked on
How To Encrypt Files That My VB App Can Decrypt
I'd like some thoughts on the following:
How do I write a program that will encrypt files that only MY VB APP is able to Run, or See correctly?
I'd like the ability to alter my App so that even different versions of my App will be able to Run or See only the files that THAT version created or is responsible for Decrypting.
Hope this is clear.
???? thoughts ????
\
How do I write a program that will encrypt files that only MY VB APP is able to Run, or See correctly?
I'd like the ability to alter my App so that even different versions of my App will be able to Run or See only the files that THAT version created or is responsible for Decrypting.
Hope this is clear.
???? thoughts ????
\
The user name in the getCryptKey will probally be changed to something more consistant. I use it to crypt my passwords in a database based of the users name. That way it is harder to break to encryption.
A more secure version would use a longer key. One that might work for you is to use the App.Major, App.Minor, and App.Revision properties to build your key:
Private AppKey as Variant
Function GetKey() as Variant
Dim TK(0 to 15) as Byte
Dim I as Integer
' Generate a 16 byte key
TK(0) = Rnd(App.Major^2 * App.Minor ^5 * App.Revision * -1) * 255 ' set seed for sequence
For I = 1 To 15
TK(I) = Rnd
Next I
GetKey = Array(TK(0),TK(1),TK(2),TK (3),TK(4), TK(5),TK(6 ),TK(7),TK (8),TK(9), TK(10),TK( 11),TK(12) ,TK(13),TK (14),TK(15 ))
End Function
Function CryptString (Src as String) as String
' Passing a plaintext string encrypts it
' Passing an encrypted string decrypts it
Dim vKey as Variant
Dim sTmp as String
Dim I as Integer
sTmp = ""
If Len(Src) > 0 Then
vKey = GetKey()
For I = 1 to Len(Src)
sTmp = sTmp & Chr(Asc(Mid(Src,I,1)) XOR vKey(I Mod 16))
Next I
End If
CryptString = sTmp
End Function
NOTE: XOR encryption, though fast and easy, is not especially secure (to be precise, it's considered a joke in cryptography circles). You might consider using another encryption method. Look around for an OCX or other control that implements more secure encryption.
Private AppKey as Variant
Function GetKey() as Variant
Dim TK(0 to 15) as Byte
Dim I as Integer
' Generate a 16 byte key
TK(0) = Rnd(App.Major^2 * App.Minor ^5 * App.Revision * -1) * 255 ' set seed for sequence
For I = 1 To 15
TK(I) = Rnd
Next I
GetKey = Array(TK(0),TK(1),TK(2),TK
End Function
Function CryptString (Src as String) as String
' Passing a plaintext string encrypts it
' Passing an encrypted string decrypts it
Dim vKey as Variant
Dim sTmp as String
Dim I as Integer
sTmp = ""
If Len(Src) > 0 Then
vKey = GetKey()
For I = 1 to Len(Src)
sTmp = sTmp & Chr(Asc(Mid(Src,I,1)) XOR vKey(I Mod 16))
Next I
End If
CryptString = sTmp
End Function
NOTE: XOR encryption, though fast and easy, is not especially secure (to be precise, it's considered a joke in cryptography circles). You might consider using another encryption method. Look around for an OCX or other control that implements more secure encryption.
ASKER
Good suggestions I suppose, but the missing consideration is that I want to be able to encrypt already existing files (txt, exe, mp3 etc.) that are in a directory and have only my Program be able to run, see, play them.
??
??
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Thanks for the points! Glad I could help!
Cheers!®©
Cheers!®©
Public Function encrypt(ByVal pwd As String, CryptKey As Integer) As String
Dim ctr As Integer
Dim newpwd As String
Dim cryptcode As Integer
ctr = 1
Do Until ctr = Len(pwd) + 1
cryptcode = Asc(Mid(pwd, ctr, 1))
If ctr Mod 2 = 0 Then
cryptcode = cryptcode - CryptKey
Else
cryptcode = cryptcode + CryptKey
End If
cryptcode = (cryptcode Xor CryptKey) - 9
newpwd = newpwd & Chr$(cryptcode)
ctr = ctr + 1
Loop
encrypt = newpwd
End Function
Public Function decrypt(pwd As String, CryptKey As Integer) As String
Dim ctr As Integer
Dim newpwd As String
Dim cryptcode As Integer
ctr = 1
Do Until ctr = Len(pwd) + 1
cryptcode = Asc(Mid(pwd, ctr, 1)) + 9 Xor CryptKey
If ctr Mod 2 = 0 Then
cryptcode = cryptcode + CryptKey
Else
cryptcode = cryptcode - CryptKey
End If
newpwd = newpwd & Chr$(cryptcode)
ctr = ctr + 1
Loop
decrypt = newpwd
End Function
Public Function GetCryptKey(UserName As String) As Integer
Dim WorkingKey As Long
Dim ctr As Integer
Dim KeyString As String
For ctr = 1 To Len(UserName)
WorkingKey = WorkingKey + Asc(Mid$(UserName, ctr, 1))
Next ctr
Do Until (WorkingKey >= 1) And (WorkingKey <= 9)
KeyString = CStr(WorkingKey)
WorkingKey = 0
For ctr = 1 To Len(KeyString)
WorkingKey = WorkingKey + CInt(Mid$(KeyString, ctr, 1))
Next ctr
Loop
GetCryptKey = CInt(WorkingKey)
End Function