Looking for way to display filecopy status.

[Dan]

I am currently trying to display the status of a file copy procedure in a
VB6 app. How can I do this once I execute the file copy code? Currently I
am using the filesystemobject to carry out the copying.

Thanks in advance!

Dan

[Alex]

"Dan" <ddeaguia@bellsouth.net> wrote:
>
>I am currently trying to display the status of a file copy procedure in
a
>VB6 app. How can I do this once I execute the file copy code? Currently
I
>am using the filesystemobject to carry out the copying.
>
>Thanks in advance!
>
>Dan


Dan,

You can use SHFileOperation API function to display progress to user (see
example below) or read from source and write to destination with your own
routine similar to 'CopyTheFile'


Function CopyTheFile(sSrc As String, sDst As String)
'This routine should also assign Date/Time stamp and all the file attributes
of the Source to destination file

Dim hSrc%, hDst%, arrData() As Byte
Dim nSize, nAttempts As Integer
On Error GoTo ErrorHandler
nSize = 32767
CopyTheFile = 0
ReDim arrData(1 To nSize)

hSrc = FreeFile(1)
Open sSrc For Binary Access Read Shared As hSrc

If Dir(sDst) <> "" Then Kill sDst
hDst = FreeFile()
Open sDst For Binary As hDst
x = LOF(hSrc) \ nSize
If x > 3 Then
With ProgressBar1
.Max = x
.Visible = True
.Value = 0
End With
End If
m = 0
Do While Not EOF(hSrc)
m = m + 1
jj = LOF(hSrc) - Seek(hSrc) + 1
If jj <= 0 Then Exit Do
If jj < nSize Then ReDim arrData(1 To jj)
nAttempts = 0
Get #hSrc, , arrData
Put #hDst, , arrData
If m <= x Then ProgressBar1.Value = m
DoEvents
Loop
ProgressBar1.Visible = False

CopyTheFile = LOF(hDst)

ExitLine:
On Error Resume Next
Close hSrc, hDst
Exit Function
ErrorHandler:

nAttempts = nAttempts + 1
If nAttempts < 10 Then
SleepEx 50&, 0&
Resume
Else
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume ExitLine
End If
End Function




'***********************************************
'Shell File Operations Routines & Constants
'***********************************************
Private Const FOF_ALLOWUNDO = &H40 'Put deleted files (except those
from floppy disks) in Recycle Bin
Private Const FOF_CONFIRMMOUSE = &H2 'Not currently implemented
Private Const FOF_FILESONLY = &H80 'Interpret a wildcard Source
to mean files only, not directories
Private Const FOF_MULTIDESTFILES = &H1 'Copy or move a wildcard Source
to multiple target files rather than to a single destination directory
Private Const FOF_NOCONFIRMATION = &H10 'Overwrite or delete files without
confirmation
Private Const FOF_NOCONFIRMMKDIR = &H200 'Create any needed destination
directories without confirmation
Private Const FOF_NOCOPYSECURITYATTRIBS = &H800 'dont copy NT file Security
Attributes
Private Const FOF_NOERRORUI = &H400 'No user interface will be displayed
if an error occurs.
Private Const FOF_RENAMEONCOLLISION = &H8 'Create new numbered files (Copy
#1 of...) if copied or moved files conflict with existing files
Private Const FOF_SILENT = &H4 'Prevent display of a progress
dialog box for slow operations
Private Const FOF_SIMPLEPROGRESS = &H100 'Simplify the progress dialog
box by not showing filenames
Private Const FOF_WANTMAPPINGHANDLE = &H20 'If FOF_RENAMEONCOLLISION is
specified, the hNameMappings member will be filled in if any files were renamed.
'Must be freed using SHFreeNameMappings
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4

Private Type SHFILEOPSTRUCT
hWnd As Long ' Window owner of any dialogs
wFunc As Long ' Copy, move, rename, or delete code
pFrom As String ' Source file
pTo As String ' Destination file or directory
fFlags As Integer ' Options to control the operations
fAnyOperationsAbortedLo As Integer ' Indicates partial failure
fAnyOperationsAbortedHi As Integer
hNameMappingsLo As Long ' Array indicating each success
hNameMappingsHi As Long
lpszProgressTitleLo As Long ' Title for progress dialog only
used if FOF_SIMPLEPROGRESS
lpszProgressTitleHi As Long
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA"
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As
Long, ByVal bAlertable As Long) As Long



'****************************************************************************
' Name: CopyFile
'
' Purpose: Direct calls to system instead of VB to copy files in order
' to supply user with visual feedback when dealing with big files
'
'
' Return(Long):
' 0 in case of success
' -2 in case user cancelled operation
' Error number otherwise (for 'serious' errors)
'
' Input parameters:
' - sSrc As String
' - sDst As String
' - Optional Options& = 0
' - Optional Owner& = 0
' See parameter list for SHFileOperation function in Windows SDK
Help
'
' Caution! This functions might return zero even though file was not copied,
' moved or deleted correctly. It is necessary always to check
' the destination file inside the calling routine
'****************************************************************************


Private Function CopyFile(sSrc As String, sDst As String, Optional Options&
= 0, Optional Owner& = 0) As Long
Dim FOpStruct As SHFILEOPSTRUCT
Dim nAttempts As Integer
Dim Msg As String
With FOpStruct
.wFunc = FO_COPY
.pFrom = sSrc
.pTo = sDst
.fFlags = Options
.hWnd = Owner
nAttempts = 0
CopyIt:
CopyFile = SHFileOperation(FOpStruct)
If .fAnyOperationsAbortedLo <> 0 Or .fAnyOperationsAbortedHi <> 0
Then
If (Options And FOF_NOERRORUI) = 0 Then
Msg = "You have cancelled copying file" & vbCrLf & "from
" & sSrc
Msg = Msg & vbCrLf & "to " & sDst & vbCrLf & "Do you want
to retry?"
If MsgBox(Msg, vbRetryCancel) = vbRetry Then
GoTo CopyIt
Else
CopyFile = -2
End If
Else
SleepEx 50&, 0&
If nAttempts < 10 Then
GoTo CopyIt
Else
CopyFile = -2
End If
End If
End If
End With
End Function




Private Sub Command1_Click()
Dim sSrc$, sDest$, nOptions As Long
Static k
On Error GoTo ErrorHandler
sSrc = "C:\Source.txt"
sDest = "D:\Destination.txt"
nOptions = FOF_FILESONLY Or FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR


Result = CopyFile(sSrc, sDest, nOptions, Me.hWnd)
If Result <> 0 Then
k = k + 1
Debug.Print k, Format(Time, "hh:nn:ss"), CStr(Err.LastDllError),
"SHFileOperation Error"
Exit Sub
End If
'Always check if file was actually copied
If Dir(sDest) = "" Then
k = k + 1
Debug.Print k, Format(Time, "hh:nn:ss"), CStr(Err.LastDllError),
"SHFileOperation Error: " & sDest & " does not exists"
Exit Sub
End If
End Select

Exit Sub
ErrorHandler:
k = k + 1
MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub


Alex