Solved

How To Encrypt Files That My VB App Can Decrypt

Posted on 2000-04-25
6
258 Views
Last Modified: 2010-05-02
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 ????
\
0
Comment
Question by:a6106a
6 Comments
 
LVL 2

Expert Comment

by:Sage020999
ID: 2749527
Try adding the following 3 functions to your program.  It will encrypt a string of characters that you can write to a file.  The pwd is what you will lock and unlock your code with.  I often you my app name, but you may want to use something a bit harder to decode.  Hope this helps.





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



0
 
LVL 2

Expert Comment

by:Sage020999
ID: 2749533
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.
0
 
LVL 32

Expert Comment

by:bhess1
ID: 2749652
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.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:a6106a
ID: 2749689
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.
??
0
 
LVL 14

Accepted Solution

by:
mcrider earned 50 total points
ID: 2750283
Here is code that will encrypt and decrypt strings.... All you have to do is read the unencrypted file into a string and pass the string to the Crypt function.  It will pass back an encrypted string that you can then save to a new file...

To decrypt a file, just do the same process again... Only this time, read the encrypted file into a string and pass it...


Cheers!®©


THE CODE:


Add This code to a module:

'-------------------------------------------------------------------------------
Public Function Crypt(Source As String, CryptKey As String) As String
    Dim lSource As String
    Dim iVal As Long
    Dim jVal As Long
    Dim lSwitch As Boolean
     
    lSwitch = True
    lSource = Source
    jVal = 0
    For iVal = 1 To Len(lSource)
        jVal = jVal + 1
        If jVal = Len(CryptKey) Then jVal = 1
        lSwitch = SwapBoolean(lSwitch)
        If lSwitch = True Then
            Mid$(lSource, iVal, 1) = Chr$(Asc(Mid$(lSource, iVal, 1)) Xor Asc(Mid$(CryptKey, jVal, 1)) + 1)
        Else
            Mid$(lSource, iVal, 1) = Chr$(Asc(Mid$(lSource, iVal, 1)) Xor Asc(Mid$(CryptKey, jVal, 1)) - 1)
        End If
    Next iVal
    Crypt = lSource
End Function
Public Function SwapBoolean(Source As Boolean) As Boolean
    If Source = True Then
        SwapBoolean = False
    Else
        SwapBoolean = True
    End If
End Function
'-------------------------------------------------------------------------------



Then you can do:


dim cString1 as string
dim cString2 as string
Cstring1=Crypt("String to encrypt","Password")


and Cstring1 will contain an encrypted string.

To unencrypt, do:

Cstring2=Crypt(Cstring1,"Password")

and Cstring2 will now have the unencrypted string.


By the way, in the above example, you can replace the password "Password" with anything you want.  This is your encryption mask, and it can be as long as you want... Just use the same string to encrypt that you use to decrypt, otherwise, the decrypt will fail and you get garbage (which is exactly what you want to have happen ;-)


Cheers!®©

0
 
LVL 14

Expert Comment

by:mcrider
ID: 2757314
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

26 Experts available now in Live!

Get 1:1 Help Now