home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / xcopy / xcopy.bas < prev    next >
Encoding:
BASIC Source File  |  1995-12-04  |  3.9 KB  |  139 lines
  1. Option Explicit
  2.  
  3. Global Const ATTR_DIRECTORY = 16
  4.  
  5. Function CopyFiles (srcPath As String, dstPath As String, IncludeSubDirs As Integer, FilePat As String) As Integer
  6.  
  7. ' This routine copies all files matching FilePat from scrPath to dstPath.
  8. ' If IncludeSubDirs is set to True, all files in subdirs will be incuded (and
  9. ' the subdirs themselves of course), like XCOPY /S
  10.  
  11. Dim DirOK As Integer, i As Integer
  12. Dim DirReturn As String
  13. ReDim d(100) As String
  14. Dim dCount As Integer
  15. Dim CurrFile$
  16. Dim CurrDir$
  17. Dim dstPathBackup As String
  18. Dim f%
  19.  
  20.    On Error GoTo DirErr
  21.  
  22.    CurrDir$ = CurDir$
  23.    
  24.    ' If Path lacks a "\", add one to the end
  25.    If Right$(srcPath, 1) <> "\" Then srcPath = srcPath & "\"
  26.    srcPath = UCase$(srcPath)
  27.    If Right$(dstPath, 1) <> "\" Then dstPath = dstPath & "\"
  28.    dstPath = UCase$(dstPath)
  29.  
  30.    dstPathBackup = dstPath
  31.    
  32.    ' Initialize var to hold filenames
  33.    DirReturn = Dir(srcPath & "*.*", ATTR_DIRECTORY)
  34.    
  35.    ' Find all subdirs
  36.    Do While DirReturn <> ""
  37.       ' Make sure we don't do anything with "." and "..", they aren't real files
  38.       If DirReturn <> "." And DirReturn <> ".." Then
  39.          
  40.          If (GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
  41.             
  42.             ' It's a dir. Add it to dirlist
  43.             dCount = dCount + 1
  44.             d(dCount) = srcPath & DirReturn
  45.  
  46.          End If
  47.       End If
  48.       DirReturn = Dir
  49.    Loop
  50.    
  51.    ' Now do all the files matching FilePath (and make sure we don't do the dirs)
  52.    DirReturn = Dir(srcPath & FilePat, 0)
  53.  
  54.    ' Find all files
  55.    Do While DirReturn <> ""
  56.       ' Make sure we don't get a dir
  57.       If Not ((GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY) Then
  58.          ' It's a file. Copy it
  59.          Frm_Copy!Lbl_CopyInfo.Caption = "Copying " & srcPath & DirReturn & " to " & dstPath & DirReturn
  60.          Frm_Copy!Lbl_CopyInfo.Refresh
  61.          ' Make sure the file doesn't already exist. If it exists, prompt the user
  62.          ' to overwrite it.
  63.          On Error Resume Next
  64.          f% = FreeFile
  65.          Open dstPath & DirReturn For Input As #f%
  66.          Close #f%
  67.          If Err = 0 Then
  68.             ' Prompt the user
  69.             f% = MsgBox("The file " & dstPath & DirReturn & " already exists. Do you wish to overwrite it?", 4 + 32 + 256)
  70.             If f% = 6 Then FileCopy srcPath & DirReturn, dstPath & DirReturn
  71.          Else
  72.             FileCopy srcPath & DirReturn, dstPath & DirReturn
  73.          End If
  74.       End If
  75.       DirReturn = Dir
  76.    Loop
  77.  
  78.    ' Now do all subs
  79.    For i = 1 To dCount
  80.       
  81.       ' Check the 'IncludeSubDirs' value. If it's true, we have to make
  82.       ' a dir called 'd(i)' in dstPath, and then assign dstPath & d(i) as
  83.       ' dstPath
  84.       If IncludeSubDirs Then
  85.  
  86.          On Error GoTo PathErr
  87.          
  88.          dstPath = dstPath & Right$(d(i), Len(d(i)) - Len(srcPath))
  89.          
  90.          ' If the Path exists, then this will work out, if not, an error
  91.          ' will be generated and trapped, and the dir will be made
  92.          ChDir dstPath
  93.  
  94.          On Error GoTo DirErr
  95.  
  96.       Else
  97.  
  98.          ' Since we aren't recoursing, we're done
  99.          CopyFiles = True
  100.          GoTo ExitFunc
  101.          
  102.       End If
  103.  
  104.       DirOK = CopyFiles(d(i), dstPath, IncludeSubDirs, FilePat)
  105.  
  106.       ' Reset dstPath to the value assigned at the argument-line
  107.       dstPath = dstPathBackup
  108.  
  109.    Next
  110.  
  111.    CopyFiles = True
  112.  
  113. ExitFunc:
  114.  
  115.    ChDir CurrDir$
  116.  
  117.    Exit Function
  118.  
  119. DirErr:
  120.  
  121.    Frm_Copy!Lbl_CopyInfo = "Error: " & Error$(Err)
  122.    
  123.    CopyFiles = False
  124.    Resume ExitFunc
  125.  
  126. PathErr:
  127.    ' Didn't find the Dir'ed path
  128.    If Err = 75 Or Err = 76 Then
  129.       Frm_Copy!Lbl_CopyInfo.Caption = "Making directory " & dstPath
  130.       Frm_Copy!Lbl_CopyInfo.Refresh
  131.       MkDir dstPath
  132.       Resume Next
  133.    End If
  134.  
  135.    GoTo DirErr
  136.    
  137. End Function
  138.  
  139.