Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 273
  • Last Modified:

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 ????
\
0
a6106a
Asked:
a6106a
1 Solution
 
Sage020999Commented:
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
 
Sage020999Commented:
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
 
Brendt HessSenior DBACommented:
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
a6106aAuthor Commented:
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
 
mcriderCommented:
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
 
mcriderCommented:
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

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!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now