HMM, kannst mal die URL posten, habe die MSDN durchsucht, aber nix passendes gefunden (jedenfalls nix, was alles kann ); ich sitze nämlich schon den ganzen Sonntag und bastele eine Klasse, die die Prozeßbehandlung unter Win 9x - XP ermöglicht.
(ListProc, IsProcRunning und Terminate)
Das Problem bei NT ist in der Tat die Toolhelp - Geschichte. Da hat man damals die psapi.dll verwendet.
Nun ja, wenn du eine Lösung hast... Ich mache das Ding aber trotzdem noch fertig. Sportliche Herausforderung
Gruß
Ulrich
hier der Code, den NT Kram kann ich erst morgen in der Firma testen.
Const PROCESS_QUERY_INFORMATION = 1024
Const PROCESS_VM_READ = 16
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const hNull = 0
Const TH32CS_SNAPPROCESS = 2&
Const MAX_PATH = 260
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
Declare Function CreateToolhelpSnapshot Lib "Kernel32.dll" Alias "CreateToolhelp32Snapshot"
(Byval lFlags As Long, Byval lProcessID As Long) As Long
Declare Function ProcessFirst Lib "Kernel32.dll" Alias "Process32First" (Byval hSnapShot As Long,
uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "Kernel32.dll" Alias "Process32Next" (Byval hSnapShot As Long,
uProcess As PROCESSENTRY32) As Long
'Declare Sub CloseHandle Lib "Kernel32.dll" (Byval hPass As Long)
Declare Function CloseHandle Lib "Kernel32.dll" (Byval Handle As Long) As Long
Declare Function FindWindow Lib "user32" Alias"FindWindowA" (Byval lpClassName As String, Byval
lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (Byval hwnd As Long, Byval wMsg As
Long, Byval wParam As Long, lParam As Any) As Long
Const WM_CLOSE = &H10
Declare Function EnumProcesses Lib "psapi.dll" ( lpidProcess As Long, Byval cb As Long,
cbNeeded As Long) As Long
Declare Function EnumProcessModules Lib "psapi.dll" (Byval hProcess As Long, lphModule As Long,
Byval cb As Long, lpcbNeeded As Long) As Long
Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (Byval hProcess
As Long, Byval hModule As Long, Byval lpFileName As String, Byval nSize As Long) As Long
Declare Function GetModuleFileNameExA Lib "psapi.dll" (Byval hProcess As Long, Byval hModule As
Long, Byval strModuleName As String, Byval nSize As Long) As Long
Declare Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (Byval hProcess As
Long, Byval hModule As Long, Byval lpBaseName As String, Byval nSize As Long) As Long
Declare Function OpenProcess Lib "kernel32" (Byval dwDesiredAccess As Long, Byval blnheritHandle
As Long, Byval dwAppProcessId As Long) As Long
Declare Function TerminateProcess Lib "kernel32" (Byval ApphProcess As Long, Byval uExitCode As
Long) As Long
Const VER_PLATFORM_WIN32_NT = 2
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Sub Click(Source As Button)
Msgbox IsWinNT
End Sub
Function ProcessRunning(Byval Filename As String) As Variant
' if IsWinNT then ...
Dim hSnapShot As Long, uProcess As PROCESSENTRY32, RetVal As Long
hSnapShot = CreateToolhelpSnapshot(2&, 0&)
If hSnapShot = 0 Then Exit Function
uProcess.dwSize = Len(uProcess)
RetVal = ProcessFirst(hSnapShot, uProcess)
Do While RetVal <> 0
If Instr(1,Ucase(uProcess.szExeFile), Ucase(Filename), 0 ) > 0 Then
ProcessRunning = True
Exit Function
End If
RetVal = ProcessNext(hSnapShot, uProcess)
Loop
processRunning = False
Call CloseHandle(hSnapShot)
End Function
Function IsWinNT() As Long
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionExA myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Sub GetProcessesByIDNT()
Const lngStartSize = 1000
Dim lngArray() As Long
Dim lngBytesReturned As Long
Dim lngElements As Long
Dim strProcessIDs As String
Dim lngCounte As Long
Dim lngErrNum As Long
Dim strErrDesc As String
Redim lngArray(lngStartSize) As Long
If EnumProcesses(lngArray(0), lngStartSize*4,lngBytesReturned) =0 Then
Msgbox "Halllo"
Else
lngElements = lngBytesReturned / 4
If lngElements > 0 Then
Redim Preserve lngArray(lngElements) As Long
For lngCounter = 0 To lngElements
strProcessIDs = strProcessIDs & Cstr(lngArray(lngCounter)) &
Chr(13)
Next
Msgbox "Current Process IDs:" & Chr(13) & strProcessIDs, vbOKOnly, " "
Else
Msgbox "Failed to retrieve any Process ID information", vbOKOnly +
vbExclamation, " "
End If
End If
End Sub
Function WindowsVersion() As String
tmp = ""
Dim OS As OSVERSIONINFO
Dim ret As Integer
OS.dwOSVersionInfoSize = 148
OS.szCSDVersion = Space$(128)
ret = GetVersionExA( OS )
Select Case OS.dwPlatformId
Case 1
Select Case OS.dwMajorVersion
Case 0: tmp = "Windows 95"
Case 10: tmp = "Windows 98"
End Select
Case 2
Select Case OS.dwMajorVersion
Case 3: tmp = "Windows NT 3.51"
Case 4: tmp = "Windows NT 4.0"
Case 5 :tmp = "Windows 2000"
End Select
Case Else
tmp = "unknown"
End Select
WindowsVersion = tmp
End Function
Function KillApps(strFilePath As String) As Long
If IsWinNT Then KillApps = KillAppsNT(strFilePath): Exit Function
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim ProcessID As Long
Dim hSnapshot As Long
Dim szExename As String
Dim i
Dim exitCode As Long
Dim myProcess As Long
Const TH32CS_SNAPPROCESS= 2&
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
i = Instr(1, uProcess.szexeFile, Chr(0))
szExename = Lcase$(Left$(uProcess.szexeFile, i - 1))
If Right$(szExename, Len(strFilePath)) = Lcase$(strFilePath) Then
myProcess = OpenProcess(PROCESS_ALL_ACCESS, False,
uProcess.th32ProcessID)
KillApps = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
KillApps = True
Exit Function
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
End Function
Function StrZToStr(pString As String) As String
StrZToStr = Left$(pString, Len(pString) - 1)
End Function
Function KillAppsNT(strFilePath As String) As Long
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim lProcessIDs() As Long
Dim cbNeeded2 As Long
Dim lNumElements2 As Long
Dim lModules(1 To 200) As Long
Dim lRet As Long
Dim exitCode As Long
Dim myProcess As Long
Dim strModuleName As String
'
Dim uProcess As PROCESSENTRY32 'This used only as a null UDT when we call DoAppsAction,
we can't make an optional parameter in a function as UDT !
'Dim exitCode As Long
'Dim myProcess As Long
Dim nSize As Long
Dim hProcess As Long
'
Dim szExename As String
'
'Dim AppKill As Boolean
'
Dim ProcessID As Long
Dim r, i, ThreadID
'Get the array containing the process id's for each process object
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
Redim lProcessIDs(cb / 4) As Long
lRet = EnumProcesses(lProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
'Get a handle to the Process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, lProcessIDs(i))
'Got a Process handle
If hProcess <> 0 Then
'Get an array of the module handles for the specified
'process
lRet = EnumProcessModules(hProcess, lModules(1), 200, _
cbNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lRet <> 0 Then
strModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, lModules(1), strModuleName,
nSize)
strModuleName = Left(strModuleName, lRet)
''''''''''''''
'Check for the client application running
szExename = Ucase(strModuleName)
If Right$(szExename, Len(strFilePath)) = Lcase$(strFilePath) Then
myProcess = OpenProcess(PROCESS_ALL_ACCESS, False,
lProcessIDs(i))
KillAppsNT = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
KillAppsNT = True
Exit Function
End If
End If
End If
'Close the handle to the process
lRet = CloseHandle(hProcess)
Next
End Function
Die Funktion KillAppsNT enthält bereits alles, um zu einer neuen Funfktion ProcessRunningNT ungebaut zu werden.
dazu muß einfach nur ab der Zeile
If Right$(szExename, Len(strFilePath)) = Lcase$(strFilePath) Then
myProcess = OpenProcess(PROCESS_ALL_ACCESS, False,
lProcessIDs(i))
ProcessRunningNT = True gesetzt werden.
Ich kann das, wie gesagt erst morgen in der Firma testen. sollte aber so funzen.
Hier noch die PSAPI.DLL
