Вызов с ожиданием завершения - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д