|
|
|
|
|
|
|
|
|
|
|
 |
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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:
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. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
 |
