Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

How To Encrypt Files That My VB App Can Decrypt

Posted on 2000-04-25
6
Medium Priority
?
270 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:Brendt Hess
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 150 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

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

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…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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 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…
Suggested Courses

972 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