Solved

How To Encrypt Files That My VB App Can Decrypt

Posted on 2000-04-25
6
257 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:a6106a
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

744 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

16 Experts available now in Live!

Get 1:1 Help Now