Запись в файл с помощью CopyHere без использования WScript.Sleep

Ответ 1

Вот как мы это делаем в VB6. После вызова CopyHere в zip мы ожидаем завершения async-сжатия, как это

    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, то есть когда pvCanOpenExclusive возвращает true.

Ответ 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

Ответ 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

Ответ 4

Решение, которое мы использовали после большой отладки и QA для различных оконных аксессуаров, включая быстрые и медленные машины и машины при большой загрузке процессора, было следующим фрагментом.

Критика и улучшения приветствуются.

Мы не смогли найти способ сделать это без цикла, т.е. если вы хотите выполнить некоторую проверку или выполнить постпиксельную работу.

Цель заключалась в том, чтобы создать что-то, что надежно работало на максимально возможном количестве окон. Идеально как можно более возможно.

Имейте в виду, что этот код по-прежнему НЕ на 100% надежный, но его значение составляет ~ 99%. Как стабильный, как мы могли бы получить его с Dev и QA время доступны. Возможно, что увеличение iSleepTime может сделать 100%

Точки обзора:

• Безусловный сон, кажется, самый надежный и совместимый подход, который мы нашли.
• iSleepTime не следует сокращать, кажется, чем чаще цикл работает, тем выше вероятность ошибки, которая, по-видимому, связана с внутренними операциями процесса zip/copy
• iFiles - это номер исходного файла
• Чем более упрощен цикл, тем лучше, например, вывод oZippp.Items().Count в цикле вызвал необъяснимые ошибки, которые выглядели так, как будто они могут быть связаны с нарушениями доступа к файлам/совместного использования/блокировки. Мы не проводили трассировку времени, чтобы узнать.
• В любом случае, похоже, что в Windows 7 внутренняя часть процесса zipping использует временный файл, расположенный в cdd сжатой ZIP-папки, вы можете видеть это во время длительных задержек, обновляя окно проводника или список dir с помощью 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
  

Ответ 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!"