Source code for Issue Number 57

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at

Code of the Week Home

Source Code

Just paste this source code into a module called basShell and include it in your project.

'   Module Name:    basShell
'   Written By:     C&D Programming Corp.
'   Create Date:    10/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at
Option Explicit

'  Constants for the wFunc field in the SHFILEOPSTRUCT
' Copies the files specified in the pFrom member to the
' location specified in the pTo member.
Public Const FO_COPY As Long = &H2

' Moves the files specified in pFrom to the location
' specified in pTo.
Public Const FO_MOVE As Long = &H1

' Deletes the files specified in pFrom. (pTo is ignored.)
Public Const FO_DELETE As Long = &H3

' Renames the files specified in pFrom.
Public Const FO_RENAME As Long = &H4

'  Constants for the fFlags field in the SHFILEOPSTRUCT

' The pTo member specifies multiple destination
' files (one for each source file) rather than one
' directory where all source files are to be deposited.
Public Const FOF_MULTIDESTFILES As Long = &H1

' Prevent display of a progress dialog box for slow operations
Public Const FOF_SILENT As Long = &H4

' Create new numbered files (Copy #1 of...) if copied
' or moved files conflict with existing files

' Overwrite or delete files without confirmation
Public Const FOF_NOCONFIRMATION As Long = &H10

' Put deleted files (except those from floppy disks) in Recycle Bin
Public Const FOF_ALLOWUNDO As Long = &H40

' Interpret a wildcard source to mean files only, not directories
Public Const FOF_FILESONLY As Long = &H80

' Simplify the progress dialog box by not showing filenames
Public Const FOF_SIMPLEPROGRESS As Long = &H100

' Create any needed destination directories without confirmation
Public Const FOF_NOCONFIRMMKDIR As Long = &H200

' Normally the SHFILEOPSTRUCT is not double-word aligned.
' Unfortunately, Visual Basic automaticaly double-word aligns
' its structures.  If no steps are taken, the last 3 variables
' will not be passed correctly. This has no impact unless
' the progress title needs to be changed.

    ' Window handle to the dialog box to display information
    ' about the status of the file operation.
    hwnd As Long

    ' the operation to perform, as defined by one of the
    ' following values: FO_COPY, FO_MOVE, FO_DELETE, FO_RENAME
    wFunc As Long

    ' Address of a buffer to specify one or more source file
    ' names. Multiple names must be null-separated. The list
    ' of names must be double null-terminated.
    pFrom As String

    ' Address of a buffer to contain the name of the
    ' destination file or directory. The buffer can contain
    ' multiple destination file names if the fFlags member
    ' specifies FOF_MULTIDESTFILES. Multiple names must
    ' be null-separated. The list of names must be
    ' double null-terminated.
    pTo As String

    ' Flags that control the file operation.  See above constants
    ' for details.
    fFlags As Long

    ' Value that receives TRUE if the user aborted any file
    ' operations before they were completed, or FALSE otherwise.
    fAnyOperationsAborted As Long

    hNameMappings As Long

    ' Address of a string to use as the title of a progress
    ' dialog box. This member is used only if fFlags includes
    ' the FOF_SIMPLEPROGRESS flag.
    lpszProgressTitle As String
End Type

Private Declare Sub CopyMemory Lib "KERNEL32" _
                Alias "RtlMoveMemory" _
                    (hpvDest As Any, hpvSource As Any, _
                        ByVal cbCopy As Long)

' Normally the lpFileOp parameter would be defined as type
' SHFILEOPSTRUCT. Since we are doing a little
' workaround for the inability of Visual Basic to create
' a byte aligned structure we need to define it as Any.
Declare Function SHFileOperation Lib "Shell32.dll" _
                Alias "SHFileOperationA" _
                    (lpFileOp As Any) As Long

Public Sub CopyFiles(Window As Form, vSourceFiles As Variant, vDestFiles As Variant,  _
                           Optional sTitle As String = "", Optional bIncludeSubDirs As Boolean = False)
    Dim lResult As Long
    Dim typFileOperation As SHFILEOPSTRUCT
    Dim sSource As String
    Dim sDest As String

    With typFileOperation
        .hwnd = Window.hwnd
        .wFunc = FO_COPY

        ' The files to copy separated by a vbNullChar and terminated by
        ' an additional vbNullChar
        If TypeName(vSourceFiles) = "String()" Then
            GenericArrayToString sSource, vSourceFiles, vbNullChar
            sSource = sSource & vbNullChar
            sSource = vSourceFiles & vbNullChar
        End If

        .pFrom = sSource & vbNullChar

       'The directory or filename(s) to copy into

        If TypeName(vDestFiles) = "String()" Then
            GenericArrayToString sDest, vDestFiles, vbNullChar
            sDest = sDest & vbNullChar
            .fFlags = FOF_MULTIDESTFILES    ' since we have multiple dest
            sDest = vDestFiles & vbNullChar
        End If

        .pTo = sDest & vbNullChar

        .fFlags = .fFlags Or FOF_NOCONFIRMMKDIR

        If Not bIncludeSubDirs Then
            .fFlags = FOF_FILESONLY
        End If

        If sTitle <> "" Then
            .fFlags = .fFlags Or FOF_SIMPLEPROGRESS
            .lpszProgressTitle = sTitle & vbNullChar & vbNullChar
        End If
    End With

    lResult = FixUpAndCallSHFileOperation(typFileOperation)

    If lResult <> 0 Then        ' Operation failed
        If lResult = 117 Then ' cancelled operation
            Err.Raise lResult, "CopyFiles", "Operation Cancelled."
            Err.Raise Err.LastDllError, "CopyFiles", "Error occurred while copying files."
        End If
        If typFileOperation.fAnyOperationsAborted <> 0 Then
            Err.Raise 5, "CopyFiles", "Error occurred while copying files."
        End If
    End If
End Sub

'   This routine is needed to enable Visual Basic to pass a byte aligned
'   structure to the operating system.
Private Function FixUpAndCallSHFileOperation(fileop As SHFILEOPSTRUCT) As Long
    Dim lResult As Long
    Dim lFileOperationLength As Long
    Dim foBuffer() As Byte

    lFileOperationLength = LenB(fileop)         ' calc the length of the structure
    ReDim foBuffer(1 To lFileOperationLength)

    ' Now we need to copy the structure into a byte array
    Call CopyMemory(foBuffer(1), fileop, lFileOperationLength)

    ' Next we move the last 12 bytes by 2 to byte align the data
    Call CopyMemory(foBuffer(19), foBuffer(21), 12)

    ' call the system file operation api with the byte-aligned data
    FixUpAndCallSHFileOperation = SHFileOperation(foBuffer(1))
End Function