?
Solved

Reading files into an array with Binary file access

Posted on 2003-02-25
9
Medium Priority
?
207 Views
Last Modified: 2010-04-07
I have created a simple program to achieve something for a friend but it involves reading a file and then recreating it with adjustments to encrypt it. The problem is...it takes FAR too long. A good couple of minutes for a 4 megabyte file.

The code I currently have is as follows:


Dim ArrayNum As Long
Dim EncryptNum As Long
Dim FileLen As Long
Dim FileArray() As Byte

Open File For Binary As #Free

FileLen = LOF(Free)
ReDim FileArray(FileLen)

Do
    DoEvents
    Get #Free, , FileArray(ArrayNum)
    ArrayNum = ArrayNum + 1
Loop Until EOF(Free)

Close Free

Open File & "enc" For Output As #Free
Close Free

Open File & "enc" For Binary As #Free

Do
    DoEvents
    Put #Free, EncryptNum + 1, FileArray(EncryptNum) + 1
    EncryptNum = EncryptNum + 1
Loop Until EncryptNum = FileLen

Close Free



I would like it if someone could give me some advice or touch up my code or even replace it if necessary. Also, I do not know how to use API calls yet so I would like it if the suggestions and possible solutions left them out.

Also larger files tend to give an out of memory error. Any suggestions in overcoming this hurdle?

Sinister Shadow
0
Comment
Question by:sinistershadow
[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
  • 4
  • 4
9 Comments
 

Author Comment

by:sinistershadow
ID: 8021785
Sorry, I forgot to mention one other problem. When because Binary access works with integers it automatically adds an additional null byte on to the end of the encrypted file. Is there anyway to overcome this?

Sinister Shadow
0
 
LVL 1

Accepted Solution

by:
Smashmad earned 320 total points
ID: 8022966
Hi.. i made a rutine symilar.. it could work better.. try it..

The functions Cript() and Decript() returns True if everything was ok, and False if there was an error
-----------------------

Const chunk As Integer = 1024

Public Function cript(ByVal archivo As String, ByVal destino As String) As Boolean
Dim n As Integer
Dim data() As Byte

If Dir(archivo) = "" Then cript = False: Exit Function

Open archivo For Binary As 1
Open destino For Binary As 2

ReDim data(1 To chunk) As Byte

10
If Loc(1) = LOF(1) Or EOF(1) Then GoTo 100

    If LOF(1) - Loc(1) < chunk Then
        ReDim data(1 To LOF(1) - Loc(1)) As Byte
    End If

Get #1, , data()

    For n = 1 To UBound(data)
        data(n) = (data(n) + 1) And 255
    Next n

Put #2, , data()
DoEvents

GoTo 10

100
Close 1
Close 2
cript = True
End Function


Public Function Decript(ByVal archivo As String, ByVal destino As String) As Boolean
Dim n As Integer
Dim data() As Byte

If Dir(archivo) = "" Then Decript = False: Exit Function

Open archivo For Binary As 1
Open destino For Binary As 2

ReDim data(1 To chunk) As Byte

10
If Loc(1) = LOF(1) Or EOF(1) Then GoTo 100

    If LOF(1) - Loc(1) < chunk Then
        ReDim data(1 To LOF(1) - Loc(1)) As Byte
    End If

Get #1, , data()

    For n = 1 To UBound(data)
        data(n) = (data(n) - 1) And 255
    Next n

Put #2, , data()
DoEvents

GoTo 10

100
Close 1
Close 2
Decript = True
End Function
0
 
LVL 17

Expert Comment

by:inthedark
ID: 8023120
The following example (see command1_click) takes just 12 seconds to read, encrypt and write a 4MB file.  The form_load shows a little example.

Create a new project.  Add a command button (command1) to the form. paste the following code:


Option Explicit
' Sample simple encrypt/decrypt
'Here is an example of simple encrypt/decrypt.
'Paste this code into a form.  The form_load event shoes how the functions
' work and also does a QA test on the encryption.


Private Sub Command1_Click()
'It should take just a few seconds....try this:

Dim sInputFileName As String
Dim sOutputFileName As String

Dim sMyPassword  As String
Dim sFileData  As String
Dim sEncFileData  As String
Dim sngStartTime As Single

sInputFileName = "C:\MyTest.TXT"
sOutputFileName = "C:\MyTestOut.TXT"


' create some test data
' only do this if none exists already
If Len(Dir(sInputFileName)) = 0 Then
    Me.Print "creating test data ";
    Dim lC As Long
    Const TestFileSize = 4000000 ' abount 4MB
    Dim lChar As Long
    lChar = 0
    sFileData = Space(TestFileSize)
    For lC = 1 To TestFileSize
        Mid(sFileData, lC, 1) = Chr(lChar)
        lChar = lChar + 1
        If lChar > 255 Then lChar = 0
    Next
    Dim ok
    ok = FileWriteOK(sInputFileName, sFileData)
    sFileData = ""
    Me.Print "done"
    DoEvents
   
End If

Me.AutoRedraw = True
Me.Print "starting file encrypt ";
DoEvents
sngStartTime = Timer

' Now read the file
sFileData = FileRead(sInputFileName)
If Len(sFileData) <> TestFileSize Then
    MsgBox "There is a problem"
End If

' Password
sMyPassword = "AnyThing" ' case sensitive

sEncFileData = Encrypt(sFileData, sMyPassword)

' save the data
ok = FileWriteOK(sOutputFileName, sEncFileData)
Me.Print "done"

MsgBox "It took " + Format(Timer - sngStartTime, "0.000") + " seconds"



' no test decrytion
Me.Print "testing decrypt ";
DoEvents
sEncFileData = Decrypt(sEncFileData, sMyPassword)
DoEvents
Me.Print "done"
If sEncFileData <> sFileData Then
    MsgBox "Encrypt/decrypt does not work"
Else
    MsgBox "This Encrypt/decrypt is excellent simple and it works"
End If

End Sub


'You can make the encryption stronger by:

'Running the encryption several times with different
'passwords and also reordering the data between encryptions.


Private Sub Form_Load()

Dim m$
Dim l$
Dim password As String

m$ = "Mary had a little lamb"

password = "NICK WAS HERE"
Dim e$

e$ = Encrypt(m$, password) ' to encrypt
l$ = Decrypt(e$, password) ' to decrypt

If l$ <> m$ Then
    MsgBox "Stupid idea idea does not work"
Else
    MsgBox "Good idea idea it works: " + vbCrLf + m$ + vbCrLf + "Came back to: " + l$, vbExclamation, "First Test"
End If

' now the real test

Dim c As Long
m$ = ""
For c = 0 To 255
    m$ = m$ + Chr$(c)
Next c
l$ = Decrypt(Encrypt(m$, password), password)
If l$ <> m$ Then
    MsgBox "Stupid idea it does not work", vbExclamation, "Second Test"
Else
    MsgBox "Good idea it works very well"
    Me.AutoRedraw = True
    Me.Print "Good idea it works very well"
End If

End Sub



Public Function Encrypt(SourceData As String, password As String) As String

Dim S$
S$ = Space$(Len(SourceData))
If Len(S$) = 0 Then Exit Function

Dim PC As Long
Dim lC As Long

For lC = 1 To Len(S$)
    PC = PC + 1
    If PC > Len(password) Then
        PC = 1
    End If
    Mid$(S$, lC, 1) = Chr(Asc(Mid(SourceData, lC, 1)) Xor Asc(Mid$(password, PC, 1)))
Next

Encrypt = S$

End Function

Public Function Decrypt(EncryptedData As String, password As String) As String

Decrypt = Encrypt(EncryptedData, password)


End Function


Function FileRead(sFileName As String) As String

' fast read a file in one hit

Dim lfn As Long
Dim sFileData  As String

' Open binary
lfn = FreeFile
Open sFileName For Binary Access Read Shared As #lfn

' read whole file in one hit
sFileData = String(LOF(lfn), 0) ' create a dummy buffer
Get #lfn, 1, sFileData
Close #lfn
FileRead = sFileData

End Function

Function FileWriteOK(sFileName As String, sData As String) As Boolean

On Error GoTo ErrorTrap

' fast write a file in one hit

Dim lfn As Long


' Open binary
lfn = FreeFile
If Len(Dir(sFileName)) > 0 Then
    Kill sFileName
End If
Open sFileName For Binary Access Read Write Shared As #lfn
Put lfn, 1, sData
Close #lfn
FileWriteOK = True
Exit Function

ErrorTrap:
FileWriteOK = False

End Function
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!

 
LVL 1

Expert Comment

by:Smashmad
ID: 8023154
Here is my code, with pass



'------------------------
Public Function cript(ByVal pass As String, ByVal Ffile As String, ByVal destiny As String) As Boolean
Dim n As Integer
Dim data() As Byte
Dim passByte() As Byte
Dim passN As Integer

If Dir(Ffile) = "" Then cript = False: Exit Function

Open Ffile For Binary As 1
Open destiny For Binary As 2

ReDim data(1 To chunk) As Byte
ReDim passByte(1 To Len(pass)) As Byte
For n = 1 To Len(pass)
passByte(n) = Asc(Mid(pass, n, 1))
Next

10
If Loc(1) = LOF(1) Or EOF(1) Then GoTo 100

    If LOF(1) - Loc(1) < chunk Then
        ReDim data(1 To LOF(1) - Loc(1)) As Byte
    End If

Get #1, , data()

    For n = 1 To UBound(data)
        If passN < Len(pass) Then passN = passN + 1 Else passN = 1
        data(n) = (data(n) + CInt(passByte(passN))) And 255
    Next n

Put #2, , data()
DoEvents
'If yo want a percentDone, use this formula CInt((Loc(1) / LOF(1)) * 100)
GoTo 10

100
Close 1
Close 2
cript = True
End Function



Public Function decript(ByVal pass As String, ByVal Ffile As String, ByVal destiny As String) As Boolean
Dim n As Integer
Dim data() As Byte
Dim passByte() As Byte
Dim passN As Integer

If Dir(Ffile) = "" Then decript = False: Exit Function

Open Ffile For Binary As 1
Open destiny For Binary As 2

ReDim data(1 To chunk) As Byte
ReDim passByte(1 To Len(pass)) As Byte
For n = 1 To Len(pass)
passByte(n) = Asc(Mid(pass, n, 1))
Next

10
If Loc(1) = LOF(1) Or EOF(1) Then GoTo 100

    If LOF(1) - Loc(1) < chunk Then
        ReDim data(1 To LOF(1) - Loc(1)) As Byte
    End If

Get #1, , data()

    For n = 1 To UBound(data)
        If passN < Len(pass) Then passN = passN + 1 Else passN = 1
        data(n) = (data(n) - CInt(passByte(passN))) And 255
    Next n

Put #2, , data()
DoEvents
'If yo want a percentDone, use this formula CInt((Loc(1) / LOF(1)) * 100)

GoTo 10

100
Close 1
Close 2
decript = True
End Function

0
 
LVL 1

Expert Comment

by:Smashmad
ID: 8023172
Sorry, I forget that, you must put it in the same Module/form you put the functions.

Private Const chunk As Integer = 1024


The aplication read, cript, and write a 4MB file en lees than 10 seconds. (my pocesor is 600 Mhz).
0
 

Author Comment

by:sinistershadow
ID: 8026862
Ok. Thanks for the info. I'm going to go and test them out and see which one is best for my purpose. Just a question, will these work with non-text files as well?

I'll get back to you in about an hour or 2.
Sinister Shadow
0
 

Author Comment

by:sinistershadow
ID: 8028019
THANK YOU THANK YOU THANK YOU THANK YOU THANK YOU!!!!!!

Ummm, like I said, thanks Smashmad! It's perfect! No null byte at the end of the file and overcomes the 'out of memory' problem with really big files! Thank you so much! The code with a password in it didn't work properly for me (it messes up my original file for some reason :-S) but I'm sure I'll be able to come up with a version.

Thanks for your help inthedark but it wasn't quite what I was looking for. It couldn't handle larger files even though it was a LOT faster with smaller files. (Roughly 40secs with a 4mb file on my 400MHz system compared to 60secs).

Smashmad, I have one more question about your code. Sorry if I seem a bit dim but what does:

data(n) = (data(n) - 1) And 255

actually do? (the 'And 255' bit)

I'll reward the points after this because I'm not sure how PAQ's work yet. (Do you have to purchase your own questions after they've been answered?)

Thanks again,

Sinister Shadow
0
 

Author Comment

by:sinistershadow
ID: 8028472
I've realised what that line of code does now. One wierd thing that I've noticed though, is now that I've renamed the variables to match the ones I use, the code executes within 9 seconds for a 5mb file! Could it be because I run the code on the cmd_Encrypt_click() event instead of calling a function? Anyway. Thank you VERY much for your help!

Sinister Shadow
0
 
LVL 1

Expert Comment

by:Smashmad
ID: 8030463
sinistershadow:

Well.. i think it's a bit late, but that line of code data(n) = (data(n) - 1) And 255
is because you only want a number between 0 - 255, so if the number is out of the range, that function returns the value that correspond.

Im new on that, is my second answer, so i dont know what PAQ's, and I dont know yet how does it works..

The other code, work faster with small files, because it reads all the data in one step.. If yo modify the value of the const Chunk, you can obtain that.
If yo increase Chunk to 2048 or 4096 or more, small files will be cripted a lot faster.. but crypting big files will lost a bit of velocity (no so much..). You can try to find a balance.. but i think 1024 or 2048 is ok.

I dont think the code velocity increases by puting the code in your cmd_button event, or changing var names.. but I dont know your program, so it could work.

Good Luck!
0

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

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

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
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…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month12 days, 7 hours left to enroll

777 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