MyTetra Share
Делитесь знаниями!
Запуск процесса (Приложения) и ожидание окончания его работы
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 15 Приложения Внешние
Запись: xintrea/mytetra_db_adgaver_new/master/base/1532018579sdzih58ylb/text.html на raw.githubusercontent.com

Запуск процесса (Приложения) и ожидание окончания его работы

Иногда возникает необходимость запустить внешнюю программу, для этого существует функция Shell, но у этой функции есть один недостаток - она передает управление в вызвавшую ее программу , не дождавшись того, когда будет выполнена запушенная задача.
Как быть? - Вставляем в модуль нижеследующие строки и используем функцию ExecCmd:

Option Compare Database

Option Explicit

'--------------------------------------------------------------------

' Module : modExecCmd

' Author : es

' Date : 20.01.04

' Purpose : Запуск процесса и ожидание его окончания

'--------------------------------------------------------------------

'API функции на тему ExecCmd с небольшой правкой взяты из MSDN ID:Q129796

'--------------------------------------------------------------------

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 String, 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 String, _

lpStartupInfo As STARTUPINFO, lpProcessInformation As _

PROCESS_INFORMATION) As Long


Private Declare Function CloseHandle Lib "kernel32" _

(ByVal hObject As Long) As Long


Private Declare Function GetExitCodeProcess Lib "kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long


Private Const STARTF_USESHOWWINDOW& = &H1

Private Const NORMAL_PRIORITY_CLASS = &H20&

Private Const INFINITE = -1&

'--------------------------------------------------------------------

Public Function ExecCmd(cmdline$, Optional WindowStyle& = 4) As Long

'es 20.01.04

'--------------------------------------------------------------------

'Опции по WindowStyle:

' 0 - Window is hidden and focus is passed to the hidden window.

' 1 - Window has focus and is restored to its original size and position.

' 2 - Window is displayed as an icon with focus.

' 3 - Window is maximized with focus.

' 4* - (тут по умолчанию) Window is restored to its most recent size and position. The currently active window remains active.

' 6 - Window is displayed as an icon. The currently active window remains active.

'--------------------------------------------------------------------

Dim proc As PROCESS_INFORMATION

Dim start As STARTUPINFO

Dim ret As Long

' Initialize the STARTUPINFO structure:

With start

.cb = Len(start)

.dwFlags = STARTF_USESHOWWINDOW

.wShowWindow = WindowStyle

End With


' Start the shelled application:

ret = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _

NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)


' Wait for the shelled application to finish:

ret = WaitForSingleObject(proc.hProcess, INFINITE)

Call GetExitCodeProcess(proc.hProcess, ret&)

Call CloseHandle(proc.hThread)

Call CloseHandle(proc.hProcess)

ExecCmd = ret

End Function







Так же в этом разделе:
 
MyTetra Share v.0.59
Яндекс индекс цитирования