soo, ich habe es:
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 ProcessRunning("notepad.exe")
End Sub
Function ProcessRunning(Byval Filename As String) As Variant
If IsWinNT Then ProcessRunning = ProcessRunningNT(FileName): Exit Function
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 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
lRet = EnumProcessModules(hProcess, lModules(1), 200, _
cbNeeded2)
If lRet <> 0 Then
strModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, lModules(1), strModuleName, nSize)
strModuleName = Left(strModuleName, lRet)
szExename = Ucase(strModuleName)
'Msgbox Right$(szExename, Len(strFilePath))
If Right$(szExename, Len(strFilePath)) = Ucase$(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
lRet = CloseHandle(hProcess)
Next
End Function
Function IsWinNT() As Variant
IsWinNt = False
If WindowsVersion = "Windows NT 4.0" Then IsWinNt = True
End Function
Function ProcessRunningNT(strFilePath As String) As Variant
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
Dim nSize As Long
Dim hProcess As Long
Dim szExename As String
Dim ProcessID As Long
Dim r, i, ThreadID
cb = 8
cbNeeded = 96
ProcessRunningNT = False
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
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, lProcessIDs(i))
If hProcess <> 0 Then
lRet = EnumProcessModules(hProcess, lModules(1), 200, _
cbNeeded2)
If lRet <> 0 Then
strModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, lModules(1), strModuleName, nSize)
strModuleName = Left(strModuleName, lRet)
szExename = Ucase(strModuleName)
' If Instr(1,Ucase(uProcess.szExeFile), Ucase(Filename), 0 ) > 0 Then
If Instr (1, Right$(szExename, Len(strFilePath)) ,Ucase$(strFilePath),0) > 0 Then
ProcessRunningNT= True
Exit Function
End If
End If
End If
lRet = CloseHandle(hProcess)
Next
End Function
Ulrich
Thema: Word-Dokument aus Notes drucken und schließen (Gelesen 5411 mal)