Escribir en un archivo usando CopyHere sin usar WScript.Sleep

Question

He escrito un pequeño VBScript para crear un archivo .zip y luego copia el contenido de una carpeta específica en ese archivo .zip.

Copio los archivos uno por uno por una razón (sé que puedo hacer todo el lote de una vez). Sin embargo, mi problema es cuando trato de copiarlos uno por uno sin WScript.Sleep entre cada iteración de bucle obtengo un "Archivo no encontrado o sin permiso de lectura". error; si coloco un WScript.Sleep 200 después de cada escritura, funciona pero no el 100% del tiempo.

Más o menos me gustaría deshacerse de la función del sueño y no confiar en que ya que dependiendo del tamaño del archivo puede tomar más tiempo para escribir, por tanto, 200 milisegundos pueden no ser lo suficientemente etc.

Como se puede veo con el pequeño trozo de código de abajo, yo bucle a través de los archivos, a continuación, si coinciden con la extensión de los coloco en el .zip (archivo 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 

Cualquier sugerencia sobre cómo puedo dejar de depender de la función del sueño ?

Gracias

Answer 1

Puede intente acceder al archivo que acaba de haber copiado, por ejemplo con un "existe" comprobar:

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 

No estoy seguro de si target se calcula correctamente para este uso contexto, pero entiendes la idea. Estoy un poco sorprendido de que este error ocurra en primer lugar ... FileSystemObject debe ser estrictamente sincrónico.

Si todo lo demás falla, hacer esto:

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

Estás en lo correcto, CopyHere es asíncrona. Cuando hago esto en un VBScript, duermo hasta que el recuento de los archivos de la cremallera, es mayor o igual al recuento de los archivos copiados en.

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

La solución se utilizó después de mucha depuración y control de calidad en varios sabores de Windows, incluyendo máquinas rápidas y lentas y máquinas bajo una gran carga de CPU, fue el siguiente fragmento.

Crítica y mejoras bienvenidas.

No hemos podido encontrar una forma de hacer esto sin un bucle, es decir, si usted quería hacer alguna validación o publicar el trabajo de compresión.

El objetivo era crear algo que funcionara de manera confiable en tantos sabores de Windows como fuera posible. Idealmente también lo más nativo posible.

Tenga en cuenta que este código es aún NO es 100% confiable, pero parece ser ~ 99%. Tan estable como podríamos obtenerlo con el desarrollador y el tiempo de QA disponible. Su posible que el aumento de iSleepTime podría hacer que sea 100%

Puntos de nota:

• El sueño incondicional parece ser el método más fiable y compatible encontramos
• El iSleepTime no debe reducirse, se parece que cuanto más frecuentemente se ejecuta el bucle, mayor es la probabilidad de un error, aparentemente relacionado con las operaciones internas del proceso zip/copy
• iFiles es el número de archivo fuente
• Cuanto más simple era el bucle, mejor, por ejemplo, generar oZippp.Items().Count en el bucle provocaba errores inexplicables que parecían estar relacionados con violaciones de acceso/compartición/bloqueo de archivos. No perdimos el tiempo rastreando para descubrirlo.
• Parece que en Windows 7 de todos modos, que las partes internas del proceso de compresión utilizan un archivo temporal ubicado en el archivo adjunto de la carpeta zip comprimida, puede ver esto durante las sesiones largas refrescando la ventana del explorador o listando dir con cmd
• tuvimos éxito con este código en Windows 2000, XP, 2003, Vista, 7

• probablemente usted desea agregar un tiempo de espera en el circuito, para evitar bucles infinitos

  '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

Así es como lo hacemos en VB6. Después de llamar a CopyHere en la postal esperamos a que la compresión asíncrona para completar esta manera

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

donde la función auxiliar se parece a esto

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 

agradable efecto secundario es que incluso si falla comprimir esto no va a terminar arriba en bucle infinito

El problema surge al acceder al archivo comprimido cuando está cerrado por zipfldr.dll, es decir cuando pvCanOpenExclusive devuelve verdadero.

Answer 5

Aquí hay un truco que utilicé en VB; obtenga la longitud del archivo zip antes del cambio y espere a que cambie, luego espere otro segundo o dos. Solo necesitaba dos archivos específicos, pero podrías hacer un loop out de esto.

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