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