Hi,
Du musst zwei dinge machen. Einmal Prüfen ob die Anwendung schon läuft.
Und wenn sie noch nicht läuft warten.
Warten:
In den Headder diese Zeile Packen...
Private Declare Sub Sleep Lib "kernel32" (ByVal _
dwMilliSeconds As Long)
... dann kann man im Code mit
Sleep (2000)
z.B. zwei sekunden warten.
Prüfen ob ein Programm schon läuft ist etwas schwieriger.:
Private Declare Function CreateToolhelpSnapshot Lib _
"kernel32" Alias "CreateToolhelp32Snapshot" ( _
ByVal lFlgas As Long, ByVal lProcessID As Long) _
As Long
Private Declare Function ProcessFirst Lib "kernel32" _
Alias "Process32First" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" _
Alias "Process32Next" (ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" ( _
ByVal hPass As Long)
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const MAX_PATH As Long = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type
Private Type ProcesParam
th32ProcessID As Long
status As Long
End Type
' Prüft, ob eine EXE-Datei bereits ausgeführt wird
Private Function IsEXERunning(ByVal sFilename As String) As ProcesParam
Dim lSnapshot As Long
Dim uProcess As PROCESSENTRY32
Dim nResult As Long
' "Snapshot" des aktuellen Prozess ermitteln
lSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapshot <> 0 Then
uProcess.dwSize = Len(uProcess)
' Ersten Prozess ermitteln
nResult = ProcessFirst(lSnapshot, uProcess)
Do Until nResult = 0
' Prozessliste durchlaufen
If InStr(LCase$(uProcess.szexeFile), LCase$(sFilename)) > 0 Then
' Jepp - EXE gefunden
IsEXERunning.status = True
IsEXERunning.th32ProcessID = uProcess.th32ProcessID
Exit Do
End If
' nächster Prozess
nResult = ProcessNext(lSnapshot, uProcess)
Loop
' Handle schliessen
CloseHandle lSnapshot
End If
End Function
Mit dem Folgenden Fragment habe ich geprüft ob der Windows Rechner schon läuft. Wenn calc Läuft habe ich die Prozess ID zurück gegeben.
Dim prüf As ProcesParam
prüf = IsEXERunning("calc.exe")
If prüf.status = True Then
Rem MsgBox "AMS Läuft." + CStr(prüf.th32ProcessID)
Ret_Val = prüf.th32ProcessID
Else
So viel Spass und hoffe geholfen zu haben !
Sulkifix
