Solved

VB6: speeding up encryption/decryption

Posted on 2004-09-14
6
561 Views
Last Modified: 2008-02-01
I have a VB6 application which uses several encrpyted text files to store data.  Most of these files are very small: short record lengths and few records. However, the encryption routine that I am using is quite slow when reading/writing files with longer record lengths - one file has a record length of about 7000 bytes and decryption is very slow on that one even though there's only about a dozen records in the file for now.  The overall file size is approx. 100K right now, but is anticipated to be even larger in the future.

I use Line Input to read these files into a UDT on a record-by-record basis, decrypting as I go, as opposed to decrypting the entire file all at once when the application opens.  The reason for taking that approach is that decrypting to a "temporary" file is unacceptable (we can't have any UNencrypted data on disk at any time, even temporarily), and reading the entire decrypted file into an array would (I presume) consume way too much memory, which could then cause other problems.

My question is: is my assumption correct regarding loading the contents of an entire file in memory?  

As you can probably tell, I am very new to working with files in this manner - what is the "standard" approach for working with encrypted data files in a VB6 app?
0
Comment
Question by:smiley_strat
[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
  • 2
  • 2
  • 2
6 Comments
 
LVL 4

Expert Comment

by:Prestaul
ID: 12056407
Do you mind sharing with us what algorithm you are using for encryption?  Is it native VB or are you using API calls?  If you are having trouble with speed you might try a different algorithm.  

I haven't used a file for storing encrypted data but we store encrypted data in a database and so each record (in fact each field) is encrypted individually.  I don't see why it would be any less acceptable to encrypt records individually if they were stored in a file and you would certainly see a performance improvement.
0
 

Author Comment

by:smiley_strat
ID: 12058423
Below is the encryption/decryption code I am using.  I found it a couple of months ago in a link from another VB thread on experts-exchange.  I altered it slightly to add 32 to the ASCII value when encrypting (and subtract 32 when decrypting) in order to force the encoded message into printable ASCII values.

Here is a snippet of code which I use to read a file.  Writing is done in a similar fashion.
 
Private Type myType
  Field1 as String * 7
  Field2 as String * 25
  Field3 as String * 13
End Type

Dim myRec as myType
Dim linebuffer as String
Dim FileName as String
Dim fileno as Integer

FileName = App.Path & "myFile.txt"
fileno = FreeFile

Open FileName For Input As #fileno
Do While Not EOF(fileno)
  Line Input #fileno, linebuffer

  ' Line Input reads one line at a time (which is why I needed to alter the encryption
  ' to use only printable characters; Line Input stops reading a line when it encounters
  ' a CR.  A line from the file is read, decrypted, and processed.

  ' the following is the call to the Decryption routine:

  linebuffer = Decryp(linebuffer)

  CopyMemory myRec, ByVal linebuffer, Len(myRec)

  ' at this point I may check the value of myRec.Field1
  ' and store the record into array if it passes the test
  ' for further processing down the line.

Loop

Close #fileno

------------------------------------------------------------------------------------

' This is the encryption and decryption module:

Public MessageLen As Integer
Public KeyLen As Integer
Public DecLen As Integer
Public BinaryLen As Long
Public EncMessage As String
Public SMS As String
Public KeyTXT As String
Public MyKey As String
Public MyMess As String
Public AllMess As String
Public NumOfMessages As Integer

Public MessagesArray() As String
Public DecArray() As Integer
Public BinArray() As Integer
Public KeyBin() As Integer
Public KeyDec() As Integer

Public Function Encryp(SMS As String)

  ' SMS = the text to encrypt or decrypt

  On Error Resume Next

  KeyTXT = "1234567890123456"
  Call Key2Decimal
  Call Key2Binary
  Call KeyBinary2Decimal

  AllMess = SMS
  NumOfMessages = ((Len(AllMess) - (Len(AllMess) Mod 4000)) / 4000) + 1
  MessageRemainder = Len(AllMess) Mod 4000
  EncMessage = ""
  ReDim MessagesArray(NumOfMessages + 1) As String
  For i = 1 To NumOfMessages
    BeginOfSelection = ((i - 1) * 4000) + 1
    If i = NumOfMessages Then ENDofSelection = MessageRemainder Else ENDofSelection = 4000
    MessagesArray(i - 1) = Mid(AllMess, BeginOfSelection, ENDofSelection)
  Next i

  For TakeAction = 1 To NumOfMessages
    MyMess = MessagesArray(TakeAction - 1)
    Call Message2Decimal
    Call Decimal2Binary
    Call Encrypt
    Call Binary2Decimal
    Call Decimal2MessageE
  Next TakeAction
  SMS = EncMessage

  Encryp = SMS

End Function

Private Sub Key2Decimal()
    ' Change the Key to Decimal
    KeyLen = 16
    MyKey = KeyTXT
    ReDim KeyDec(KeyLen) As Integer
    For KeyDecCounter = 1 To KeyLen
        KeyDec(KeyDecCounter - 1) = Asc(Mid(MyKey, KeyDecCounter, 1))
    Next KeyDecCounter
End Sub

Private Sub Key2Binary()
    ' Change the Key to Binary
    keybinlen = KeyLen * 8
    ReDim KeyBin(keybinlen) As Integer
    KeyBinCounter = 0
    For KeyDecCounter = 0 To KeyLen - 1
        DecimaLKeyNum = KeyDec(KeyDecCounter)
        For MyPower = 7 To 0 Step -1
            If DecimaLKeyNum - (2 ^ MyPower) < 0 Then
                KeyBin(KeyBinCounter) = 0
            Else
                KeyBin(KeyBinCounter) = 1
                DecimaLKeyNum = DecimaLKeyNum - (2 ^ MyPower)
            End If
            KeyBinCounter = KeyBinCounter + 1
        Next MyPower
    Next KeyDecCounter
' Running a Shift left to the key
    MyVar = KeyBin(0)
    For i = 1 To 127
        KeyBin(i - 1) = KeyBin(i)
    Next i
    KeyBin(127) = MyVar
End Sub

Private Sub KeyBinary2Decimal()
' Change the inverted key from binary to decimal for later comparisons with the text
    deccounter = 0
    For n = (KeyLen * 8) - 2 To 1 Step -1
        n = n + 1
        KeyInvDec = 0
        For i = 7 To 0 Step -1
            KeyInvDec = KeyInvDec + (2 ^ i) * KeyBin(n)
            n = n - 1
        Next i
        KeyDec(deccounter) = KeyInvDec
        deccounter = deccounter + 1
    Next n
End Sub

Private Sub Message2Decimal()

  MessageLen = Len(MyMess)
  DecLen = MessageLen

  Do
    If DecLen Mod 16 > 0 Then DecLen = DecLen + 1
  Loop Until DecLen Mod 16 = 0

  ReDim DecArray(DecLen) As Integer
  For deccounter = 0 To MessageLen - 1
    DecArray(deccounter) = Asc(Mid(MyMess, deccounter + 1, 1))
  Next deccounter

  If MessageLen < DecLen Then
    For Bonus = MessageLen To DecLen - 1
      DecArray(Bonus) = 0
    Next Bonus
  End If

End Sub

Private Sub Decimal2Binary()

    ' Change to Binary
    BinaryLen = DecLen * 8
    ReDim BinArray(BinaryLen) As Integer
    BinaryCounter = 0
    KeyDecCounter = 0
    For deccounter = 0 To DecLen - 1
    If KeyDecCounter = KeyLen Then KeyDecCounter = 0
        DecimalNum = 0
        DecimalNum = DecArray(deccounter)
        If DecimalNum = KeyDec(KeyDecCounter) Then DecimalNum = 0
        For MyPower = 7 To 0 Step -1
            If DecimalNum - (2 ^ MyPower) < 0 Then
                BinArray(BinaryCounter) = 0
            Else
                BinArray(BinaryCounter) = 1
                DecimalNum = DecimalNum - (2 ^ MyPower)
            End If
            BinaryCounter = BinaryCounter + 1
        Next MyPower
        KeyDecCounter = KeyDecCounter + 1
    Next deccounter
End Sub

Private Sub Encrypt()
' A function to Xor the Key with the Message Binry Code.
    For i = 1 To BinaryLen - 1
        i = i - 1
        For m = (KeyLen * 8) - 1 To 0 Step -1
            If KeyBin(m) = BinArray(i) Then
            BinArray(i) = 0
            Else
            BinArray(i) = 1
            End If
            i = i + 1
        Next m
    Next i

End Sub

Private Sub Binary2Decimal()
' Change The Binary to Decimal
    DecimalCounter = 0
    KeyCounter = 0
    For BinaryCounter = 1 To BinaryLen - 1
        If KeyCounter = KeyLen Then KeyCounter = 0
        Dec = 0
        BinaryCounter = BinaryCounter - 1
        For MyPower = 7 To 0 Step -1
            Dec = Dec + ((2 ^ MyPower) * BinArray(BinaryCounter))
            BinaryCounter = BinaryCounter + 1
        Next MyPower
        If Dec = 0 Then Dec = KeyDec(KeyCounter)
        DecArray(DecimalCounter) = Dec
        DecimalCounter = DecimalCounter + 1
        KeyCounter = KeyCounter + 1
    Next BinaryCounter
End Sub

Private Sub Decimal2MessageE()
' Change the Decimal numbers in the Array to letters.
    For deccounter = 0 To MessageLen - 1
        EncMessage = EncMessage & Chr$(DecArray(deccounter) + 32)
    Next deccounter
End Sub

Public Function Decryp(SMS As String)

  On Error Resume Next

  KeyTXT = "1234567890123456"
  Call Key2Decimal
  Call Key2Binary
  Call KeyBinary2Decimal

  AllMess = SMS
  NumOfMessages = ((Len(AllMess) - (Len(AllMess) Mod 4000)) / 4000) + 1
  MessageRemainder = Len(AllMess) Mod 4000
  EncMessage = ""
  ReDim MessagesArray(NumOfMessages + 1) As String
  For i = 1 To NumOfMessages
    BeginOfSelection = ((i - 1) * 4000) + 1
    If i = NumOfMessages Then ENDofSelection = MessageRemainder Else ENDofSelection = 4000
    MessagesArray(i - 1) = Mid(AllMess, BeginOfSelection, ENDofSelection)
  Next i

  For TakeAction = 1 To NumOfMessages
    MyMess = MessagesArray(TakeAction - 1)
    Call M2D
    Call Decimal2Binary
    Call Encrypt
    Call Binary2Decimal
    Call Decimal2Message
  Next TakeAction
  SMS = EncMessage

  Decryp = SMS

End Function

Private Sub Decimal2Message()
' Change the Decimal numbers in the Array to letters.
    For deccounter = 0 To MessageLen - 1
        EncMessage = EncMessage & Chr$(DecArray(deccounter))
    Next deccounter
End Sub

Private Sub M2D()

  MessageLen = Len(MyMess)
  DecLen = MessageLen

  Do
    If DecLen Mod 16 > 0 Then DecLen = DecLen + 1
  Loop Until DecLen Mod 16 = 0

  ReDim DecArray(DecLen) As Integer
  For deccounter = 0 To MessageLen - 1
    DecArray(deccounter) = Asc(Mid(MyMess, deccounter + 1, 1)) - 32
  Next deccounter

  If MessageLen < DecLen Then
    For Bonus = MessageLen To DecLen - 1
      DecArray(Bonus) = 0
    Next Bonus
  End If

End Sub

----------------------------------------------------
0
 
LVL 4

Expert Comment

by:Prestaul
ID: 12059663
I'm sorry that I lack the energy to look through the code completely.  My first thought is that, while it is possible to write efficient vb code, vb makes it very easy to write slow/inefficient code.  You might be better off using something that is time-tested and known to be quick (like the win32 encryption APIs).
0
SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

 
LVL 9

Accepted Solution

by:
Dang123 earned 200 total points
ID: 12063745
smiley_strat,
    Here are a few links I found that may be helpful to you. You may want to try a few of them and see what one is fastest for your needs.

Encryption using CryptoAPI
http://www.freevbcode.com/ShowCode.Asp?ID=804

RC4 Encryption in VB
http://www.freevbcode.com/ShowCode.Asp?ID=4398

Encryption and Decryption for Strings and Files
http://www.freevbcode.com/ShowCode.Asp?ID=2715

Secure Encryption
http://www.freevbcode.com/ShowCode.Asp?ID=215

CRYPTO
http://www.mentalis.org/vbexamples/vbexample.php?vbexample=CRYPTO&category=SOURCE

Encryption Module
http://www.freevbcode.com/ShowCode.Asp?ID=2919

CryptoAPI Wrapper
http://www.freevbcode.com/ShowCode.Asp?ID=967


Dang123
0
 

Author Comment

by:smiley_strat
ID: 12065650
Thank you very much for those links; that RC4 algorthm seems especially useful for my needs.
0
 
LVL 9

Expert Comment

by:Dang123
ID: 12067022
smiley_strat ,
    Glad I could help, thanks for the A.
Dang123
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

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…
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 …
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
Course of the Month8 days, 13 hours left to enroll

617 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