Вызов с ожиданием завершения - VB
Формулировка задачи:
Проблема не раз обсуждалась и имеет решения на разных форумах
Однако столкнулся с проблемой
Суть вопроса: нужно вызвать программу с параметрами и дождаться ее завершения (rmdir, mkdir, xcopy, 7z, т.е. консольные приложения)
Вызывал разными методами. На моем компьютере вроде все методы работают
Пробовал на виртуалке - урезанная ХП - не работает, и на ПК брата - то же не работает, винда там такая же как и у меня (вин7,х64)
ссылка на программу (исходники) - http://rghost.ru/45349307
В пути присутствуют пробелы
Для разных вызовов использовал разные решения:
функция MakeSpaceInQuotes ставит пробелы в кавычки
так же брал полные пути в кавычки, например "C:\Program Files (x86)\my program", так же работает
Однако программа либо не работает, либо крошится на других ПК
Алгоритмы вызова с ожиданием лежат в модулях bModule, MainModule
ShellFile ( моя любимая функция )
ExecuteAndWait2
ExecuteAndWait3
CommandExthttp://f4.s.qip.ru/Wd8G0yCd.pnghttp://f2.s.qip.ru/Wd8G0yCe.pnghttp://f3.s.qip.ru/Wd8G0yCf.pnghttp://f2.s.qip.ru/Wd8G0yCg.pnghttp://f4.s.qip.ru/Wd8G0yCh.png
Т.е. устанавливает анимации из архива в app.path & "\anim\"
использует временную папку app.path & "\temp\"
null
Решение задачи: «Вызов с ожиданием завершения»
textual
Листинг программы
Attribute VB_Name = "Processn" '############### БЛОК ПРОГРАММ ОБЕСПЕЧЕНИЯ ПРОЦЕССОВ ################### '############### Позаимствовано у Брюса МакКинни ################### Const PROCESS_ALL_ACCESS = 2035711 '(&H1F0FFF) Const INFINITE = -1 '(&HFFFFFFFF) Const STILL_ACTIVE = 259 '(&H103) Const WAIT_FAILED = -1 '(&HFFFFFFFF) Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _ lpExitCode As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ':::: Ожидать завершения процесса и получить код завершения ::::: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Function WaitOnProgram(ByVal idProg As Long, _ Optional ByVal WaitDead As Boolean) As Long Dim cRead As Long Dim iExit As Long Dim hProg As Long Dim iResult As Long '::: Получаем хэндл процесса hProg = OpenProcess(PROCESS_ALL_ACCESS, False, idProg) If (WaitDead) Then '::: Ждем до победного конца iResult = WaitForSingleObject(hProg, INFINITE) '::: Если ожидание завершилось неудачно - возбудим ошибку If (iResult = WAIT_FAILED) Then Error Err.LastDllError '::: Получаем код завершения GetExitCodeProcess hProg, iExit Else '::: Пробуем получить код завершения GetExitCodeProcess hProg, iExit '::: Если процесс все еще в состоянии выполнения, '::: не дадим системе зависнуть Do While (iExit = STILL_ACTIVE) '!!!!!!!!! <- место для анимации !!!!!!! DoEvents GetExitCodeProcess hProg, iExit Loop End If '::: Закроем хендл CloseHandle hProg WaitOnProgram = iExit End Function ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ':::: Запустиь программу ProgName с командной строкой CmdLine, :::: ':::: получением кода завершения RC в окне стиля winStyle :::: ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: Public Sub ExecPrg(ProgName As String, _ CmdLine As String, _ RC As Long, _ winStyle As Integer) Dim idProc As Long, iExit As Long idProg = Shell((ProgName + " " + CmdLine), winStyle) iExit = WaitOnProgram(idProg,True) RC = iExit End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д