Вызов с ожиданием завершения - 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
Листинг программы
  1. Attribute VB_Name = "Processn"
  2.  
  3. '############### БЛОК ПРОГРАММ ОБЕСПЕЧЕНИЯ ПРОЦЕССОВ ###################
  4. '###############   Позаимствовано у Брюса МакКинни   ###################
  5.  
  6. Const PROCESS_ALL_ACCESS = 2035711 '(&H1F0FFF)
  7.  
  8. Const INFINITE = -1                '(&HFFFFFFFF)
  9.  
  10. Const STILL_ACTIVE = 259           '(&H103)
  11.  
  12. Const WAIT_FAILED = -1             '(&HFFFFFFFF)
  13.  
  14.  
  15. Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
  16.                                              ByVal bInheritHandle As Long, _
  17.                                              ByVal dwProcessId As Long) As Long
  18.  
  19.  
  20. Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
  21.                                                      ByVal dwMilliseconds As Long) As Long
  22.  
  23.  
  24. Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, _
  25.                                                           lpExitCode As Long) As Long
  26.  
  27. Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  28.  
  29. ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  30. '::::   Ожидать завершения процесса и получить код завершения      :::::
  31. ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  32.  
  33. Function WaitOnProgram(ByVal idProg As Long, _
  34.               Optional ByVal WaitDead As Boolean) As Long
  35.  
  36. Dim cRead   As Long
  37. Dim iExit   As Long
  38. Dim hProg   As Long
  39. Dim iResult As Long
  40.  
  41.     '::: Получаем хэндл процесса
  42.  
  43.     hProg = OpenProcess(PROCESS_ALL_ACCESS, False, idProg)
  44.  
  45.     If (WaitDead) Then
  46.  
  47.        '::: Ждем до победного конца
  48.      
  49.        iResult = WaitForSingleObject(hProg, INFINITE)
  50.  
  51.        '::: Если ожидание завершилось неудачно - возбудим ошибку
  52.  
  53.        If (iResult = WAIT_FAILED) Then Error Err.LastDllError
  54.  
  55.        '::: Получаем код завершения
  56.  
  57.        GetExitCodeProcess hProg, iExit
  58.  
  59.     Else
  60.  
  61.        '::: Пробуем получить код завершения
  62.  
  63.        GetExitCodeProcess hProg, iExit
  64.  
  65.        '::: Если процесс все еще в состоянии выполнения,
  66.       '::: не дадим системе зависнуть
  67.  
  68.        Do While (iExit = STILL_ACTIVE)
  69.           '!!!!!!!!! <- место для анимации !!!!!!!
  70.          DoEvents
  71.           GetExitCodeProcess hProg, iExit
  72.        Loop
  73.  
  74.     End If
  75.  
  76.     '::: Закроем хендл
  77.  
  78.     CloseHandle hProg
  79.  
  80.     WaitOnProgram = iExit
  81.  
  82. End Function
  83.  
  84. '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  85. '::::   Запустиь программу ProgName с командной строкой CmdLine,   ::::
  86. '::::   получением кода завершения RC в окне стиля winStyle        ::::
  87. '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  88.  
  89. Public Sub ExecPrg(ProgName As String, _
  90.                    CmdLine As String, _
  91.                    RC As Long, _
  92.                    winStyle As Integer)
  93.  
  94. Dim idProc As Long, iExit As Long
  95.  
  96.     idProg = Shell((ProgName + " " + CmdLine), winStyle)
  97.  
  98.     iExit = WaitOnProgram(idProg,True)
  99.  
  100.     RC = iExit
  101.  
  102. End Sub

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


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

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

7   голосов , оценка 3.857 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы