How do I indicate copying progress 1

[tedsmith]

In copying a file across a network I used
FSO.CopyFile MyFilename, "\\" & DestinationIP & "\c\DestinationFolder\"
This works well, whether the file was already there or not.

But some files are very large and take over a minute to copy on a slow 100mhz network and the computer freezes until copying is finished.

How do I provide a moving in-progress indicator?

I tried showing a small AVI but it freezes while the copying is in progress

I tried a 1 second timer flashing a label but it also freezes the timer.

I wonder how does Microsoft get their Copyfile AVI to work?

 

[PatrickIRL]

Ted, take a look at thread222-907420, might be of some use.

Patrick

 

[tedsmith]

I looks to me that the example suggested indicates progress only when each file of a folder is copied giving a sort of progress indicator but in my case I want to show progress during one file only.

 

[vb5prgrmr]

With 9x there used to be a way to spawn the file copy progress dialog (i.e. when you copied a large amount of data from one place to another with windows explorer) but I doubt that is what you are talking about. I think this is probably what you are talking about...

http://vbnet.mvps.org/index.html?code/callback/filebackupcallback.htm

Good Luck

 

[tedsmith]

After wading through many and various examples by others, I condensed the code to the minimum required to copy and still allow other actions such as cancelling the copy mid way thru.
It shows a progressbar that moves during a single file transfer.

On a form that has a Button to start copy, a Button to cancel the copy, a VB progressbar to show copy progress and a Label to indicate success.

Sub cmdStartCopy_Click()
CancelBackup = False
if CopyTheFile (Me, SourcePathAndFilename,  TargetPathAndFilename)= 1 then 
	lblAdvice.Caption="Copy Successful"
Else
	lblAdvice.Caption="Copy failed"
End If

'Source and Target must include file title 
'Eg (Me, "C:\LocalVideoFolder\MyNewVideo.avi", "\\10.290.255.123\C\RemoteVideoFolder\MyNewVideo.avi")

End Sub

Sub cmdCancelCopy()
CancelBackup=True
End Sub
--------------------------------------------
In a Module

Option Explicit
Public CancelBackup As Long
Private MyFileTitle As String
'Define possible return codes from the CopyFileEx callback routine
Private Const PROGRESS_CONTINUE As Long = 0
Private Const PROGRESS_CANCEL As Long = 1

'CopyFileEx callback routine state change values
Private Const CALLBACK_CHUNK_FINISHED As Long = &H0
Private MyFormName As Form
Private Const CALLBACK_STREAM_SWITCH As Long = &H1
Private Const COPY_FILE_RESTARTABLE As Long = &H2
Private Declare Function CopyFileEx Lib "kernel32" _
     Alias "CopyFileExA" _
    (ByVal lpExistingFileName As String, _
     ByVal lpNewFileName As String, _
     ByVal lpProgressRoutine As Long, _
     lpData As Any, _
     pbCancel As Long, _
     ByVal dwCopyFlags As Long) As Long

Public Function CopyTheFile(InFormName As Form, sSourceFile As String, sTargetFile As String) As Boolean
Set MyFormName = InFormName
Dim lpCallback As Long
lpCallback = FARPROC(AddressOf CopyProgressCallback)
 
CopyTheFile = CopyFileEx(sSourceFile, _
    sTargetFile, _
    lpCallback, _
    0&, _
    CancelBackup, _
    COPY_FILE_RESTARTABLE) = 1
    
'if CopyFileEx succeeds, the return value is 1. A failure returns 0.
End Function

Private Function FARPROC(ByVal pfn As Long) As Long
'passes the addressof the callback procedure to the
'CopyFileEx lpCallback member. Because AddressOf
'can not be assigned directly, use a roundabout
'means by passing the address to a function
'that returns the same.
FARPROC = pfn
End Function

Private Function CopyProgressCallback(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, _
    lpData As Long) As Long

'Show copy progress on a ProgressBar on the main form
Select Case dwCallbackReason
Case CALLBACK_STREAM_SWITCH:
    'happens when callback is initialized for each file.
     MyFormName.ProgressBar1.Value = 0
     MyFormName.ProgressBar1.Min = 0
     MyFormName.ProgressBar1.Max = (TotalFileSize * 10000)
     MyFormName.ProgressBar1.Refresh
     CopyProgressCallback = PROGRESS_CONTINUE
         
Case CALLBACK_CHUNK_FINISHED
    'happens when a block has been copied
     MyFormName.ProgressBar1.Value = (TotalBytesTransferred * 10000)
     DoEvents
     If CancelBackup = False Then
        	CopyProgressCallback = PROGRESS_CONTINUE
     Else
        	CopyProgressCallback = PROGRESS_CANCEL 'stop coying
     End If
         
End Select
End Function

Hoping this may be useful to others to see how it all fits together.

 

[dpaulson]

I had to change the 1 in this line

if CopyTheFile (Me, SourcePathAndFilename, TargetPathAndFilename)= 1 then

to a 'true' since a boolean is returned. False has a value of 0 while true is anything other than a 0.

Your code works graet otherwise.

David Paulson

 

[tedsmith]

Thats odd
In my computer it definitely returned a 1 and not -1.
I originally had it true and I had to change it to make it work.
I'm using WindowsXp.
It might have been better to say
if CopyTheFile (Me, SourcePathAndFilename, TargetPathAndFilename)= 0 then
lblAdvice.Caption="Copy failed"
Else
lblAdvice.Caption="Copy Successful"
End If

Then it doesnt matter

 

[strongm]

>In my computer it definitely returned a 1

The underlying function (CopyFileEx) returns a 1 (or 0), but your wrapping function converts it to a boolean here:

CopyTheFile = CopyFileEx(sSourceFile, _
sTargetFile, _
lpCallback, _
0&, _
CancelBackup, _
COPY_FILE_RESTARTABLE) = 1

Given the above CopyTheFile can never have returned 1. Of course if CopyTheFile was defines 'As Long' and the function return value had been:

CopyTheFile = CopyFileEx(sSourceFile, _
sTargetFile, _
lpCallback, _
0&, _
CancelBackup, _
COPY_FILE_RESTARTABLE)

then you'd have got 1. Perhaps one of your rewrites of what looks to be the VBNet code confused things.

 

[tedsmith]

You're right
I originally didn't have an AS anything but in my zeal to have the code look 'proper' for publication, I added the declaration before I posted the example without testing it.

It show the danger of changing ANYTHING in code without fully testing it!

I have often wondered why you can have a function without a declaration even though you have Option Explicit at the top?

 

[strongm]

In the same way that you can do

Dim a

without using As when using Option Explicit. You are implicitly declaring it as a variant.