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

Question

Я написал небольшой VBScript для создания файла .zip, а затем скопировал содержимое указанной папки в этот файл .zip.

Я копирую файлы по одному по какой-то причине (я знаю, что могу сделать все сразу). Однако моя проблема заключается в том, что, когда я пытаюсь скопировать их одно за другим без WScript.Sleep между каждой итерацией цикла, я получаю «Файл не найден или нет разрешения на чтение». ошибка; если я ставлю 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. После вызова CopyHere в zip-файле мы ждем завершения асинхронного сжатия, как это

    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.

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

Вот трюк, который я использовал в 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!"

Answer 4

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

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

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

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

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

Примечания:

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

Вы можете попытаться получить доступ к только что скопированному файлу, например, с помощью проверки «существует»:

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