Question

我编写了一个小的VBScript来创建.zip文件，然后将指定文件夹的内容复制到该.zip文件中。

我出于某种原因逐个复制文件（我知道我可以一次完成所有这些）。但是我的问题是，当我尝试在没有WScript的情况下逐个复制它们。在每次循环迭代之间，我得到一个“找不到文件或没有读取权限”。错误;如果我在每次写入后放置WScript.Sleep 200它会起作用，但不是100％的时间。

我非常想摆脱Sleep功能而不依赖它，因为根据文件大小的不同，写入可能需要更长时间，因此200毫秒可能还不够等。

正如您可以看到下面的一小段代码，我遍历文件，然后如果它们与扩展名匹配，我将它们放入.zip（zipFile）

For Each file In folderToZip.Items
    For Each extension In fileExtensions
        if (InStr(file, extension)) Then
            zipFile.CopyHere(file)
            WScript.Sleep 200
            Exit For
        End If
    Next
Next

关于如何停止依赖睡眠功能的任何建议？

由于

Answer 1

这就是我们在VB6中的做法。在zip上调用CopyHere后，我们等待异步压缩完成，如此

    Call Sleep(100)
    Do
        Do While Not pvCanOpenExclusive(sZipFile)
            Call Sleep(100)
        Loop
        Call Sleep(100)
    Loop While Not pvCanOpenExclusive(sZipFile)

辅助函数看起来像这样

Private Function pvCanOpenExclusive(sFile As String) As Boolean
    Dim nFile       As Integer

    nFile = FreeFile
    On Error GoTo QH
    Open sFile For Binary Access Read Lock Write As nFile
    Close nFile
    pvCanOpenExclusive = True
QH:
End Function

好的副作用是，即使压缩失败，这也不会以无限循环结束。

当zip文件被zipfldr.dll关闭时访问zip文件时出现问题，即pvCanOpenExclusive返回true时。

Answer 2

你是对的，CopyHere是异步的。当我在vbscript中执行此操作时，我会一直睡觉，直到zip中的文件数大于或等于复制的文件数。

Sub NewZip(pathToZipFile)

   WScript.Echo "Newing up a zip file (" & pathToZipFile & ") "

   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   Dim file
   Set file = fso.CreateTextFile(pathToZipFile)

   file.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)

   file.Close
   Set fso = Nothing
   Set file = Nothing

   WScript.Sleep 500

End Sub



Sub CreateZip(pathToZipFile, dirToZip)

   WScript.Echo "Creating zip  (" & pathToZipFile & ") from (" & dirToZip & ")"

   Dim fso
   Set fso= Wscript.CreateObject("Scripting.FileSystemObject")

   If fso.FileExists(pathToZipFile) Then
       WScript.Echo "That zip file already exists - deleting it."
       fso.DeleteFile pathToZipFile
   End If

   If Not fso.FolderExists(dirToZip) Then
       WScript.Echo "The directory to zip does not exist."
       Exit Sub
   End If

   NewZip pathToZipFile

   dim sa
   set sa = CreateObject("Shell.Application")

   Dim zip
   Set zip = sa.NameSpace(pathToZipFile)

   WScript.Echo "opening dir  (" & dirToZip & ")"

   Dim d
   Set d = sa.NameSpace(dirToZip)

   ' for diagnostic purposes only
   For Each s In d.items
       WScript.Echo  s
   Next


   ' http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx
   ' ===============================================================
   ' 4 = do not display a progress box
   ' 16 = Respond with "Yes to All" for any dialog box that is displayed.
   ' 128 = Perform the operation on files only if a wildcard file name (*.*) is specified. 
   ' 256 = Display a progress dialog box but do not show the file names.
   ' 2048 = Version 4.71. Do not copy the security attributes of the file.
   ' 4096 = Only operate in the local directory. Don't operate recursively into subdirectories.

   WScript.Echo "copying files..."

   zip.CopyHere d.items, 4

   Do Until d.Items.Count <= zip.Items.Count
       Wscript.Sleep(200)
   Loop

End Sub

Answer 3

您可以尝试访问刚刚复制的文件，例如使用“存在”检查：

For Each file In folderToZip.Items
    For Each extension In fileExtensions
        If LCase(oFSo.GetExtensionName(file)) = LCase(extension) Then
            zipFile.CopyHere(file)
            Dim i: i = 0
            Dim target: target = oFSO.BuildPath(zipFile, oFSO.GetFileName(file))
            While i < 100 And Not oFSO.FileExists(target) 
              i = i + 1
              WScript.Sleep 10
            Wend
            Exit For
        End If
    Next
Next

我不确定是否为此使用上下文正确计算target，但您明白了。我有点惊讶的是，这个错误首先出现...... FileSystemObject应该是严格同步的。

如果所有其他方法都失败了，请执行以下操作：

For Each file In folderToZip.Items
    For Each extension In fileExtensions
        If LCase(oFSo.GetExtensionName(file)) = LCase(extension) Then
            CompressFailsafe zipFile, file
            Exit For
        End If
    Next
Next

Sub CompressFailsafe(zipFile, file)
  Dim i: i = 0
  Const MAX = 100

  On Error Resume Next
  While i < MAX
    zipFile.CopyHere(file)
    If Err.Number = 0 Then 
      i = MAX
    ElseIf Err.Number = xxx ''# use the actual error number!
      Err.Clear
      WScript.Sleep 100
      i = i + 1
    Else 
      ''# react to unexpected error
    End Of
  Wend
  On Error GoTo 0
End Sub

Answer 4

我们在各种Windows风格上进行了大量调试和QA后使用的解决方案，包括快速和慢速机器以及CPU负载过重的机器，是以下代码段。

批评和改进欢迎。

我们无法在没有循环的情况下找到这样做的方法，也就是说，如果你想进行一些验证或发布压缩工作。

目标是在尽可能多的窗口风格上构建可靠运行的东西。理想情况下尽可能本地。

请注意，此代码仍然不是100％可靠，但它似乎是~99％。我们可以通过dev和QA时间获得稳定性。增加iSleepTime可能会使其成为100％

注意事项：

无条件睡眠似乎是我们发现的最可靠和最兼容的方法
iSleepTime不应该减少，似乎循环越频繁，出错的可能性越大，看似与zip / copy过程的内部操作有关
iFiles是源文件计数
循环越简单，越好，例如在循环中输出oZippp.Items().Count会导致无法解释的错误，看起来它们可能与文件访问/共享/锁定违规有关。我们没有花时间跟踪找出来。
无论如何，在Windows 7上似乎，压缩过程的内部使用位于压缩zip文件夹的cwd中的临时文件，您可以在长时间运行的拉链中通过刷新资源管理器窗口或使用cmd列出目录来查看/ LI>
我们在Windows 2000，XP，2003，Vista，7

您可能希望在循环中添加超时，以避免无限循环

'Copy the files to the compressed folder
oZippp.CopyHere oFolder.Items()
iSleeps = 0
iSleepTime = 5
On Error Resume Next
Do
    iSleeps = iSleeps + 1
    wScript.Sleep (iSleepTime * 1000)
Loop Until oZippp.Items().Count = iFiles
On Error GoTo 0


If iFiles <> oZippp.Items().Count Then
    ' some action to handle this error case
Else
    ' some action to handle success
End If

Answer 5

这是我在VB中使用的技巧;在更改之前获取zip文件的长度并等待它更改 - 然后再等一两秒。我只需要两个特定的文件，但你可以用它来循环。

Dim s As String
Dim F As Object 'Shell32.Folder
Dim h As Object 'Shell32.Folder
Dim g As Object 'Shell32.Folder
Dim Flen As Long, cntr As Long, TimerInt As Long
Err.Clear
s = "F:\.zip"
NewZipFolder s
Flen = FileLen(s)
Set F = CreateObject("Shell.Application").namespace(CVar(s))
TimerInt = FileLen("F:\MyBigFile.txt") / 100000000  'set the loop longer for bigger files
F.CopyHere "F:\DataSk\DemoData2010\Test.mdf"
Do
    cntr = Timer + TimerInt
    Do
        DoEvents: DoEvents
    Loop While cntr > Timer
    Debug.Print Flen
Loop While Flen = FileLen(s)
    cntr = Timer + (TimerInt / 2)
    Do
        DoEvents: DoEvents
    Loop While cntr > Timer
Set F = Nothing
Set F = CreateObject("Shell.Application").namespace(CVar(s))


F.CopyHere "F:\MynextFile.txt"

MsgBox "Done!"

使用CopyHere写入文件而不使用WScript.Sleep

5 个答案: