Как узнать что файл уже полностью сохранился?

[kibernetics]

Приветствую!

Парни, посоветуйте решение по одной дилемме. Значит, из кода приложения вызывается сторонний ехе-шник с передачей ему параметров:

Код: Выделить всё

Sub CreateFile()
    Call Shell ("cmd.exe /c ""C:\My path\prg.exe"" > newfile.txt")
End Sub

Шелл вызывается, там своя задача начинает выполнятся, а управление тотчас же передаётся назад в приложение. Код идёт дальше, где собственно, срабатывает таймер на определение, появился ли нужный мне файл в директории:

Код: Выделить всё

Private Sub myTimer_Timer()
    Dim sTemp   As String
    sTemp = MyPath & "\" & "newfile.txt"
     
    If FileExists(sTemp) Then
        myTimer.Enabled = False
        ExtractDataFromMyFile
    End If
End Sub

и вот, что происходит: часть файла екзешник из шела успел записать. т.е. иными словами файл в директории появился, но он не полный ещё, а у меня в коде уже идёт его открытие, где удаётся получить размер файла конкретно на момент запроса. В итоге, я считываю в буфер только часть файла, что понятное дело не верно! Ведь, в шеле ещё выполняется запись в файл!

Как обойти это узкое место? Как понять, что файл уже полностью сохранился?
На вскидку приходит разве что, контролировать уничтожение терминального окна... Или, пробовать открывать файл монопольно и смотреть занят он или нет (хотя, пока не представляю как это технически сделать).

В идеале, конечно, лучше чтобы приложение приостановилось на то время пока выполняется операция в терминале, тогда и надобность в таймере отпадает, с определением сформировался ли файл.

Вот такая беда, господа.

[bon818]

Код: Выделить всё

'Запустить программу и дождаться завершения его работы
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Sub ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Инициализируем структуру STARTUPINFO:
start.cb = Len(start)
' Запускаем приложение:
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Ждем завершения запущенного приложения:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
ret& = CloseHandle(proc.hProcess)
End Sub

Private Sub Form_Load()
ExecCmd ("Notepad")
MsgBox "Работа Блокнота завершена", vbInformation, "Конец."
End Sub


[Teranas]

Полно вариантов:
1. Если дочерняя программа завершается после записи в файл, то можно через

Код: Выделить всё


Public Function FindProcessID(ProcessID As Long) As Boolean
Dim Snap As Long, Process As TProcessEntry32
Snap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  If Snap <> -1 Then
      Process.dwSize = Len(Process)
      If Process32First(Snap, Process) <> 0 Then
        Do
          If Process.th32ProcessID = ProcessID Then
            FindProcessID = True ' Указанный ID процесса найден!
            Exit Do
          End If
        Loop Until Process32Next(Snap, Process) = 0
      End If
    CloseHandle Snap
  End If
End Function


  pid = Shell("C:\My path\prg.exe " & "newfile.txt")
  do
     sleep 100
  loop while FindProcessID(pid)
  ' Файл записан



2. Если дочерняя программа имеет окно, можно так же проверять существование окна

3. Можно искать имя процесса таким же способом

4. Контроль размера файла через промежуток времени, скажем через 500 мс, если размер не изменился, значит программа больше в него не пишет (ненадёжно).

5. Открытие файла на запись через CreateFile(), каждые NNN мс, если открылся, значит программа его освободила и закончила запись.

6. Искать дескриптор открытого файла newfile.txt (надёжно)

есть ещё пара совсем экзотических методов, дата изменения файла и так далее...

[ALX_2002]

Господа, я видимо, что-то не учитываю ? Но может так проще ?

1) Смена кодовой страницы
2) Выполнение программы с выводом в лог
3) Ожидание окончания работы
4) Открытие лога по концу.

Код: Выделить всё

CreateObject("WScript.Shell").Run "cmd /c ""chcp 65001 && ping 127.0.0.1 > ping_log.txt && ping_log.txt""", 0, True


1) Смена кодовой страницы
2) Выполнение программы с выводом в лог
3) Ожидание окончания работы

Код: Выделить всё

CreateObject("WScript.Shell").Run "cmd /c ""chcp 65001 && ping 127.0.0.1 > ping_log.txt""", 0, True


[kibernetics]

Я кумекал-кумекал, пришёл к выводу, что мониторить занят ли файл другим приложением более правильная операция, нежели, контролировать уничтожение инстанса сторонней прилаги. Мало ли, она уничтожена, а файл всё равно пишется там какими-нибудь потоками в системе. Я так детально в архитектуре не секу. Сделал проверку флагов файла
GENERIC_READ и OPEN_EXISTING, и тогда уже к нему обращаюсь.

По сути, поступил по п.5 от Teranas.

[kibernetics]

Однако, сколько интересных вариантов нарисовалось здесь. Забавно, сколько идей.

[Хакер]

Я кумекал-кумекал, пришёл к выводу, что мониторить занят ли файл другим приложением более правильная операция, нежели, контролировать уничтожение инстанса сторонней прилаги.

Неправильно кумекал. Перенаправлять вывод в файл, а потом читать самому из этого файла — это дурацкий и убогий путь, если учесть, что можно перенаправить вывод не в файл, а в пайп (канал, который может как трубопровод проводить поток байтов от одного процесса к другому).

С учётом этой маленькой на значимой детали, совет bon818 становится наиболее актуальным и правильным: просто нужно только в структуре STARTUPINFO в поле hStdOutput записать хендл пайпа, а из своего приложения — прочитать данные, записанные дочерним процессом в пайп.

Полезным бонусом окажется то, что операция не сфейлит, если на диске нет места. Плюс система из родительского и дочернего процесса окажется работоспособной, если запускается без прав на создание и запись файлов (в отличие от варианта с файлом).

Впрочем, если дочерний процесс имеет внутри себя вызов FlushFileBuffers, то даже вариант ожидания завершения процесса и использование файла гарантированно сработает правильно.

[kibernetics]

Перенаправлять вывод в файл, а потом читать самому из этого файла — это дурацкий и убогий путь, если учесть, что можно перенаправить вывод не в файл, а в пайп

А ведь правда, мне то этот файл и не нужен на диске. Можно напрямую из трубы таскать каштаны. Файл то после обработки сразу же и удаляется.
Помню говорил мне Саня (ALX_2002) о неком чудо-пайпе, но я как-то помаялся-помаялся с экспериментами, но ничего не собрал, подумал, не тривиально это как-то, не встречал в примерах кода, чтоб так делали. Ошибался значит, не придал должного значения.

[Teranas]

kibernetics

Замотаешься ты с этим pipe, там столько хитрожопости...

Кусок из моей программы:

Код: Выделить всё


Public Function SetProcessT(sComm As String, Optional SWindow As eSW_SHOW = SW_NORMAL, Optional sAppPath As String = "") As Long
  Dim St As STARTUPINFO, Pr As PROCESS_INFORMATION, ret As Long
  Dim Pipe As SECURITY_ATTRIBUTES3, Pipe2 As SECURITY_ATTRIBUTES3
  With Pipe
    .nLength = Len(Pipe)
    .lpSecurityDescriptor = 0
    .bInheritHandle = True
  End With
  LSet Pipe2 = Pipe
  ' создаем пайп для stdin
  ret = CreatePipe(StdInputRead, StdInputWrite, Pipe, 0)
  If ret = 0 Then
    MsgBox "Error CreatePipe Input!", vbCritical: Exit Function
  End If
  ' создаем пайп для stdout
  ret = CreatePipe(StdOutputRead, StdOutputWrite, Pipe2, 0)
  If ret = 0 Then
    Call CloseHandle(StdInputRead)
    Call CloseHandle(StdInputWrite)
    MsgBox "Error CreatePipe Output!", vbCritical: Exit Function
  End If
   
  St.wShowWindow = SWindow
  St.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
  'St.dwFlags = lFlag ' STARTF_USESTDHANDLES orSTARTF_USESHOWWINDOW
  St.hStdInput = StdInputRead
  St.hStdOutput = StdOutputWrite
  St.hStdError = StdOutputWrite
  St.lpTitle = 0& ' StrPtr(StrConv("Welcom!" & vbNullChar, vbFromUnicode))
  St.cb = Len(St)
  'ret = CreateProcessA(sComm, vbNullString, 0&, 0&, 1&, IDLE_PRIORITY_CLASS Or CREATE_NEW_CONSOLE, 0&, 0&, St, Pr)
  ret = CreateProcessA(sComm, vbNullString, ByVal 0&, ByVal 0&, 1&, IDLE_PRIORITY_CLASS, ByVal 0&, vbNullString, St, Pr)
  If ret <> 0 Then
    With Pr
      EnPrID = .dwProcessId
      EnPrHandle = .hProcess
      EnThreadID = .dwThreadId
      EnThreadHandle = .hThread
    End With
  Else
    Call CloseHandle(StdInputRead)
    Call CloseHandle(StdInputWrite)
    Call CloseHandle(StdOutputRead)
    Call CloseHandle(StdOutputWrite)
    MsgBox "Error create process:" & vbCrLf & sComm & vbCrLf & "Error number: " & CStr(ret), vbCritical
  End If
    ' MsgA "Accept          = " & LogErr(hHandle)
    ' MsgA "CreateProcess   = " & LogErr(SetProcessA)
    ' MsgA "ProcessId       = " & CStr(Pr.dwProcessId)
  'CloseHandle hHandle
  'CloseHandle Pr.hProcess
  'CloseHandle Pr.hThread
End Function



[Vova_2581]

А ведь правда, мне то этот файл и не нужен на диске. Можно напрямую из трубы таскать каштаны. Файл то после обработки сразу же и удаляется.

Может так будет немного попроще?..

Код: Выделить всё

Private Sub Form_Load()
Dim objShell, objCmdExec
cmdstr = "ipconfig /all" 'prg.exe
Set objShell = CreateObject("WScript.Shell")
Set objCmdExec = objShell.exec(cmdstr)
ResultStr = objCmdExec.StdOut.ReadAll
Debug.Print ResultStr ' > newfile.txt
End
End Sub