binary file copy?

[fenris]

I modified the sub below from source I found on the net to copies files using a buffer and a byte array. It seems to work but the newly copied files have an extra byte and I don't know where it is coming from?

Any ideas on how to improve this code would also be appreciated....

Thanks..




'======================
Public Sub copyBin(source As String, dest As String)
Dim readChunkSize As Long
Dim bufferSize As Long, tempSize As Long
Dim infil As Long
Dim outfil As Long
Dim r() As Byte, numBytes As Long
Dim EndOfCTime As Single
Dim FCStTime As Single
Dim buffer() As Byte
Dim i As Long, upper As Long 'used as indices
Dim CurPosOn As Long
Dim Totalto As Long
Dim temp As Long

Dim binCol As New Collection
Dim myByte As clsByteArray
Dim tempByte As clsByteArray

If myCacheSize = 0 Then
readChunkSize = 32767
Else
readChunkSize = myCacheSize
End If

bufferSize = readChunkSize * 2

If Dir$(source) = "" Then

mySucessfull = False
Exit Sub
End If

'If Dir(Destination) <> &quot;&quot; Then
' Kill Destination
'End If

FCStTime = Timer

infil = FreeFile
Open source For Binary As #infil
outfil = FreeFile
Open dest For Binary As #outfil


If readChunkSize > LOF(infil) Then

Get #infil, , r
Put #outfil, , r
GoTo CLoseFiles
End If


upper = LOF(infil) \ readChunkSize
temp = LOF(infil) Mod readChunkSize
If temp <> 0 Then
upper = upper + 1 ' as the remainder will never be greater then the denominator(?)
End If

numBytes = 0
For i = 1 To upper
ReDim r(readChunkSize)
Get #infil, , r
numBytes = numBytes + UBound(r)
'now we need to put r into buffer
Set myByte = New clsByteArray
myByte.byteArray = r

binCol.Add myByte

If numBytes >= bufferSize Then

For Each tempByte In binCol
Put #outfil, , tempByte.byteArray
Next 'tempbyte

numBytes = 0
Set binCol = New Collection
End If


CurPosOn = Loc(outfil) / 100
Totalto = LOF(infil) / 100
myPercentReady = (CurPosOn * 100) / Totalto
DoEvents

If LOF(infil) - Loc(infil) < readChunkSize Then
readChunkSize = LOF(infil) - Loc(infil)
End If


Next 'i

If binCol.Count > 0 Then
For Each tempByte In binCol
Put #outfil, , tempByte.byteArray
Next 'tempbyte
End If


CLoseFiles:

Close #infil, #outfil
mySucessfull = True
EndOfCTime = Timer

mySecondsTaken = EndOfCTime - FCStTime
Set binCol = Nothing
Set myByte = Nothing
Set tempByte = Nothing
End Sub

'======================
'clsByteArray

Option Explicit

Private myByte() As Byte 'holds the byte array



Public Property Get byteArray() As Byte()
byteArray = myByte
End Property

Public Property Let byteArray(ByRef byteA() As Byte)
myByte = byteA
End Property






Troy Williams B.Eng.
fenris@hotmail.com

 

[JohnYingling]

Doesn't FILECOPY do it for you?

http://www.VBCompare.com

Compare Code (Text)

http://www.VBSortGen.com

Generate Sort in VB or VBScript

 

[VBGuyUsingVC]

I would also recommend filecopy(). If you want to create a file copy routine then I would simply open the file in binary mode and do a string copy.

It takes 4 bytes to represent 3 bytes in byte arrays I believe which would explain your extra byte. In fact if you try several examples of the code you may end up with 2 or 3 extra bytes if I'm not mistaken.

 

[fenris]

Filecopy doesn't provide a mechanism to track the progress of the file being copied.

Also the comparable copy routine using strings instead of a byte array is far, far quicker then the built in routine...

Normally I would use the filecopy routine, but this program has to be able to copy 3GB worth of files on a regular basis and speed is of the essence.

Thanks for the replies though.. Troy Williams B.Eng.
fenris@hotmail.com

 

[Alt255]

If you are using NT or 2000 you might try CopyFileEx.
[tt]
Private Sub Form_Load()
Dim Ret As Long
Me.AutoRedraw = True
Me.Print &quot;Click to abort file copy&quot;
Me.Show
Ret = CopyFileEx(&quot;c:\MyBigFile.qaz&quot;, _
&quot;c:\MyCopiedFile.qaz&quot;, _
AddressOf CopyProgressRoutine, _
ByVal 0&, _
bCancel, _
COPY_FILE_RESTARTABLE)
Me.Print &quot;Filecopy completed &quot; _
+ IIf(Ret = 0, &quot;(ERROR/ABORTED)&quot;, _
&quot;successfully&quot
End Sub

Private Sub Form_Click()
bCancel = 1
End Sub
[/tt]
'In-a-module=====================================================
[tt]
Public Const PROGRESS_CANCEL = 1
Public Const PROGRESS_CONTINUE = 0
Public Const PROGRESS_QUIET = 3
Public Const PROGRESS_STOP = 2
Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
Public Const COPY_FILE_RESTARTABLE = &H2
Public Declare Function CopyFileEx _
Lib &quot;kernel32.dll&quot; _
Alias &quot;CopyFileExA&quot; _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal lpProgressRoutine As Long, _
lpData As Any, _
ByRef pbCancel As Long, _
ByVal dwCopyFlags As Long) As Long
Public bCancel As Long
Public Function CopyProgressRoutine _
(ByVal TotalFileSize As Currency, _
ByVal TotalBytesTransferred As Currency, _
ByVal StreamSize As Currency, _
ByVal StreamBytesTransferred As Currency, _
ByVal dwStreamNumber As Long, _
ByVal dwCallbackReason As Long, _
ByVal hSourceFile As Long, _
ByVal hDestinationFile As Long, _
ByVal lpData As Long) As Long
Form1.Caption = CStr(Int((TotalBytesTransferred * 10000) _
/ (TotalFileSize * 10000) * 100)) + &quot;% complete...&quot;
DoEvents
CopyProgressRoutine = PROGRESS_CONTINUE
End Function

 

[MichaelRed]

At the risk of quoting the sage,

Public Function basFilCopy(FNameIn As String, FNameOut As String)

    'Michael Red 1/30/2002
    Fil = FreeFile                              'get the next free file number

    'This works for large files. I (Troy Williams)tried it
    'with a 50 meg file on a computer with 128 Mb of ram and it worked fine.
    'open the file and dump the contents into the rawfile variable

    Open FName For Binary As #Fil               'Open file
    RawFile = String$(LOF(Fil), 32)             'Create "empty" String of Length
    Get #Fil, 1, RawFile                        'Fill "Empty Str with File
    Close #Fil                                  'Close File

    Fil = FreeFile
    Open FNameOut For Binary As #Fil
    Put #Fil, 1, RawFile
    Close #Fil

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[fenris]

Thanks Michael for the rehash

I was using the code that I had posted here, but I am curious as to whether that code is as fast as a filecopy can get? That is why I am trying to do this using byte arrays. Also by buffering the file to copy, it would have the ability to display copy progress (if one desired).

I have managed increasing the speed somewhat of that code by converting RawFile to a byte array:

dim RawFile() as byte

Open FName For Binary As #Fil
Get #Fil, , RawFile
Close #Fil

Fil = FreeFile
Open FNameOut For Binary As #Fil
Put #Fil, , RawFile
Close #Fil

Thanks all for the responses.... Troy Williams B.Eng.
fenris@hotmail.com

 

[Alt255]

No mistake. Thank you.