Solved

How To Encrypt Files That My VB App Can Decrypt

Posted on 2000-04-25
6
266 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 

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

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

710 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