我已经将一些非常有趣的代码整理到一起来压缩多个文件和文件夹。
该脚本将获取一个参数列表（文件和文件夹），并将它们拉为zip，并以日期/时间作为名称。
所以我需要一些在参数是文件时执行的代码。代码应该将文件的目录结构添加到zip文件中。
'=================== THE SCRIPT =====================================
'Get command-line arguments.
Set objArgs = WScript.Arguments
Set objShell = CreateObject("Shell.Application")
'
'C:\DateYYYY-MM-DD_TimeHH-MM-SS.zip
ZipFile = "C:\DateYYYY-MM-DD_TimeHH-MM-SS.zip"
'Create empty ZIP file.
CreateObject("Scripting.FileSystemObject").CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Set zip = objShell.NameSpace(ZipFile)
'
for i = 0 To objArgs.Count-1
On Error Resume Next
IF fnFileExists( objArgs(i) ) OR (NOT fnFolderIsEmpty( objArgs(i) )) THEN
'WScript.Echo "Copying - " & objArgs(i)
IF fnFileExists( objArgs(i) ) THEN
'??? Code/Function/CopyHere[option] to create a directory structure in zip and copy objArgs(i) file into it
End If
zip.CopyHere( objArgs(i) )
Else
WScript.Echo "Empty or !Exist - " & objArgs(i)
End If
Do
wScript.Sleep 200
Loop Until objShell.NameSpace(zip).Items.Count >= i
Next
WScript.Echo "THE END"
fnFileExists()函数仅在文件存在时返回TRUE（如果文件夹或文件不存在，则FALSE。）
如果文件夹为空或不存在，fnFolderIsEmpty()函数将返回TRUE。
给出这样的电话：
"wscript zip.vbs "c:\Folder1\" "c:\Folder2\Sub2-1\" "c:\Windows\System32\TestFile0.txt"
文件夹是这样的：
\Folder1\
└──TestFile1.txt
└──TestFile2.txt
\Folder2\
└──\Sub2-1\
└──TestFile3.txt
└──TestFile4.txt
\Windows\
└──\System32\
└──TestFile0.txt
└──\Sub3-2\
└──TestFoo.txt
我得到一个像这样的结构的zip文件：
\Folder1\
└──TestFile1.txt
└──TestFile2.txt
\Sub2-1\
└──TestFile3.txt
└──TestFile4.txt
\TestFile0.txt
这就是我想要的样子：
\Folder1\
└──TestFile1.txt
└──TestFile2.txt
\Folder2\
└──\Sub2-1\
└──TestFile3.txt
└──TestFile4.txt
\Windows\
└──\System32\
└──TestFile0.txt
我确实找到了以下内容，但我不知道Java是如何转换为VBScript的：
java.util.zip - Recreating directory structure
-AND-
Zipping files preserving the directory structure
答案 0 :(得分：0)
好的，这是。 对于每个单独的文件，我将它放在临时文件夹（“C：\ xxMisc”）中，在temp文件夹下创建完整路径。然后我压缩temp文件夹中的所有文件夹。适用于我的目的。
e.g。如果我需要压缩“c：\ windows \ system32 \ bob.dll”
我会创建一个路径\文件“c：\ xxMisc \ windows \ system32 \”＆amp;将bob.dll复制到其中。
然后致电：zip.MoveHere( "c:\xxMisc\Windows" );
结果是zip文件将包含一个“\ windows \”目录，其中包含所有子目录（和文件）。
用法： wscript <script.vbs> [/x] <FullPath[FileName]>
[]参数是可选的。外卡不起作用。用'\'结束完整路径。 “/ x”将显示IE调试窗口
wscript script.vbs /X "C:\My Path\" "c:\windows\system32\bob.dll"
结果： zip文件位于“c：\”，它将包含整个目录“c：\ My Path \”（包括文件和子目录）和“\ windows \ system32 \”中的bob.dll “目录路径。
这是代码。
IF WScript.Arguments.Count = 0 THEN
WSCript.Quit
END IF
Dim objIEDebugWindow
sTempFolderName = "C:\xxMisc" 'Where individual files go
iBeforeCopy = 0 'Value to detect when a move/copy is complete
bDebug = FALSE 'Debug Flag
i = 0 'Index through the objArgs()
'Get command-line arguments.
Set objArgs = wScript.Arguments
'General objects
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Detect Debug Command Line Argument | MUST be FIRST Argument
IF UCase( objArgs( 0 ) ) = "/X" THEN
bDebug = TRUE
i = 1 'Change Which Index objArgs() to start looking for files/folders
END IF
'Test to see if Windows Script Host is >= 2.0
fnCheckWSHversion( 2000 )
'Create empty ZIP file.
'C:\DateYYYY-MM-DD_TimeHH-MM-SS.zip
ZipFile = "C:\Date" & Year(Date) & "-" & Right("0" & Month(Date),2) & "-" & Right("0" & Day(Date),2) & "_Time" & Right("0" & Hour(now), 2) & "-" & Right("0" & Minute(now), 2) & "-" & Right("0" & Second(now), 2) & ".zip"
CreateObject("Scripting.FileSystemObject").CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Set zip = objShell.NameSpace(ZipFile)
CALL Debug ( objArgs.Count )
'Iterate through the command line arguments
for i = i To objArgs.Count-1
CALL Debug( "Processing objArgs = " & i & "| " & objArgs(i) )
IF FileExists( objArgs(i) ) OR (NOT fnFolderIsEmpty( objArgs(i) )) THEN
IF FileExists( objArgs(i) ) THEN
'IT'S A FILE
CALL Debug( "Copying File - " & objArgs(i) )
CALL fnMakeTempFile( sTempFolderName, objArgs( i ) )
Else 'IT'S A FOLDER
CALL Debug( "Copying Folder - " & objArgs(i) )
iBeforeCopy = objShell.NameSpace(zip).Items.Count
zip.CopyHere( objArgs(i) )
'Wait until copy is done (Items.Count goes up)
Do
wScript.Sleep 200
Loop Until objShell.NameSpace(zip).Items.Count > iBeforeCopy
End If
Else
CALL Debug( "Empty or !Exist - " & objArgs(i) )
End If
Next
IF (NOT fnFolderIsEmpty( "c:\xxMisc" )) THEN 'Just in case no FILES were backed up
'Get ArrayList of Temp Folders
Set arrDirs = fnListDirIn( "c:\xxMisc" )
CALL Debug( "Copying sTempFolder" )
For Each sFolderName in arrDirs
CALL Debug( "sFolderName=" & sFolderName )
iBeforeCopy = objShell.NameSpace(zip).Items.Count
zip.MoveHere( sFolderName )
'Wait until copy is done (Items.Count goes up)
Do
wScript.Sleep 200
Loop Until objShell.NameSpace(zip).Items.Count > iBeforeCopy
Next
CALL Debug( "COPY DONE!" )
CALL Debug( "Deleting sTempFolderName = " & sTempFolderName )
objFSO.DeleteFolder sTempFolderName, TRUE
'Wait until folder is finished deleting; because MoveHere doesn't MOVE
While objFSO.FolderExists( sTempFolderName )
wScript.Sleep 200
Wend
END IF
CALL Debug( "THE END" )
CALL MsgBox( "Backup Complete", vbOKOnly+vbInformation, "My Backup" )
Set objArgs = Nothing
Set objShell = Nothing
Set objFSO = Nothing
Set zip = Nothing
wScript.Quit
' ----------------------------------------------
'END MAIN
' ----------------------------------------------
' ----------------------------------------------
'Copies sFileName into a temporary directory specified by sTempFolder
' e.g.:
' sTempFolder = "C:\Temp\"
' sFileName = "c:\Windows\System32\bob.ocx"
' results is the creation of "C:\Temp\Windows\System32\bob.ocx"
'-Uses fnCreatePath()
'-No Return
Function fnMakeTempFile( ByVal sTempFolder, sFileName )
IF Right( sTempFolder, 1 ) <> "\" THEN
sTempFolder = sTempFolder & "\"
End If
Set objFile = objFSO.GetFile( sFileName )
FilePath = objFSO.GetParentFolderName( objFile )
FilePath = sTempFolder & Mid(FilePath, 4)
fnCreatePath( FilePath )
CALL Debug( "FILECOPY = "& objFile.Name &" -> FilePath = " & FilePath )
objFile.Copy( FilePath & "\" & objFile.Name )
While NOT objFSO.FileExists( FilePath & "\" & objFile.Name )
wScript.Sleep 200
CALL Debug( "FileCopy Waiting" )
Wend
CALL Debug( "Temp FileCopy Completed" )
Set objFile = Nothing
End Function
' ----------------------------------------------
'Recursively creates a folder path
'Based on script from:
'http://www.techcoil.com/blog/handy-vbscript-functions-for-dealing-with-zip-files-and-folders/
Function fnCreatePath( folderUrl )
folderUrl = objFSO.GetAbsolutePathName(folderUrl)
If (Not objFSO.folderExists(objFSO.GetParentFolderName(folderUrl))) then
' Call CreateFolder recursively to create the parent folder
fnCreatePath(objFSO.GetParentFolderName(folderUrl))
End If
' Create the current folder if the parent exists
If (Not objFSO.FolderExists(folderUrl)) then
CALL Debug( "fnCreatePath; FolderURL = " & folderUrl )
objFSO.CreateFolder(folderUrl)
End If
End Function
' ----------------------------------------------
' Will return TRUE if folder is Empty or !Exist
Function fnFolderIsEmpty( sFolderName )
Dim objFolderFSO 'FileSystemObject
Dim objFolder
Set objFolderFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fnFolderIsEmpty = TRUE 'Return TRUE if it doesn't exist either
If objFolderFSO.FolderExists( sFolderName ) Then
Set objFolder = objFolderFSO.GetFolder( sFolderName )
If objFolder.Files.Count = 0 And objFolder.SubFolders.Count = 0 Then
fnFolderIsEmpty = TRUE
Else
fnFolderIsEmpty = FALSE
End If
End If
objFolderFSO = Nothing
objFolder = Nothing
End Function
' ----------------------------------------------
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Function FileExists( strFile )
On Error Resume Next
DIM fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists( strFile )) Then
FileExists = TRUE
Else
FileExists = FALSE
End If
fso = Nothing
End Function
'---------------------------------------------------------------
'Based on: http://blogs.msdn.com/b/gstemp/archive/2004/08/11/213028.aspx
' Returns ArrayList of folders found in sDirectory
Function fnListDirIn( ByVal sDirectory )
Set objWMIService = GetObject("winmgmts:\\.")
CALL Debug( "fnListDirIn() Path=" & sDirectory )
Set colFolders = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & sDirectory & "'} " _
& "WHERE AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
Set arrNames = CreateObject("System.Collections.ArrayList")
For Each objFolder in colFolders
CALL Debug( "fnListDirIn Add Folder=" & objFolder.Name )
arrNames.Add( objFolder.name )
Next
'colFolders = Nothing ?Why does this fail?
'objFolder = Nothing ?Why does this fail?
Set fnListDirIn = arrNames
End Function
' ----------------------------------------------
'Checks available Windows Scripting Host Version
' - Quit Script if not available
'Based on: http://www.robvanderwoude.com/vbstech_debugging.php
Function fnCheckWSHversion( ByVal iMinVer )
intMajorVerion = 0 + CInt( Mid( WScript.Version, 1, InStr( WScript.Version, "." ) - 1 ) )
intMinorVerion = 0 + CInt( Mid( WScript.Version, InStr( WScript.Version, "." ) + 1 ) )
intCheckVersion = 1000 * intMajorVerion + intMinorVerion
CALL Debug( "WSH Version = " & intCheckVersion )
If intCheckVersion < iMinVer Then
WScript.Echo "Sorry, this script requires WSH " & iMinVer/1000 & " or later"
WScript.Quit intCheckVersion
End If
End Function
' ----------------------------------------------
' Dumps debug myText to an InternetExplorer Window
' Based on script from:
' http://www.robvanderwoude.com/vbstech_debugging.php
Sub Debug( myText )
' Uncomment the next line to turn off debugging
IF NOT bDebug THEN
Exit Sub
END IF
If Not IsObject( objIEDebugWindow ) Then
Set objIEDebugWindow = CreateObject( "InternetExplorer.Application" )
objIEDebugWindow.Navigate "about:blank"
objIEDebugWindow.Visible = True
objIEDebugWindow.ToolBar = False
objIEDebugWindow.Width = 200
objIEDebugWindow.Height = 300
objIEDebugWindow.Left = 10
objIEDebugWindow.Top = 10
Do While objIEDebugWindow.Busy
WScript.Sleep 100
Loop
objIEDebugWindow.Document.Title = "IE Debug Window"
objIEDebugWindow.Document.Body.InnerHTML = _
"<b>" & Now & "</b></br>"
End If
objIEDebugWindow.Document.Body.InnerHTML = _
objIEDebugWindow.Document.Body.InnerHTML _
& myText & "<br>" & vbCrLf
'Do NOT set objIEDebugWindow = Nothing; Will go away
End Sub
让我知道你的想法。感谢。