Looking for way to display filecopy status.


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 2 of 2

Thread: Looking for way to display filecopy status.

  1. #1
    Dan Guest

    Looking for way to display filecopy status.


    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

  2. #2
    Alex Guest

    Re: Looking for way to display filecopy status.


    "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


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center