批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[转贴] VBS Sync 同步文件夹

本帖最后由 yu2n 于 2013-4-18 17:59 编辑

VBS 同步文件夹 [翻译+转载 by yu2n]
功能:  同步文件夹,只更新已修改(或新增)的文件及文件夹,支持删除多余(目标文件夹中存在,源文件夹不存在)的文件及文件夹
参数:  sync.vbs  [/RD]  [/RF]  [/C]  <sourcePath>  <destinationPath>
  sourcePath  源文件夹
  destinationPath  目标文件夹
  /RD 删除目标文件夹中多余的文件夹;
  /RF 删除目标文件夹中多余的文件;
  /C  等于同时使用 /RD /RF 参数
源代码下载:  http://www.robotii.co.uk/wp-content/uploads/2008/10/sync.vbs
个人说明:  此脚本是我使用过的同步脚本中效率及兼容性最高的。
  1. ' Download:  http://www.robotii.co.uk/wp-content/uploads/2008/10/sync.vbs
  2. '**********************************************************************
  3. ' sync.vbs
  4. '
  5. ' This script makes a "synchronised" backup of a folder tree from one
  6. ' path to another.
  7. '
  8. ' Extraneous directories (folders) may be removed from the destination
  9. ' tree by specifying the /RD switch on the command line.  These are
  10. ' directories already existing in the destination tree but no longer
  11. ' found in the source tree.
  12. '
  13. ' Extraneous files may be removed from the destination tree by specifying
  14. ' the /RF switch on the command line.  These are files which exist in
  15. ' destination directories but not in source directories.
  16. '
  17. ' Both extraneous directories and files can be removed by specifying the
  18. ' /C switch on the command line. This switch is equivalent to specifying
  19. ' both the /RD and /RF switches
  20. '
  21. ' Usage:  sync.vbs <sourcePath> <destinationPath>
  22. '    or:  cscript /nologo sync.vbs <sourcePath> <destinationPath>
  23. '    or:  wscript /nologo sync.vbs <sourcePath> <destinationPath>
  24. '
  25. ' Notes:  Paths can use drive letters or UNC specifications.
  26. '
  27. '**********************************************************************
  28. Dim oArgs
  29. Dim TempArg
  30. Dim bRemoveFolders
  31. Dim bRemoveFiles
  32. Dim SleepTime
  33. Dim SrcFolder
  34. Dim arrSrcFolders()
  35. Dim s
  36. Dim DstFolder
  37. Dim arrDstFolders()
  38. Dim d
  39. Dim arrCopyFrom()
  40. Dim arrCopyTo()
  41. Dim arrSizes()
  42. Dim fMax
  43. Dim TotalSize
  44. Dim oExplorer
  45. Dim FSO
  46. On Error Resume Next
  47.   bRemoveFolders = False
  48.   bRemoveFiles   = False
  49.   SleepTime      = 10    ' default to leaving display onscreen for 10 seconds
  50.   Set oArgs = WScript.Arguments
  51.   For s = 0 To oArgs.Count - 1
  52.     TempArg = Ucase(Left(oArgs(s),3))
  53.     Select Case TempArg
  54.       Case "/?"
  55.             ShowSyntax()
  56.             Wscript.Quit
  57.       Case "/S:"
  58.             SrcFolder = Trim(Mid(oArgs(s),4))
  59.       Case "/D:"
  60.             DstFolder = Trim(Mid(oArgs(s),4))
  61.       Case "/RD"
  62.             bRemoveFolders = True
  63.       Case "/RF"
  64.             bRemoveFiles = True
  65.       Case "/C"
  66.             bRemoveFiles = True
  67.             bRemoveFolders = True
  68.       Case "/T:"
  69.             SleepTime = Cint(Mid(oArgs(s),4))
  70.             If SleepTime < 0 Then
  71.               SleepTime = 0
  72.             End If
  73.       Case Else
  74.             If Left(oArgs(s),1) <> "/" Then
  75.               If SrcFolder = "" Then
  76.                 SrcFolder = oArgs(s)
  77.               ElseIf DstFolder = "" Then
  78.                 DstFolder = oArgs(s)
  79.               Else
  80.                 Wscript.Echo "Unknown parameter on command line... " & oArgs(s)
  81.                 ShowSyntax()
  82.                 Wscript.Quit
  83.               End If
  84.             End If
  85.     End Select
  86.   Next
  87.   If SrcFolder = "" or DstFolder = "" Then
  88.     Wscript.Echo "You must enter a 'SourcePath' and 'DestinationPath' when starting this script."
  89.     ShowSyntax()
  90.     Wscript.Quit
  91.   End If
  92.   If Right(SrcFolder,1) <> "\" Then
  93.     SrcFolder = SrcFolder & "\"
  94.   End If
  95.   If Right(DstFolder,1) <> "\" Then
  96.     DstFolder = DstFolder & "\"
  97.   End If
  98.   If InStr(LCase(SrcFolder),LCase(DstFolder)) > 0 _
  99.   Or InStr(LCase(DstFolder),LCase(SrcFolder)) > 0  Then
  100.     Wscript.Echo "The 'SourcePath' and 'DestinationPath' cannot overlap!"
  101.     Wscript.Quit
  102.   End If
  103.   TotalSize = 0
  104.   Set FSO = CreateObject("Scripting.FileSystemObject")
  105.   Set oExplorer = CreateObject("InternetExplorer.Application")
  106.   oExplorer.Navigate2 "about:blank"
  107.   oExplorer.Width     = 550
  108.   oExplorer.Height    = 300
  109.   oExplorer.Top       = 300
  110.   oExplorer.Left      = 300
  111.   oExplorer.Toolbar   = False
  112.   oExplorer.Menubar   = False
  113.   oExplorer.Statusbar = False
  114.   oExplorer.Visible   = True
  115.   oExplorer.Document.Write "<font face=Verdana>"
  116.   oExplorer.Document.Write "<h2>File Backup in Progress</h2>"
  117.   oExplorer.Document.Write "<p>Beginning backup...<br>"
  118.   oExplorer.Document.Title = "Please be patient.... "
  119.   GetSrcInfo
  120.   GetDstInfo
  121.   CreateMissingFolders
  122.   If bRemoveFolders Then
  123.     DeleteExtraFolders
  124.   End If
  125.   If bRemoveFiles Then
  126.     DeleteExtraFiles
  127.   End If
  128.   FindFilesNeedingBackup
  129.   CopySourceToDest
  130.   oExplorer.document.write "<font color=red>"
  131.   oExplorer.Document.Write "  Finished!<br>"
  132.   If SleepTime > 0 Then
  133.     Wscript.Sleep (SleepTime * 1000)
  134.   End If
  135.   QuitScript()
  136. Sub GetSrcInfo()
  137.   oExplorer.Document.Write "Analyzing source directories...<br>"
  138.   '-- get information about source directories
  139.   If FSO.FolderExists(SrcFolder) Then
  140.     ReDim arrSrcFolders(100)
  141.     s = 0
  142.     arrSrcFolders(0) = Left(SrcFolder, Len(SrcFolder) - 1)
  143.     GetSrcFolders FSO.GetFolder(SrcFolder)
  144.     ReDim Preserve arrSrcFolders(s)
  145.   Else
  146.     Wscript.Echo "Source folder not found... aborting."
  147.     QuitScript()
  148.   End If
  149. End Sub
  150. Sub GetSrcFolders(Folder)
  151.   Dim Subfolder
  152.   For Each Subfolder In Folder.SubFolders
  153.     s = s + 1
  154.     If s > Ubound(arrSrcFolders) Then
  155.       ReDim Preserve arrSrcFolders(Ubound(arrSrcFolders) + 100)
  156.     End If
  157.     arrSrcFolders(s) = SubFolder.Path
  158.     GetSrcFolders Subfolder
  159.   Next
  160. End Sub
  161. Sub GetDstInfo()
  162.   oExplorer.Document.Write "Analyzing backup directories...<br>"
  163.   '-- get information about destination directories
  164.   If Not FSO.FolderExists(DstFolder) Then
  165.     CreateMultiLevelFolder DstFolder
  166.   End If
  167.   ReDim arrDstFolders(100)
  168.   d = 0
  169.   arrDstFolders(0) = Left(DstFolder, Len(DstFolder) - 1)
  170.   GetDstFolders FSO.GetFolder(DstFolder)
  171.   ReDim Preserve arrDstFolders(d)
  172. End Sub
  173. Sub CreateMultiLevelFolder(FolderPath)
  174. Dim TempPath
  175. Dim Path
  176. Dim arrNodes
  177. Dim n
  178.   TempPath = FolderPath
  179.   Path = ""
  180.   ' See if input is in UNC format...
  181.   If Instr(TempPath,"\\") > 0 Then
  182.     TempPath = Mid(TempPath,3)
  183.     n = Instr(TempPath,"\")
  184.     Path = "\\" & Left(TempPath,n)
  185.     TempPath = Mid(TempPath,n+1)
  186.   End If
  187.   arrNodes = Split(TempPath,"\")
  188.   Path     = Path & arrNodes(0)
  189.   For n = 1 To UBound(arrNodes)
  190.     Path = Path & "\" & arrNodes(n)
  191.     If Not FSO.FolderExists(Path) Then
  192.       FSO.CreateFolder(Path)
  193.     End If
  194.   Next
  195. End Sub
  196. Sub GetDstFolders(Folder)
  197.   Dim Subfolder
  198.   For Each Subfolder In Folder.SubFolders
  199.     d = d + 1
  200.     If d > Ubound(arrDstFolders) Then
  201.       ReDim Preserve arrDstFolders(Ubound(arrDstFolders) + 100)
  202.     End If
  203.     arrDstFolders(d) = SubFolder.Path
  204.     GetDstFolders Subfolder
  205.   Next
  206. End Sub
  207. Sub CreateMissingFolders()
  208.   Dim LenOfSrcBaseDir
  209.   Dim strFolder, f
  210.   oExplorer.Document.Write "Creating any missing backup directories...<br>"
  211.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  212.   For f = 0 to s
  213.     strFolder = DstFolder & Mid(arrSrcFolders(f), LenOfSrcBaseDir)
  214.     If Not FSO.FolderExists(strFolder) Then
  215.       FSO.CreateFolder(strFolder)
  216.     End IF
  217.   Next
  218. End Sub
  219. Sub DeleteExtraFolders()
  220.   Dim LenOfDstBaseDir
  221.   Dim strFolder, f
  222.   oExplorer.Document.Write "Removing any extra backup directories...<br>"
  223.   LenOfDstBaseDir = Len(DstFolder) + 1
  224.   For f = 0 To d
  225.     strFolder = SrcFolder & Mid(arrDstFolders(f), LenOfDstBaseDir)
  226.     If (Not FSO.FolderExists(strFolder)) Then
  227.       FSO.DeleteFolder arrDstFolders(f),True
  228.     End IF
  229.   Next
  230. End Sub
  231. Sub DeleteExtraFiles()
  232.   Dim LenOfSrcBaseDir
  233.   Dim LenOfDstBaseDir
  234.   Dim strDstFolder
  235.   Dim strDstFile
  236.   Dim strSrcFile
  237.   Dim oFldr, oFile
  238.   Dim fc, f
  239.   oExplorer.Document.Write "Removing any extra backup files...<br>"
  240.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  241.   LenOfDstBaseDir = Len(DstFolder) + 1
  242.   For f = 0 to s
  243.     strDstFolder = DstFolder & Mid(arrSrcFolders(f), LenOfSrcBaseDir)
  244.     set fc = FSO.GetFolder(strDstFolder).Files
  245.     For Each oFile In fc
  246.       strDstFile = strDstFolder & IIf(f = 0, "", "\") & oFile.Name
  247.       strSrcFile = SrcFolder & Mid(strDstFile, LenOfDstBaseDir)
  248.       If (Not FSO.FileExists(strSrcFile)) And FSO.FileExists(strDstFile) Then
  249.         FSO.DeleteFile strDstFile,True
  250.       End If
  251.     Next
  252.   Next
  253.   Set fc    = Nothing
  254. End Sub
  255. Sub FindFilesNeedingBackup()
  256.   Dim LenOfSrcBaseDir
  257.   Dim strFrom
  258.   Dim strTo, f, fc, oFile
  259.   oExplorer.Document.Write "Determining which files to backup...<br>"
  260.   ReDim arrCopyFrom(100)
  261.   ReDim arrCopyTo(100)
  262.   ReDim arrSizes(100)
  263.   fMax = -1
  264.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  265.   arrSrcFolders(0) = SrcFolder
  266.   arrDstFolders(0) = DstFolder
  267.   For f = 0 To s
  268.     Set fc = FSO.GetFolder(arrSrcFolders(f)).Files
  269.     For Each oFile In fc
  270.       strFrom = arrSrcFolders(f) & "\" & oFile.Name
  271.       strTo   = DstFolder & Mid(strFrom, LenOfSrcBaseDir)
  272.       If Not FSO.FileExists(strTo) Then
  273.         AddToList strFrom, strTo, oFile.Size
  274.       Else
  275.         Set oDstFile = FSO.GetFile(strTo)
  276.         If FileIsNewer(oFile, oDstFile) Then
  277.           AddToList strFrom, strTo, oFile.Size
  278.         End If
  279.       End If
  280.     Next
  281.   Next
  282.   Set fc = Nothing
  283. End Sub
  284. Function FileIsNewer(Source, Dest)
  285.   FileIsNewer = False
  286.   If Source.DateLastModified > Dest.DateLastModified Then
  287.     FileIsNewer = True
  288.   End If
  289. End Function
  290. Sub AddToList(strFrom, strTo, FileSize)
  291.   Dim fCur
  292.   fCur = Ubound(arrCopyFrom)
  293.   fMax = fMax + 1
  294.   if fMax > fCur Then
  295.     ReDim Preserve arrCopyFrom(fCur + 100)
  296.     ReDim Preserve arrCopyTo(fCur + 100)
  297.     ReDim Preserve arrSizes(fCur + 100)
  298.   End If
  299.   arrCopyFrom(fMax) = strFrom
  300.   arrCopyTo(fMax)   = strTo
  301.   arrSizes(fMax)    = FileSize
  302.   TotalSize         = TotalSize + FileSize
  303. End Sub
  304. Sub CopySourceToDest()
  305.   Dim CurPercent, TotalCopied, myProgressIndicator, f
  306.   TotalCopied = 0
  307.   If fMax > -1 Then
  308.     If fMax = 0 Then
  309.       oExplorer.Document.Write "Backing up 1 file...<br>"
  310.     Else
  311.       oExplorer.Document.Write "Backing up " & fMax + 1 & " files...<br>"
  312.     End If
  313.     oexplorer.document.write "<div id='ProgressIndicator' style='background-color:blue;text-align:center; color:white;'></div>"
  314.     Set myProgressIndicator = oExplorer.Document.All("ProgressIndicator")
  315.     For f = 0 To fMax
  316.       If FSO.FileExists(arrCopyTo(f)) Then
  317.         FSO.DeleteFile arrCopyTo(f), True
  318.       End If
  319.       FSO.CopyFile arrCopyFrom(f), arrCopyTo(f)
  320.       TotalCopied = TotalCopied + arrSizes(f)
  321.       CurPercent  = CStr(Round(100 * TotalCopied / TotalSize)) & "%"
  322.       ' Set the current progress indicator
  323.       myProgressIndicator.innerHTML = CurPercent
  324.       myProgressIndicator.style.width = CurPercent
  325.     Next
  326.   Else
  327.     oExplorer.Document.Write "No files need to be backed up...<br>"
  328.   End If
  329. End Sub
  330. Function IIf( expr, truepart, falsepart )
  331.   If expr Then
  332.     IIf = truepart
  333.   Else
  334.     IIf = falsepart
  335.   End If
  336. End Function
  337. Sub QuitScript()
  338.   oExplorer.Quit
  339.   Set oExplorer = Nothing
  340.   Set FSO       = Nothing
  341.   Wscript.Quit
  342. End Sub
  343. Sub ShowSyntax()
  344.   Wscript.Echo "Sync.vbs [/S:]<source> [/D:]<destination> [/RD] [/RF] [/C] [/T:<num>]          "
  345.   Wscript.Echo "                                                                               "
  346.   Wscript.Echo "  All switches are case insensitive as well as 'order insensitive'.  Directory "
  347.   Wscript.Echo "  names with embedded spaces are supported either with or without surrounding  "
  348.   Wscript.Echo "  quotes (single or double), however, if they contain multiple adjacent spaces "
  349.   Wscript.Echo "  they must be quoted.  Spaces after the ':' are ignored.                      "
  350.   Wscript.Echo "                                                                               "
  351.   Wscript.Echo "  /RD specifies to remove extraneous directories (folders) from the            "
  352.   Wscript.Echo "      destination path if found.                                               "
  353.   Wscript.Echo "                                                                               "
  354.   Wscript.Echo "  /RF specifies to remove extraneous files from the destination path if found. "
  355.   Wscript.Echo "                                                                               "
  356.   Wscript.Echo "  /C  Equivalent to specifying /RD and /RF on the command line.                "
  357.   Wscript.Echo "                                                                               "
  358.   Wscript.Echo "  /T:<num> Optional switch to specify number of seconds to leave final         "
  359.   Wscript.Echo "           screen display visible. Defaults to 10 seconds if not specified.    "
  360.   Wscript.Echo "                                                                               "
  361.   Wscript.Echo "  The /S: and /D: switches are optional.  When not used, the first parameter   "
  362.   Wscript.Echo "  on the command line not preceded by '/' will be taken as the source path and "
  363.   Wscript.Echo "  the second parameter not preceded by '/' will be taken as the destination    "
  364.   Wscript.Echo "  path.                                                                        "
  365.   Wscript.Echo "                                                                               "
  366.   Wscript.Echo "  The use of the '-' character in lieu of '/' is not supported.                "
  367.   Wscript.Echo "                                                                               "
  368. End Sub
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

感谢分享!

TOP

也许要用到才有耐心看

QQ 20147578

TOP

这个我修改后的版本(去掉原版的IE GUI):
sync.vbs
  1. ' VBS 同步文件夹
  2. ' 功能:  同步文件夹,只同步已修改(或新增)的文件及文件夹,支持删除冗余(目标文件夹中存在,源文件夹不存在)文件及文件夹
  3. ' 参数:  sync.vbs  [/RD]  [/RF]  [/C]  <sourcePath>  <destinationPath>
  4. '   sourcePath  源文件夹
  5. '   destinationPath  目标文件夹
  6. '   /RD 删除目标文件夹中多余的文件夹;
  7. '   /RF 删除目标文件夹中多余的文件;
  8. '   /C  等于同时使用 /RD /RF 参数
  9. ' 源代码下载:  http://www.robotii.co.uk/wp-content/uploads/2008/10/sync.vbs
  10. ' 个人说明:  此脚本是我使用过的同步脚本中效率及兼容性最高的。
  11. ' Download:  http://www.robotii.co.uk/wp-content/uploads/2008/10/sync.vbs
  12. '**********************************************************************
  13. ' sync.vbs
  14. '
  15. ' This script makes a "synchronised" backup of a folder tree from one
  16. ' path to another.
  17. '
  18. ' Extraneous directories (folders) may be removed from the destination
  19. ' tree by specifying the /RD switch on the command line.  These are
  20. ' directories already existing in the destination tree but no longer
  21. ' found in the source tree.
  22. '
  23. ' Extraneous files may be removed from the destination tree by specifying
  24. ' the /RF switch on the command line.  These are files which exist in
  25. ' destination directories but not in source directories.
  26. '
  27. ' Both extraneous directories and files can be removed by specifying the
  28. ' /C switch on the command line. This switch is equivalent to specifying
  29. ' both the /RD and /RF switches
  30. '
  31. ' Usage:  sync.vbs <sourcePath> <destinationPath>
  32. '    or:  cscript /nologo sync.vbs <sourcePath> <destinationPath>
  33. '    or:  wscript /nologo sync.vbs <sourcePath> <destinationPath>
  34. '
  35. ' Notes:  Paths can use drive letters or UNC specifications.
  36. '
  37. '**********************************************************************
  38. CmdMode "sync folder", "1f"
  39. Dim oArgs
  40. Dim TempArg
  41. Dim bRemoveFolders
  42. Dim bRemoveFiles
  43. Dim SleepTime
  44. Dim SrcFolder
  45. Dim arrSrcFolders()
  46. Dim s
  47. Dim DstFolder
  48. Dim arrDstFolders()
  49. Dim d
  50. Dim arrCopyFrom()
  51. Dim arrCopyTo()
  52. Dim arrSizes()
  53. Dim fMax
  54. Dim TotalSize
  55. Dim oExplorer
  56. Dim FSO
  57. On Error Resume Next
  58.   bRemoveFolders = False
  59.   bRemoveFiles   = False
  60.   SleepTime      = 10    ' default to leaving display onscreen for 10 seconds
  61.   Set oArgs = WScript.Arguments
  62.   For s = 0 To oArgs.Count - 1
  63.     TempArg = Ucase(Left(oArgs(s),3))
  64.     Select Case TempArg
  65.       Case "/?"
  66.             ShowSyntax()
  67.             QuitScript()
  68.             'Wscript.Quit
  69.       Case "/S:"
  70.             SrcFolder = Trim(Mid(oArgs(s),4))
  71.       Case "/D:"
  72.             DstFolder = Trim(Mid(oArgs(s),4))
  73.       Case "/RD"
  74.             bRemoveFolders = True
  75.       Case "/RF"
  76.             bRemoveFiles = True
  77.       Case "/C"
  78.             bRemoveFiles = True
  79.             bRemoveFolders = True
  80.       Case "/T:"
  81.             SleepTime = Cint(Mid(oArgs(s),4))
  82.             If SleepTime < 0 Then
  83.               SleepTime = 0
  84.             End If
  85.       Case Else
  86.             If Left(oArgs(s),1) <> "/" Then
  87.               If SrcFolder = "" Then
  88.                 SrcFolder = oArgs(s)
  89.               ElseIf DstFolder = "" Then
  90.                 DstFolder = oArgs(s)
  91.               Else
  92.                 Wscript.Echo "Unknown parameter on command line... " & oArgs(s)
  93.                 ShowSyntax()
  94.                 QuitScript()
  95.                 'Wscript.Quit
  96.               End If
  97.             End If
  98.     End Select
  99.   Next
  100.   If SrcFolder = "" or DstFolder = "" Then
  101.     Wscript.Echo "You must enter a 'SourcePath' and 'DestinationPath' when starting this script."
  102.     ShowSyntax()
  103.     QuitScript()
  104.     'Wscript.Quit
  105.   Else
  106.     echo "Source      : " & SrcFolder & VbCrLf & _
  107.          "Destination : " & DstFolder & VbCrLf
  108.   End If
  109.   If Right(SrcFolder,1) <> "\" Then
  110.     SrcFolder = SrcFolder & "\"
  111.   End If
  112.   If Right(DstFolder,1) <> "\" Then
  113.     DstFolder = DstFolder & "\"
  114.   End If
  115.   If InStr(LCase(SrcFolder),LCase(DstFolder)) > 0 _
  116.   Or InStr(LCase(DstFolder),LCase(SrcFolder)) > 0  Then
  117.     Wscript.Echo "The 'SourcePath' and 'DestinationPath' cannot overlap!"
  118.     Wscript.Quit
  119.   End If
  120.   TotalSize = 0
  121.   Set FSO = CreateObject("Scripting.FileSystemObject")
  122.   'Set oExplorer = CreateObject("InternetExplorer.Application")
  123.   'oExplorer.Navigate2 "about:blank"
  124.   'oExplorer.Width     = 550
  125.   'oExplorer.Height    = 300
  126.   'oExplorer.Top       = 300
  127.   'oExplorer.Left      = 300
  128.   'oExplorer.Toolbar   = False
  129.   'oExplorer.Menubar   = False
  130.   'oExplorer.Statusbar = False
  131.   'oExplorer.Visible   = True
  132.   'oExplorer.Document.Write "<font face=Verdana>"
  133.   'oExplorer.Document.Write "<h2>File Backup in Progress</h2>"
  134.   'oExplorer.Document.Write "<p>Beginning backup...<br>"
  135.   'oExplorer.Document.Title = "Please be patient.... "
  136.   
  137.   echo "File Backup in Progress" & VbCrLf
  138.   echo "Beginning backup..." & VbCrLf
  139.   echo "Please be patient.... " & VbCrLf
  140.   GetSrcInfo
  141.   GetDstInfo
  142.   CreateMissingFolders
  143.   If bRemoveFolders Then
  144.     DeleteExtraFolders
  145.   End If
  146.   If bRemoveFiles Then
  147.     DeleteExtraFiles
  148.   End If
  149.   FindFilesNeedingBackup
  150.   CopySourceToDest
  151.   
  152.   'oExplorer.document.write "<font color=red>"
  153.   'oExplorer.Document.Write "  Finished!<br>"
  154.   
  155.   echo "Finished!" & VbCrLf
  156.   QuitScript()
  157. Sub GetSrcInfo()
  158.   'oExplorer.Document.Write "Analyzing source directories...<br>"
  159.   echo "Analyzing source directories..." & VbCrLf
  160.   '-- get information about source directories
  161.   If FSO.FolderExists(SrcFolder) Then
  162.     ReDim arrSrcFolders(100)
  163.     s = 0
  164.     arrSrcFolders(0) = Left(SrcFolder, Len(SrcFolder) - 1)
  165.     GetSrcFolders FSO.GetFolder(SrcFolder)
  166.     ReDim Preserve arrSrcFolders(s)
  167.   Else
  168.     Wscript.Echo "Source folder not found... aborting."
  169.     QuitScript()
  170.   End If
  171. End Sub
  172. Sub GetSrcFolders(Folder)
  173.   Dim Subfolder
  174.   For Each Subfolder In Folder.SubFolders
  175.     s = s + 1
  176.     If s > Ubound(arrSrcFolders) Then
  177.       ReDim Preserve arrSrcFolders(Ubound(arrSrcFolders) + 100)
  178.     End If
  179.     arrSrcFolders(s) = SubFolder.Path
  180.     GetSrcFolders Subfolder
  181.   Next
  182. End Sub
  183. Sub GetDstInfo()
  184.   'oExplorer.Document.Write "Analyzing backup directories...<br>"
  185.   echo "Analyzing backup directories..." & VbCrLf
  186.   '-- get information about destination directories
  187.   If Not FSO.FolderExists(DstFolder) Then
  188.     CreateMultiLevelFolder DstFolder
  189.   End If
  190.   ReDim arrDstFolders(100)
  191.   d = 0
  192.   arrDstFolders(0) = Left(DstFolder, Len(DstFolder) - 1)
  193.   GetDstFolders FSO.GetFolder(DstFolder)
  194.   ReDim Preserve arrDstFolders(d)
  195. End Sub
  196. Sub CreateMultiLevelFolder(FolderPath)
  197. Dim TempPath
  198. Dim Path
  199. Dim arrNodes
  200. Dim n
  201.   TempPath = FolderPath
  202.   Path = ""
  203.   ' See if input is in UNC format...
  204.   If Instr(TempPath,"\\") > 0 Then
  205.     TempPath = Mid(TempPath,3)
  206.     n = Instr(TempPath,"\")
  207.     Path = "\\" & Left(TempPath,n)
  208.     TempPath = Mid(TempPath,n+1)
  209.   End If
  210.   arrNodes = Split(TempPath,"\")
  211.   Path     = Path & arrNodes(0)
  212.   For n = 1 To UBound(arrNodes)
  213.     Path = Path & "\" & arrNodes(n)
  214.     If Not FSO.FolderExists(Path) Then
  215.       FSO.CreateFolder(Path)
  216.     End If
  217.   Next
  218. End Sub
  219. Sub GetDstFolders(Folder)
  220.   Dim Subfolder
  221.   For Each Subfolder In Folder.SubFolders
  222.     d = d + 1
  223.     If d > Ubound(arrDstFolders) Then
  224.       ReDim Preserve arrDstFolders(Ubound(arrDstFolders) + 100)
  225.     End If
  226.     arrDstFolders(d) = SubFolder.Path
  227.     GetDstFolders Subfolder
  228.   Next
  229. End Sub
  230. Sub CreateMissingFolders()
  231.   Dim LenOfSrcBaseDir
  232.   Dim strFolder, f
  233.   'oExplorer.Document.Write "Creating any missing backup directories...<br>"
  234.   echo "Creating any missing backup directories..." & VbCrLf
  235.   
  236.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  237.   For f = 0 to s
  238.     strFolder = DstFolder & Mid(arrSrcFolders(f), LenOfSrcBaseDir)
  239.     If Not FSO.FolderExists(strFolder) Then
  240.       FSO.CreateFolder(strFolder)
  241.     End IF
  242.   Next
  243. End Sub
  244. Sub DeleteExtraFolders()
  245.   Dim LenOfDstBaseDir
  246.   Dim strFolder, f
  247.   'oExplorer.Document.Write "Removing any extra backup directories...<br>"
  248.   echo "Removing any extra backup directories..." & VbCrLf
  249.   
  250.   LenOfDstBaseDir = Len(DstFolder) + 1
  251.   For f = 0 To d
  252.     strFolder = SrcFolder & Mid(arrDstFolders(f), LenOfDstBaseDir)
  253.     If (Not FSO.FolderExists(strFolder)) Then
  254.       FSO.DeleteFolder arrDstFolders(f),True
  255.     End IF
  256.   Next
  257. End Sub
  258. Sub DeleteExtraFiles()
  259.   Dim LenOfSrcBaseDir
  260.   Dim LenOfDstBaseDir
  261.   Dim strDstFolder
  262.   Dim strDstFile
  263.   Dim strSrcFile
  264.   Dim oFldr, oFile
  265.   Dim fc, f
  266.   'oExplorer.Document.Write "Removing any extra backup files...<br>"
  267.   echo "Removing any extra backup files..." & VbCrLf
  268.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  269.   LenOfDstBaseDir = Len(DstFolder) + 1
  270.   For f = 0 to s
  271.     strDstFolder = DstFolder & Mid(arrSrcFolders(f), LenOfSrcBaseDir)
  272.     set fc = FSO.GetFolder(strDstFolder).Files
  273.     For Each oFile In fc
  274.       strDstFile = strDstFolder & IIf(f = 0, "", "\") & oFile.Name
  275.       strSrcFile = SrcFolder & Mid(strDstFile, LenOfDstBaseDir)
  276.       If (Not FSO.FileExists(strSrcFile)) And FSO.FileExists(strDstFile) Then
  277.         FSO.DeleteFile strDstFile,True
  278.       End If
  279.     Next
  280.   Next
  281.   Set fc    = Nothing
  282. End Sub
  283. Sub FindFilesNeedingBackup()
  284.   Dim LenOfSrcBaseDir
  285.   Dim strFrom
  286.   Dim strTo, f, fc, oFile
  287.   'oExplorer.Document.Write "Determining which files to backup...<br>"
  288.   echo "Determining which files to backup..." & VbCrLf
  289.   
  290.   ReDim arrCopyFrom(100)
  291.   ReDim arrCopyTo(100)
  292.   ReDim arrSizes(100)
  293.   fMax = -1
  294.   LenOfSrcBaseDir = Len(SrcFolder) + 1
  295.   arrSrcFolders(0) = SrcFolder
  296.   arrDstFolders(0) = DstFolder
  297.   For f = 0 To s
  298.     Set fc = FSO.GetFolder(arrSrcFolders(f)).Files
  299.     For Each oFile In fc
  300.       strFrom = arrSrcFolders(f) & "\" & oFile.Name
  301.       strTo   = DstFolder & Mid(strFrom, LenOfSrcBaseDir)
  302.       If Not FSO.FileExists(strTo) Then
  303.         AddToList strFrom, strTo, oFile.Size
  304.       Else
  305.         Set oDstFile = FSO.GetFile(strTo)
  306.         If FileIsNewer(oFile, oDstFile) Then
  307.           AddToList strFrom, strTo, oFile.Size
  308.         End If
  309.       End If
  310.     Next
  311.   Next
  312.   Set fc = Nothing
  313. End Sub
  314. Function FileIsNewer(Source, Dest)
  315.   FileIsNewer = False
  316.   If Source.DateLastModified > Dest.DateLastModified Then
  317.     FileIsNewer = True
  318.   End If
  319. End Function
  320. Sub AddToList(strFrom, strTo, FileSize)
  321.   Dim fCur
  322.   fCur = Ubound(arrCopyFrom)
  323.   fMax = fMax + 1
  324.   if fMax > fCur Then
  325.     ReDim Preserve arrCopyFrom(fCur + 100)
  326.     ReDim Preserve arrCopyTo(fCur + 100)
  327.     ReDim Preserve arrSizes(fCur + 100)
  328.   End If
  329.   arrCopyFrom(fMax) = strFrom
  330.   arrCopyTo(fMax)   = strTo
  331.   arrSizes(fMax)    = FileSize
  332.   TotalSize         = TotalSize + FileSize
  333. End Sub
  334. Sub CopySourceToDest()
  335.   Dim CurPercent, TotalCopied, myProgressIndicator, f
  336.   TotalCopied = 0
  337.   If fMax > -1 Then
  338.     If fMax = 0 Then
  339.       'oExplorer.Document.Write "Backing up 1 file...<br>"
  340.       echo "Backing up 1 file..." & VbCrLf
  341.     Else
  342.       'oExplorer.Document.Write "Backing up " & fMax + 1 & " files...<br>"
  343.       echo "Backing up " & fMax + 1 & " files... "
  344.     End If
  345.     'oexplorer.document.write "<div id='ProgressIndicator' style='background-color:blue;text-align:center; color:white;'></div>"
  346.     'Set myProgressIndicator = oExplorer.Document.All("ProgressIndicator")
  347.     For f = 0 To fMax
  348.       echo String(Len(CurPercent), Chr(8))
  349.       If FSO.FileExists(arrCopyTo(f)) Then
  350.         FSO.DeleteFile arrCopyTo(f), True
  351.       End If
  352.       FSO.CopyFile arrCopyFrom(f), arrCopyTo(f)
  353.       TotalCopied = TotalCopied + arrSizes(f)
  354.       CurPercent  = CStr(Round(100 * TotalCopied / TotalSize)) & "%"
  355.       ' Set the current progress indicator
  356.       'myProgressIndicator.innerHTML = CurPercent
  357.       'myProgressIndicator.style.width = CurPercent
  358.       echo CurPercent
  359.     Next
  360.     echo VbCrLf
  361.   Else
  362.     'oExplorer.Document.Write "No files need to be backed up...<br>"
  363.     echo "No files need to be backed up..." & VbCrLf
  364.   End If
  365. End Sub
  366. Function IIf( expr, truepart, falsepart )
  367.   If expr Then
  368.     IIf = truepart
  369.   Else
  370.     IIf = falsepart
  371.   End If
  372. End Function
  373. Sub QuitScript()
  374.   'oExplorer.Quit
  375.   'Set oExplorer = Nothing
  376.   Set FSO       = Nothing
  377.   
  378.   If SleepTime = "" Then
  379.     Pause " > Press enter to quit ... "
  380.   Else
  381.   'If SleepTime > 0 Then
  382.     Wscript.Sleep (SleepTime * 1000)
  383.   End If
  384.   
  385.   Wscript.Quit
  386. End Sub
  387. Sub ShowSyntax()
  388.   Wscript.Echo "Sync.vbs [/S:]<source> [/D:]<destination> [/RD] [/RF] [/C] [/T:<num>]          "
  389.   Wscript.Echo "                                                                               "
  390.   Wscript.Echo "  All switches are case insensitive as well as 'order insensitive'.  Directory "
  391.   Wscript.Echo "  names with embedded spaces are supported either with or without surrounding  "
  392.   Wscript.Echo "  quotes (single or double), however, if they contain multiple adjacent spaces "
  393.   Wscript.Echo "  they must be quoted.  Spaces after the ':' are ignored.                      "
  394.   Wscript.Echo "                                                                               "
  395.   Wscript.Echo "  /RD specifies to remove extraneous directories (folders) from the            "
  396.   Wscript.Echo "      destination path if found.                                               "
  397.   Wscript.Echo "                                                                               "
  398.   Wscript.Echo "  /RF specifies to remove extraneous files from the destination path if found. "
  399.   Wscript.Echo "                                                                               "
  400.   Wscript.Echo "  /C  Equivalent to specifying /RD and /RF on the command line.                "
  401.   Wscript.Echo "                                                                               "
  402.   Wscript.Echo "  /T:<num> Optional switch to specify number of seconds to leave final         "
  403.   Wscript.Echo "           screen display visible. Defaults to 10 seconds if not specified.    "
  404.   Wscript.Echo "                                                                               "
  405.   Wscript.Echo "  The /S: and /D: switches are optional.  When not used, the first parameter   "
  406.   Wscript.Echo "  on the command line not preceded by '/' will be taken as the source path and "
  407.   Wscript.Echo "  the second parameter not preceded by '/' will be taken as the destination    "
  408.   Wscript.Echo "  path.                                                                        "
  409.   Wscript.Echo "                                                                               "
  410.   Wscript.Echo "  The use of the '-' character in lieu of '/' is not supported.                "
  411.   Wscript.Echo "                                                                               "
  412. End Sub
  413. ' ====================================================================================================
  414. ' CMD 命令集
  415. ' ----------------------------------------------------------------------------------------------------
  416. ' ----------------------------------------------------------------------------------------------------
  417. ' 强制以命令行模式运行
  418. Function CmdMode(ByVal title,ByVal color)
  419.     If LCase(Right(WScript.FullName,11))="wscript.exe" Then
  420.         Set oArgs = WScript.Arguments
  421.         For s = 0 To oArgs.Count - 1
  422.             strArgs = strArgs & " """ & Trim(oArgs(s)) & """ "
  423.         Next
  424.         With CreateObject("Wscript.Shell")
  425.             .Run "cmd /c title "&title&"&color "&color&"&Cscript //Nologo """ & WScript.ScriptFullName & """ " & strArgs, 1, False
  426.             '.Run "taskkill /f /im cmd.exe",0
  427.         End With
  428.         WScript.Quit
  429.     End If
  430. End Function
  431. ' 检测是否运行于CMD模式
  432. Function IsCmdMode()
  433.     IsCmdMode = False
  434.     If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then IsCmdMode = True
  435. End Function
  436. ' 获取CMD输出
  437. Function CmdOut( ByVal strCmd)
  438.     If IsCmdMode() = False Then Exit Function
  439.     Set ws = CreateObject("WScript.Shell")
  440.     Set oexec = ws.Exec( strCmd )
  441.     pid = oExec.ProcessId
  442.     CmdOut = oExec.StdOut.ReadAll
  443. End Function
  444. ' 输出消息
  445. Sub Echo( ByVal strOutput )
  446.     If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  447. WScript.StdOut.Write strOutput
  448.     End If
  449. End Sub
  450. ' 暂停函数
  451. Function Pause( ByVal strMsg )
  452.     If (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  453.         WScript.StdOut.Write VbCrLf & strMsg
  454.         Pause = WScript.StdIn.ReadLine
  455.     End If
  456. End Function
  457. ' 读取输入,相当于Set/p p=
  458. Function ReadInput( ByVal strEnquiry )
  459. If IsCmdMode() = True Then
  460.         WScript.StdOut.Write strEnquiry
  461.         ReadInput = Trim( WScript.StdIn.ReadLine )
  462.     Else
  463.         ReadInput = Trim( Inputbox( strEnquiry, "请输入:", "" ) )
  464.     End If
  465. End Function
复制代码
还有配套的 Sync-Explorer.vbs (与 sync.vbs 同文件夹才可用 ),方便使用。
  1. 'On Error Resume Next
  2. ' 取得当前路径
  3. Dim MeDir, MeName
  4. MeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)                                ' 脚本所在文件夹路径
  5. ' 检测是否重复运行
  6. If MeIsAlreadyRun() = True Then
  7.     REM CreateObject("WScript.Shell").popup VbCrLf & "程序 " & AppFile & " 已运行。    " & VbCrLf, 1, "提示", 0+48
  8.     WScript.Quit(999)
  9. End If
  10. ' 是否使用脚本所在目录作为源
  11. Dim choice
  12. choice = msgbox( VbCrLf & "来源文件夹:" & MeDir & " (本程序位置)  " & VbCrLf & VbCrLf & "是否确认?" & VbCrLf & VbCrLf, _
  13.                 vbYesNoCancel + 64, _
  14.                 "文件夹同步 - Foler Sync")
  15. Select Case choice
  16.     Case vbYes
  17.         folder_src = MeDir
  18.         folder_des = BrowseFolder(  "来源文件夹:" & folder_src & VbCrLf & _
  19.                                     "目标文件夹:请选择一个目标文件夹的位置" _
  20.                                     , "", True )
  21.         If folder_des = "" Then QuitScript(1001)
  22.     Case vbNo
  23.         folder_src = BrowseFolder( "来源文件夹:请选择一个来源文件夹的位置" & VbCrLf _
  24.                                   , "", True )
  25.         If folder_src = "" Then QuitScript(1002)
  26.         folder_des = BrowseFolder( "来源文件夹:" & folder_src & VbCrLf & _
  27.                                     "目标文件夹:请选择一个目标文件夹的位置" _
  28.                                     , "", True )
  29.         If folder_des = "" Then QuitScript(1003)
  30.     Case vbCancel
  31.         QuitScript(1004)
  32. End Select
  33. ' 确认同步
  34. choice = msgbox( VbCrLf & "来源文件夹: " & folder_src & "  " & VbCrLf & VbCrLf & _
  35.                     " 同步至  " & VbCrLf & VbCrLf & _
  36.                     "目标文件夹: " & folder_des & "  " & VbCrLf & VbCrLf & VbCrLf &  _
  37.                     "是否确认?" & VbCrLf, _
  38.                 vbYesNoCancel + 64, _
  39.                 "文件夹同步 - Foler Sync")
  40. If Not choice = vbYes Then QuitScript(1005)
  41. ' 打开同步脚本 .\sync.vbs
  42. CreateObject("WScript.Shell").Run """" & MeDir & "\sync.vbs"" """ & folder_src & """ """ & folder_des & """ ""/C""" , 1, False
  43. ' 退出
  44. QuitScript(0)
  45. ' 退出程序
  46. Function QuitScript(ErrorNum)
  47.     WScript.Quit(ErrorNum)
  48. End Function
  49. ' 检测自身是否重复运行
  50. Function MeIsAlreadyRun()
  51.     MeIsAlreadyRun = False
  52.     If (IsRun(LCase(Right(WScript.FullName,11)), WScript.ScriptFullName) > 1) Then MeIsAlreadyRun = True
  53. End Function
  54. ' 检测是否运行
  55. Function IsRun(byVal AppName, byVal AppPath)   ' Eg: Call IsRun("mshta.exe", "c:\test.hta")
  56.     IsRun = 0 : i = 0
  57.     For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  58.         IF LCase(ps.name) = LCase(AppName) Then
  59.             If AppPath = "" Then IsRun = 1 : Exit Function
  60.             IF Instr( LCase(ps.CommandLine) , LCase(AppPath) ) Then i = i + 1
  61.         End IF
  62.     Next
  63.     IsRun = i
  64. End Function
  65. ' http://www.robvanderwoude.com/vbstech_ui_browsefolder.php
  66. ' BrowseFolder( "源文件夹:请选择一个来源文件夹的位置", "D:\", True )
  67. Function BrowseFolder( strPrompt, myStartLocation, blnSimpleDialog )
  68. ' This function generates a Browse Folder dialog
  69. ' and returns the selected folder as a string.
  70. '
  71. ' Arguments:
  72. ' myStartLocation   [string]  start folder for dialog, or "My Computer", or
  73. '                             empty string to open in "Desktop\My Documents"
  74. ' blnSimpleDialog   [boolean] if False, an additional text field will be
  75. '                             displayed where the folder can be selected
  76. '                             by typing the fully qualified path
  77. '
  78. ' Returns:          [string]  the fully qualified path to the selected folder
  79. '
  80. ' Based on the Hey Scripting Guys article
  81. ' "How Can I Show Users a Dialog Box That Only Lets Them Select Folders?"
  82. ' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
  83. '
  84. ' Function written by Rob van der Woude
  85. ' http://www.robvanderwoude.com
  86.      Const MY_COMPUTER   = &H11&
  87.      Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
  88.      Dim numOptions, objFolder, objFolderItem
  89.      Dim objPath, objShell, strPath ', strPrompt
  90.      ' Set the options for the dialog window
  91.      'strPrompt = "Select a folder:"
  92.      If blnSimpleDialog = True Then
  93.          numOptions = 0      ' Simple dialog
  94.      Else
  95.          numOptions = &H10&  ' Additional text field to type folder path
  96.      End If
  97.      
  98.      ' Create a Windows Shell object
  99.      Set objShell = CreateObject( "Shell.Application" )
  100.      ' If specified, convert "My Computer" to a valid
  101.      ' path for the Windows Shell's BrowseFolder method
  102.      If UCase( myStartLocation ) = "MY COMPUTER" Then
  103.          Set objFolder = objShell.Namespace( MY_COMPUTER )
  104.          Set objFolderItem = objFolder.Self
  105.          strPath = objFolderItem.Path
  106.      Else
  107.          strPath = myStartLocation
  108.      End If
  109.      Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
  110.                                                numOptions, strPath )
  111.      ' Quit if no folder was selected
  112.      If objFolder Is Nothing Then
  113.          BrowseFolder = ""
  114.          Exit Function
  115.      End If
  116.      ' Retrieve the path of the selected folder
  117.      Set objFolderItem = objFolder.Self
  118.      objPath = objFolderItem.Path
  119.      ' Return the path of the selected folder
  120.      BrowseFolder = objPath
  121. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

回复 1# yu2n


    这个怎么使用呀?点了什么反应都没,也不懂得哪里设定文件夹??

TOP

回复 5# ww0000


    命令行用法:
sync.vbs  [/RD]  [/RF]  [/C]  <sourcePath>  <destinationPath>
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

谢谢分享!

TOP

返回列表