Solved

VB6: speeding up encryption/decryption

Posted on 2004-09-14
6
549 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
  • 2
  • 2
  • 2
6 Comments
 
LVL 4

Expert Comment

by:Prestaul
Comment Utility
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
Comment Utility
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
Comment Utility
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
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 9

Accepted Solution

by:
Dang123 earned 200 total points
Comment Utility
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
Comment Utility
Thank you very much for those links; that RC4 algorthm seems especially useful for my needs.
0
 
LVL 9

Expert Comment

by:Dang123
Comment Utility
smiley_strat ,
    Glad I could help, thanks for the A.
Dang123
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Mysql vs Oracle 10 119
LINQ return type for nested group query 6 59
Use closed file on desktop in vba 6 56
Help in WHSCRIPT 9 41
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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…

771 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

10 Experts available now in Live!

Get 1:1 Help Now