在不休眠的情况下使用 VBScript 压缩文件

Posted 2023-03-06

【中文标题】在不休眠的情况下使用 VBScript 压缩文件

【英文标题】：Zip files using VB Script with out sleep

【发布时间】：2014-07-24 06:14:17

【问题描述】：

我想知道是否有使用 vbscript 压缩文件而不使用 WScript.Sleep 的方法。以下是我的脚本（实用方法被跳过）；

Sub Main
   Dim Path
   Dim ZipFile
   Dim objShell

   ZipFile = WScript.Arguments(0)
   Path = WScript.Arguments(1)

   Dim a: a = ListDir(Path)
   If UBound(a) = -1 then
      WScript.Echo "No files found."
      Exit Sub
      End If

   CreateObject("Scripting.FileSystemObject").CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
   Set objShell = CreateObject("Shell.Application")
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   Dim FileName
   For Each FileName In a
      WScript.Echo FileName
      objShell.NameSpace(fso.GetAbsolutePathName(ZipFile)).CopyHere(FileName)
      'Required!
      WScript.Sleep 4000
      Next
   End Sub

如果您看到代码，我正在使用 sleep 命令等待一段时间（假设文件在指定时间压缩）。但是，这会导致脚本等待相同的时间，即使对于不好的小文件也是如此。我已经在网上搜索过是否有同步压缩文件，但无法得到答案。

【参考方案1】：

Shell.NameSpace 操作是异步的。据我所知，从 vbscript 中，不可能完全删除 Sleep，因为至少需要等待异步进程启动，但是，您可以尝试访问 zip 文件以知道操作是否已经结束。 （对不起，我已经重写了你的代码进行测试）

Option Explicit

Sub Main

    ' Retrieve arguments
    Dim strPath, strZipFile
    If Wscript.Arguments.UnNamed.Count < 2 Then 
        WScript.Echo "No arguments"
        Exit Sub
    End If
    strZipFile = WScript.Arguments(0)
    strPath = WScript.Arguments(1)

    ' Create needed objects
    Dim fso, shell
    Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
    Set shell = WScript.CreateObject("Shell.Application")

    ' Check for valid source path
    If Not fso.FolderExists( strPath ) Then 
        WScript.Echo "Folder does not exist"
        Exit Sub
    End If
    Dim oFolder
    Set oFolder = fso.GetFolder( strPath )
    If oFolder.Files.Count < 1 Then 
        WScript.Echo "No files found"
        Exit Sub
    End If

    ' Initialize zip file access
    Dim oZipFile
    strZipFile = fso.GetAbsolutePathName( strZipFile )
    fso.CreateTextFile( strZipFile, True ).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
    Set oZipFile = shell.NameSpace( strZipFile )

    ' Add files to zip
    Dim oFile
    For Each oFile In oFolder.Files
        WScript.Echo oFile.Name
        oZipFile.CopyHere(oFile.Path)
        WScript.Sleep 500
        WaitForFile strZipFile, -1
    Next

End Sub

' Wait for a file to become writeable

Function WaitForFile( FullPathToFile, TimeToWait )
Dim fso, timeLimit, oFile

    WaitForFile = False
    Set fso = WScript.CreateObject("Scripting.FileSystemObject")

    ' Determine if we are going to wait for the file
    If TimeToWait > 0 Then 
        timeLimit = DateAdd("s", TimeToWait, Now )
    ElseIf TimeToWait = 0 Then
        timeLimit = Now
    Else 
        timeLimit = DateAdd("yyyy", 100, Now)
    End If

    ' Loop until the file can be written or the timeout has been reached
    On Error Resume Next
    Do
        Err.Clear
        Set oFile = fso.OpenTextFile( FullPathToFile, 8, False )
        If Err.Number = 0 Then
            oFile.Close
            WaitForFile = True
            Exit Do
        End If
        WScript.Sleep 100
    Loop While Now < timeLimit
    On Error GoTo 0

End Function

' Call main process
    Main

WaitForFile 函数将返回一个布尔值，指示文件是否在指定的超时时间内变为可写（没有锁定文件的操作）。示例代码使用-1 作为超时，即等到文件可写。当 NameSpace 操作结束（源文件已被压缩）时，压缩文件中将没有锁，函数将返回。

【讨论】：

仅仅等待操作开始是不够的。当脚本终止时，Shell.Application 对象也随之终止，从而结束它可能仍在执行的任何操作。

@AnsgarWiechers，没有。可能我解释得不好。已删除的是CopyHere 操作的固定延迟。现在，该进程等待让操作开始，然后等到复制操作释放 zip 文件上的锁定。 Shell.Application 对象在处理完所有复制操作后才会释放。这样该过程只等待所需的时间。

【参考方案2】：

在我看来，您可以用循环比较 ZipFile 中的文件计数与源文件夹中的文件计数来替换当前的睡眠。如果一个比另一个小，做一个短暂的睡眠。要使其工作，您需要将 a 修改为 FSO 文件夹对象，而不是文件名数组。然后你可以使用它的 .Count 属性。 Like This.