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

Question

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

我一个接一个地复制文件出于某种原因（我知道我可以一次完成整件事）。然而，我的问题是，当我试图在没有WScript.Sleep的情况下逐一复制它们时，每次循环迭代时我都会得到一个“未找到文件或没有读取权限”。错误;如果我在每次写入后都设置了WScript.Sleep 200，但不是100％的时间。

差不多，我想摆脱休眠功能，而不是依赖于因为根据文件的大小，可能需要更长的时间，因此写200毫秒可能不够等

，你可以看到小片的下面的代码，我遍历文件，那么如果它们扩展匹配我把它们放入的.zip（zip文件）

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

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

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 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

我们很多的调试和QA后使用的解决方案各种windows风格，包括快速和慢速机器和CPU负载繁重的机器是以下代码片段。

批判和改进的欢迎。

我们无法找到一种没有循环的方法，也就是说，如果您想做一些验证或压缩后的工作。

目标是在尽可能多的windows风格上建立可靠运行的东西。理想情况下也尽可能本地化。

请注意，此代码仍不是100％可靠，但它似乎是〜99％。尽可能稳定，因为我们可以通过dev和QA时间获得它。 它可能增加iSleepTime可以把它100％

点注意事项：

• 无条件睡眠似乎是最可靠和最兼容的方法，我们发现
• 的iSleepTime不应该降低，它似乎循环运行得越频繁，出现错误的概率就越高，似乎与压缩/复制过程的内部操作有关
• iFiles是源文件数
• 循环越简单越好，例如在循环中输出oZippp.Items().Count会导致看似可能与文件访问/共享/锁定违例相关的无法解释的错误。我们没有花时间追踪发现。
• 无论如何，在Windows 7上看来，压缩过程的内部使用位于压缩zip文件夹的cwd中的临时文件，您可以在长时间运行的zip文件中通过刷新资源管理器窗口或使用cmd列出目录来看到此内容
• 我们有与此代码成功在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 4

这是我们如何在VB6中完成的。在拉链调用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 

尼斯的副作用是，即使压缩和解失败，这不会结束在无限循环中。

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

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!"