• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 212
  • Last Modified:

Reading files into an array with Binary file access

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
sinistershadow
Asked:
sinistershadow
  • 4
  • 4
1 Solution
 
sinistershadowAuthor Commented:
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
 
SmashmadCommented:
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
 
inthedarkCommented:
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
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
SmashmadCommented:
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
 
SmashmadCommented:
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
 
sinistershadowAuthor Commented:
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
 
sinistershadowAuthor Commented:
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
 
sinistershadowAuthor Commented:
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
 
SmashmadCommented:
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

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

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