kopier folgendes in ein KlassenModule
Option Explicit
'Klasse zu Starten von eigenständigen Prozessen, merkt sich die PID
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Public Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
ByVal lpApplicationName As String, ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As _
SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As _
Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo _
As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As _
Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (hObject As Long) As Boolean
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As _
Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As _
Long, ByVal uExitCode As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As _
Long, lpExitCode As Long) As Long
Const STILL_ACTIVE = &H103
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const PROCESS_TERMINATE = &H1
Private currPid As Long
'Erstellt einen neuen Prozess
Public Function newTask(ByVal App As String, ByVal WorkDir As String, ByVal _
start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
If IsActive Then
newTask = False
Exit Function
End If
Dim pclass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
sinfo.dwFlags = STARTF_USESHOWWINDOW
sinfo.wShowWindow = start_size
pclass = Priority_Class
newTask = CreateProcess(vbNullString, App, sec1, sec2, False, pclass, 0&, _
WorkDir, sinfo, pinfo)
currPid = pinfo.dwProcessId
end Function
'beendet den gestarteten Prozess
Public Sub Kill()
Dim Task As Long, Result As Long
Task = OpenProcess(PROCESS_TERMINATE, 0&, currPid)
Result = TerminateProcess(Task, 1&)
Result = CloseHandle(Task)
End Sub
'prüft ob Prozess noch läuft
Public Function IsActive() As Boolean
Dim Handle&, ExitCode&
Handle = OpenProcess(PROCESS_ALL_ACCESS, False, currPid)
Call GetExitCodeProcess(Handle, ExitCode)
IsActive = IIf(ExitCode = STILL_ACTIVE, True, False)
End Function
'gibt die PID zurück
Public Property Get pid() As Long
pid = currPid
End Property |