Visual Basic File API Routines

CopyFileEx: Create a File Backup App
     
Posted:   Saturday September 18, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

CopyFileEx: Create a File Backup App with a Progress Callback
     
 Prerequisites
None.

I receive a lot of ideas for code pages from interesting questions posted in the Microsoft newsgroups, and this demo is based on one of those. The OP wanted to devise a backup mechanism to copy files from one folder to another but, to minimize backup time, make the method contingent on the file needing backing up. That is to say, if fileA existed in the backup folder and was the same as the source fileA, then not to spend the time copying that file. 

I approached this by looking at four aspects of the file in question - the existence of the target file, the size of both files, their attributes and their last-write dates.

The resulting code below enumerates through each file in a given source path and first tests if there is a file of the same name in the target folder. If there is not, a backup is made. If there is a file with the same name then the size, date and attributes of each are compared.

As presently coded, if the source file is newer than the target file it is copied to overwrite the target. If the target file is newer (something that theoretically shouldn't happen if this were a true backup), the routine logs that fact but does not copy the file (as shown in the illustration). Having the app copy the file requires the developer to uncomment just one line of code below. Finally, if the attributes of the files are different, again as presently as coded, the app logs this too without performing a copy. The user may again choose to enable the copy mechanism here to overwrite the target regardless of the attributes.

Not included in this demo is a line or two of code to set a file's attributes (for example turning off the Archive bit), something that you may want to include in a true copy/backup routine.

In table form the logic flow for the code looks like:

  • 1.  Check for existence of source folder
  • 2.  If source folder not available, perform action (ie abort, map a drive etc)
  • 3.  Check for existence of target folder
  • 4.  If target folder not available, perform action (ie abort, create folder(s) etc)
  • 5.  Obtain handle to the source folder
  • 6.  Begin enumerating source contents
  • 7.  If source item is a file, attempt to locate the same file in the target folder
  • 8.  If file is missing in target, copy the file
  • 9.  If file is present, obtain the file details of both the source and target files
  • 10.  If files are the same, move to the next file in the source folder
  • 11.  If files are different, copy source file into target folder (noting conditions above)
  • 12.  Repeat for all files in source

As tends to be my custom there are more comments than code below ... the routines are actually pretty compact considering what they do.

Note: As-coded, the routine does make one assumption ... the CreateNestedFolders routine responsible for creating the target folders (regardless of the nest level) is hard-coded to extract a drive letter for the path's creation. On a networked system that is not using mapped drives the code would need to be amended to correctly handle targets on a UNC path. An alternative to this would be to add the code from WNetAddConnection2: Transparently Connect to Network Shares in order for the application to automatically map the required drive, if needed, before accessing or creating the target folder.

The one other omission - mostly to keep the code minimal, was a recursive search for files in subfolders at the source. There are several other File API pages here that cover how to do recursive searching using FindFirstFile/FindNextFile - look in the FileAPI code section under the 'Recursive' subcategory.

 BAS Module Code
None.

 Form Code
Create a new project, and add to the form: two text boxes (Text1 & Text2), two lists (List1 & List2), and a command button, (Command1). Labels are optional. Text1 and List1 correspond to source file settings, while Text2 and List2 handle the target. Once constructed, add the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
PrivateConst MAXDWORD As Long = &HFFFFFFFF
PrivateConst MAX_PATH As Long = 260
PrivateConst INVALID_HANDLE_VALUE As Long = -1
PrivateConst FILE_ATTRIBUTE_DIRECTORY As Long = &H10

PrivateType FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

PrivateType WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

PrivateType SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

PrivateDeclare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
PrivateDeclare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
PrivateDeclare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
      
PrivateDeclare Function CompareFileTime Lib "kernel32" _
  (lpFileTime1 As FILETIME, _
   lpFileTime2 As FILETIME) As Long

PrivateDeclare Function CopyFile Lib "kernel32" _
   Alias "CopyFileA" _
  (ByVal lpExistingFileName As String, _
   ByVal lpNewFileName As String, _
   ByVal bFailIfExists As Long) As Long
   
PrivateDeclare Function CreateDirectory Lib "kernel32" _
    Alias "CreateDirectoryA" _
   (ByVal lpPathName As String, _
    lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
    
    
Private Sub Command1_Click()
   
   List1.AddItem "--- new backup ---"
   List2.AddItem "--- new backup ---"
   
   Call BackupBegin()

End Sub


Private Sub BackupBegin()

   Dim WFDSource As WIN32_FIND_DATA
   Dim WFDTarget As WIN32_FIND_DATA
   
   Dim sSourceFolder As String
   Dim sTargetFolder As String
   
   Dim hFileSource As Long
   Dim hFileTarget As Long
   
'Pre-backup check (this sub)
'------------------------------------------------
'1.  Important! Assure both source and target
'    paths are fully qualified
'2.  Check for existence of source folder
'    by obtaining a handle to the source
'3.  If source folder not available, perform
'    action (ie abort, map a drive etc)
'4.  Check for existence of target folder
'5.  If target folder not available, perform
'    action (ie abort, create folder(s) etc)

'Backup steps (BackupSourceFolder function)
'------------------------------------------------
'1. Begin enumerating source folder contents
'2. If source item is a file, attempt to
'   locate the same file in the target folder
'3. If file is missing, copy it
'4. If file is present, obtain the file details
'   of the source and target files
'5. If they are the same, move to the next file in the source folder
'6. If they are different, copy source file into target folder
'7. Repeat for all files in source.
      
  'Assure both source and target
  'paths are fully qualified
   sSourceFolder = QualifyPath(Text1.Text)
   sTargetFolder = QualifyPath(Text2.Text)
   
  'Check for existence of source folder
  'by obtaining a handle to the source
   hFileSource = FileGetFileHandle(sSourceFolder, WFDSource)
   
  'If source folder not available, perform
  'action (ie abort, map a drive etc)
   If hFileSource = INVALID_HANDLE_VALUE Then
   
      MsgBox "Backup source folder " & sSourceFolder & " not found."
      Exit Sub
      
   End If
   
  'Check for existence of target folder
  'by obtaining a handle to the target
   hFileTarget = FileGetFileHandle(sTargetFolder, WFDTarget)
   
   If hFileTarget = INVALID_HANDLE_VALUE Then
      
     'If target folder not available, perform
     'action (ie abort, create folder(s) etc).
     'Here,  we'll create the folder(s)
      MsgBox "Backup folder " & sTargetFolder & " not found. Creating target."
            
     'remember ... although the CreateNestedFolders call
     'returns the *value* of the handle used in creating the 
     'folders, the handle was actually closed in the function. 
     'The value is returned for comparison in the If..Then 
     'below is not and is NOT valid, so don't attempt to
     'use it to access files!
      hFileTarget = CreateNestedFolders(sTargetFolder)
   
   End If

  'If source and target handles are valid
   If (hFileSource <> INVALID_HANDLE_VALUE) And _
      (hFileTarget <> INVALID_HANDLE_VALUE) Then
      
     'perform the backup
      Call BackupSourceFolder(hFileSource, sSourceFolder, WFDSource, sTargetFolder)
         
   End If
  
  'clean up by closing the source handle. The target
  'handle is closed in the BackupSourceFolder sub.
   Call FindClose(hFileSource)
   
End Sub


Private Function FileCompareFileDates(WFDSource As WIN32_FIND_DATA, _
                                      WFDTarget As WIN32_FIND_DATA) As Long
   
   Dim CTSource As FILETIME
   Dim CTTarget As FILETIME
   
  'assign the source and target file write 
  'times to a FILETIME structure, and compare. 
   CTSource.dwHighDateTime = WFDSource.ftLastWriteTime.dwHighDateTime
   CTSource.dwLowDateTime = WFDSource.ftLastWriteTime.dwLowDateTime
   
   CTTarget.dwHighDateTime = WFDTarget.ftLastWriteTime.dwHighDateTime
   CTTarget.dwLowDateTime = WFDTarget.ftLastWriteTime.dwLowDateTime
   
   FileCompareFileDates = CompareFileTime(CTSource, CTTarget)
   
End Function


Private Function UnQualifyPath(ByVal sFolder As String) As String

  'remove any trailing slash
   sFolder = Trim$(sFolder)
   
   If Right$(sFolder, 1) = "\" Then
      UnQualifyPath = Left$(sFolder, Len(sFolder) - 1)
   Else
      UnQualifyPath = sFolder
   End If
   
End Function


Private Function BackupSourceFolder(ByVal hFileSource As Long, _
                                    ByVal sSourceFolder As String, _
                                    WFDSource As WIN32_FIND_DATA, _
                                    ByVal sTargetFolder As String) As Long

  'common local working variables
   Dim sPath As String
   Dim sRootSource As String
   Dim sTmp As String
   Dim sTargetMsg As String
   Dim sSourceMsg As String
   Dim diff As Long

  'variables used for the source files and folders
   Dim dwSourceFileSize As Long

  'variables used for the target files and folders
   Dim WFDTarget As WIN32_FIND_DATA
   Dim hTargetFile As Long
   Dim dwTargetFileSize As Long

   sRootSource = QualifyPath(sSourceFolder)
   sPath = sRootSource & "*.*"

  'last check!
   If hFileSource <> INVALID_HANDLE_VALUE Then

      Do

        'remove trailing nulls from the first retrieved object
         sTmp = TrimNull(WFDSource.cFileName)
         
        'if the object is not a folder..
         If (WFDSource.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
         
           'check for the corresponding file
           'in the target folder by using the API
           'to locate that specific file
            hTargetFile = FindFirstFile(sTargetFolder & sTmp, WFDTarget)
           
           'if the file is located in the target folder..
            If hTargetFile <> INVALID_HANDLE_VALUE Then
            
              'get the file size for the source and target files
               dwSourceFileSize = FileGetFileSize(WFDSource)
               dwTargetFileSize = FileGetFileSize(WFDTarget)

              'compare the dates.
              'If diff = 0 source and target are the same
              'If diff = 1 source is newer than target
              'If diff = -1 source is older than target
               diff = FileCompareFileDates(WFDSource, WFDTarget)
               
              'if the dates, attributes and file times
              'are the same...
               If (dwSourceFileSize = dwTargetFileSize) And _
                  WFDSource.dwFileAttributes = WFDTarget.dwFileAttributes And _
                  diff = 0 Then
               
                 '...the files are the same, so take
                 'appropriate action (here, this is
                 'to simply list the files for info)
                  List1.AddItem sTmp & vbTab & _
                        dwSourceFileSize & vbTab & _
                        WFDSource.dwFileAttributes & vbTab & _
                        "files the same"
                        
                  List2.AddItem sTmp & vbTab & _
                        dwTargetFileSize & vbTab & _
                        WFDTarget.dwFileAttributes & vbTab & _
                        "No"
               
               Else
               
                 'files are not the same

                  If diff = 1 Then
                    'perform the preferred copy method ONLY if
                    'diff indicated that the source was newer!
                     Call CopyFile(sSourceFolder & sTmp, sTargetFolder & sTmp, False)
                     sTargetMsg = "Yes"
                     sSourceMsg = "source newer"
                     
                  ElseIf diff = -1 Then
                    'source is older
                     sTargetMsg = "No"
                     sSourceMsg = "source older"
                     
                  ElseIf diff = 0 Then
                    'the dates are the same but the file attributes
                    'are different. Since the date didn't change,
                    'replacing the file is a judgement call for
                    'the developer. Uncomment the line below if
                    'you want to copy this file, or alternatively,
                    'add a checkbox in your app the user can select
                    'to force an overwrite of files with similar dates.
                     sTargetMsg = "No"
                     sSourceMsg = "attr different"
                    'Call CopyFile(sSourceFolder & sTmp, sTargetFolder & sTmp, False)
                  End If
                  
                 'debug only: add the files to the
                 'lists with the appropriate message
                  List1.AddItem sTmp & vbTab & _
                        dwSourceFileSize & vbTab & _
                        WFDSource.dwFileAttributes & vbTab & _
                        sSourceMsg
                                         
                  List2.AddItem sTmp & vbTab & _
                        dwTargetFileSize & vbTab & _
                        WFDTarget.dwFileAttributes & vbTab & _
                        sTargetMsg

               End If  'If dwSourceFileSize
               
              'since the target file was found,
              'close the handle
               Call FindClose(hTargetFile)
               
            Else:
            
                 'the target file was not found so
                 'copy the file to the target directory
                  Call CopyFile(sSourceFolder & sTmp, sTargetFolder & sTmp, False)
                  
                 'info only: add the files to the lists
                  List1.AddItem sTmp & vbTab & _
                        "target file did not exist"
                        
                  List2.AddItem sTmp & vbTab & _
                        dwTargetFileSize & vbTab & _
                        WFDTarget.dwFileAttributes & vbTab & _
                        "Yes"
              
            End If  'If hTargetFile
         End If  'If WFDSource.dwFileAttributes

        'clear the local variables
         dwSourceFileSize = 0
         dwTargetFileSize = 0
      
      Loop While FindNextFile(hFileSource, WFDSource)

   End If
   
End Function


Private Function FileGetFileSize(WFD As WIN32_FIND_DATA) As Long

   FileGetFileSize = (WFD.nFileSizeHigh * (MAXDWORD + 1)) + WFD.nFileSizeLow
   
End Function


Private Function FileGetFileHandle(sPathToFiles As String, _
                                   WFD As WIN32_FIND_DATA) As Long

   Dim sPath As String
   Dim sRoot As String
      
   sRoot = QualifyPath(sPathToFiles)
   sPath = sRoot & "*.*"
   
  'obtain handle to the first match
  'in the target folder
   FileGetFileHandle = FindFirstFile(sPath, WFD)
   
End Function


Private Function QualifyPath(sPath As String) As String

  'assures that a passed path ends in a slash
   If Right$(sPath, 1) <> "\" Then
      QualifyPath = sPath & "\"
   Else
      QualifyPath = sPath
   End If
      
End Function


PrivateFunction TrimNull(startstr As String) As String

  'returns the string up to the first
  'null, if present, or the passed string
   Dim pos As Integer
   
   pos = InStr(startstr, Chr$(0))
   
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
  
   TrimNull = startstr
  
End Function


Private Function CreateNestedFolders(ByVal sCompletePath As String) As Long

  'creates nested directories on the drive
  'included in the path by parsing the passed
  'directory string and looping through each
  'folder listed to create the final path.
  '
  'Note: this routine was developed prior to the 
  'availability of the Split() function, which 
  'VB6 users can use to simplify the routine 
  'significantly. It was also developed prior 
  'to the availability of the MakeSureDirectoryPathExists() 
  'API which would reduce the code here even further.
  
   Dim SA As SECURITY_ATTRIBUTES
   Dim WFD As WIN32_FIND_DATA
   Dim drivePart As String
   Dim newDirectory  As String
   Dim item As String
   Dim pos As Long
   Dim cnt As Long
   Dim hPath As Long
   
  'Procedures in this function
  '--------------------------------------------------
  '1. Make sure the path is fully qualified: required!
  '2. Check for a drive in the string; if
  '   so get it otherwise assume current drive
  '3. Enter loop ...
  '4. Extract each folder that makes up the total path
  '5. If the first time through, create the
  '   folder using the drive spec, otherwise
  '   append successive levels to the nested folders
  '7. Call CreateDirectory until the total path created
  '8. As a sign of success, call FileGetFileHandle
  '   passing the directory that should now exist.
  '   If the returned value is not INVALID_HANDLE_VALUE
  '   the CreateDirectory call was successful.
  '9. Close the handle on exiting.
  
   sCompletePath = QualifyPath(sCompletePath)
   
   pos = InStr(sCompletePath, ":\")

   If pos Then
      drivePart = StripDelimitedItem(sCompletePath, "\")
   Else
      drivePart = StripDelimitedItem(CurDir(), "\")
   End If

   Do

      cnt = cnt + 1
      
      item = StripDelimitedItem(sCompletePath, "\")
     
      If cnt = 1 Then
         newDirectory = drivePart & item
      Else
         newDirectory = newDirectory & item
      End If

      SA.nLength = LenB(SA)
      Call CreateDirectory(newDirectory, SA)
      
   Loop Until sCompletePath = ""
   
   hPath = FileGetFileHandle(sCompletePath, WFD)
   
   CreateNestedFolders = hPath
   Call FindClose(hPath)
   
End Function


Private Function StripDelimitedItem(startStrg As String, _
                                    delimiter As String) As String

  'take a string separated by delimiter,
  'split off 1 item, and shorten the string
  'so the next item is ready for removal.
   Dim pos As Long
   Dim item As String
   
   pos = InStr(1, startStrg, delimiter)
   
   If pos Then

      StripDelimitedItem = Mid$(startStrg, 1, pos)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
    
   End If

End Function
 Comments
Save the project, and before running, set the correct paths in both text boxes. Toss some files into the source folder and run. Note that if you error during the run, you may be unable to delete the target files for a second test. This is due to CopyFile leaving the file opened; the only recourse is to save the work, exit the project and restart it. You can then delete the target folders and/or files.

If you have copied many files into the source folder, especially if some were large files, you will encounter two of the drawbacks to this method... one, that the app 'locks up' during the copying (a judiciously placed DoEvents with a corresponding Enabled=False for the command button will overcome this. The second drawback is that without the list, you don't know how the copying is progressing. Therefore, we need a second demo .. CopyFileEx: Create a File Backup App with a Progress Callback.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter