Вызов с ожиданием завершения - 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

7   голосов , оценка 3.857 из 5
Похожие ответы