home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgfs / safecopy.vbs < prev    next >
Encoding:
Text File  |  1998-10-23  |  5.4 KB  |  170 lines
  1. '--------------------------------------------------------------------------
  2. ' SafeCopy.vbs - Makes backup copy of the VisualC project tree.
  3. '                Backup copy is copied to the first removable drive.
  4. '                Assumes that WinZip is installed.
  5. '                To customize this script, change constants 
  6. '                specified at the top of the file.
  7. '
  8. ' NOTE: Before running this script make sure that folder
  9. '       specified in sRootFolder variable is current folder.
  10. '
  11. ' This file is part of the sgFileSys.
  12. ' Copyright (C) 1998 Stinga
  13. ' You can use and modify this script.
  14. '--------------------------------------------------------------------------option explicit
  15. option explicit
  16.  
  17. Dim sRootFolder, sProjectFolder, sZipFile
  18. sRootFolder    = "f:/Projects/"
  19. sProjectFolder = "f:/Projects/Components/sgFileSys/"
  20. sZipFile       = "sgFileSys"
  21.  
  22.  
  23. ' SGFileSys.Enumerator constants
  24. const sgfAll          = &H00001FF7&
  25. const sgfArchive      = &H00000020&
  26. const sgfCompressed   = &H00000800&
  27. const sgfDirectory    = &H00000010&
  28. const sgfEncrypted    = &H00000040&
  29. const sgfHidden       = &H00000002&
  30. const sgfNormal       = &H00000080&
  31. const sgfOffline      = &H00001000&
  32. const sgfReadOnly     = &H00000001&
  33. const sgfReparsePoint = &H00000400&
  34. const sgfSparseFile   = &H00000200&
  35. const sgfSystem       = &H00000004&
  36. const sgfTemporary    = &H00000100&
  37.  
  38.  
  39. ' Create and initialize file enumerator
  40. Dim en
  41. Set en = WScript.CreateObject("SGFileSys.Enumerator")
  42.  
  43. en.Recurse         = true
  44. en.RootPath        = sProjectFolder
  45. en.NameMask        = "*.*"
  46. en.ExcludedFolders = "debug:release:"
  47. en.ExcludedExt     = "scc:mdb:ncb:aps:plg:opt:mdp:bak:tmp:obj:o:exe:dll:"  & _
  48.                      "lib:ocx:out:ex~:res:sbr:tlh:tli:trg:pdb:ilk:idb:pch:" & _
  49.                      "zip:log:ps:wc:vbw:oca:exp"
  50.  
  51. ' Create shell objects
  52. Dim FS, WSH
  53. Set WSH = WScript.CreateObject("WScript.Shell")
  54. Set FS  = CreateObject("Scripting.FileSystemObject")
  55.  
  56. On Error Resume Next
  57.  
  58. ' Prepare parameters
  59. sRootFolder = Replace(sRootFolder, "/", "\")
  60. sProjectFolder = Replace(sProjectFolder, "/", "\")
  61.  
  62.  
  63. ' Define destination drive and file
  64. Dim strDestDrive
  65. strDestDrive = GetRemovableDrive(FS)
  66. if strDestDrive = "" then
  67.   msgbox "Unable to find removable drive"
  68.   WScript.Quit
  69. end if
  70.  
  71. ' Delete old compressed file
  72. if FS.FileExists(sZipFile + ".zip") then _
  73.    FS.DeleteFile sZipFile + ".zip", True
  74.  
  75. ' Create output file
  76. Dim strOutFile, outFile
  77. strOutFile = "FileList.txt"
  78. Set outFile = FS.CreateTextFile(strOutFile, True)
  79.  
  80. ' Collect files to backup
  81. CollectFileNames en, sRootFolder, outFile
  82. Set outFile = Nothing
  83.  
  84. ' Get WinZIP executable path
  85. Dim strWinZipFile
  86. strWinZipFile = WSH.RegRead("HKCR\WinZip\shell\open\command\")
  87. If (Trim(strWinZipFile) = "") Then
  88.    MsgBox "Unable to find WinZIP.EXE file"
  89.    WScript.Quit
  90. End If
  91. strWinZipFile = """" & Left(strWinzipFile, InStrRev(strWinzipFile, " ")-1) & """"
  92.  
  93. ' Create command line and compress files
  94. Dim strParameters, strCmdLine, rc
  95. strParameters = "-a -r -p -ex " & sZipFile & ".zip @" & strOutFile
  96. strCmdLine    = strWinZipFile & " " & strParameters
  97. rc = WSH.Run(strCmdLine, 9, True)
  98. If Err.Number <> 0 Then ReportError(True)
  99.  
  100. ' Delete existing backups on the removable drive
  101. FS.DeleteFile strDestDrive & sZipFile & "*.zip", True
  102. If Err.Number<>0 And Err.Number<>53 then ReportError(True)
  103.  
  104. ' Copy zipped file to the removable drive
  105. Err.Clear
  106. FS.CopyFile sZipFile & ".zip", strDestDrive & sZipFile & ".zip"
  107. If Err.Number <> 0 Then ReportError(True)
  108.  
  109. WScript.Quit
  110.  
  111.  
  112.  
  113. '----------------------------------------------------------------------------------
  114. ' CollectFileNames() subroutine walks folder tree and writes file paths
  115. ' to the specified text stream.
  116. '
  117. ' In:
  118. '   enum      - SGFileSys.Enumerator object
  119. '   outRoot   - string that will be removed from the start of the file path
  120. '   out       - TextStream object that will contain collected file names
  121. '
  122. ' Out:
  123. '   File with list of files
  124. '----------------------------------------------------------------------------------
  125. Sub CollectFileNames(en, outRoot, out)
  126.  
  127.     Dim nPrefixLen, strPath, item
  128.     outRoot = LCase(outRoot)
  129.     nPrefixLen = Len(outRoot)
  130.  
  131.     for each item in en.items
  132.         ' Do not emit directories into the result file
  133.         if (item.Attributes And sgfDirectory) <> sgfDirectory then
  134.             ' Remove root path from the current item path
  135.             strPath = LCase(item.Path)
  136.             if (nPrefixLen > 0) And (InStr(strPath, outRoot) = 1) then _
  137.                 strPath = Mid(strPath, nPrefixLen+1)
  138.  
  139.             ' Write file specification line
  140.             out.WriteLine strPath
  141.         end if
  142.     next
  143. end sub
  144.  
  145. '----------------------------------------------------------------------------------
  146. ' ReportError
  147. '----------------------------------------------------------------------------------
  148. Sub ReportError(bQuit)
  149.   If Err.Number<>0 then
  150.      MsgBox Err.Description + " (" + Err.Number + ")"
  151.      if bQuit Then WScript.Quit
  152.   End If
  153. End Sub
  154.  
  155. '----------------------------------------------------------------------------------
  156. ' Find first removable drive
  157. '----------------------------------------------------------------------------------
  158. function GetRemovableDrive(fs)
  159.   Dim drive
  160.   for each drive in fs.Drives
  161.     if drive.DriveType = 1 And drive.Driveletter <> "A" And drive.Driveletter <> "B" then
  162.        GetRemovableDrive = drive.DriveLetter + ":\"
  163.        exit function
  164.     end if
  165.   next
  166.   
  167.   ' Default is floppy A:
  168.   GetRemovableDrive = "A:\"
  169. end function
  170.