Option Explicit



'API for close handle
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'Process APIs
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Private Declare Function Process32Next Lib "kernel32" _
(ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

Private Declare Function OpenProcess Lib "Kernel32.dll" _
(ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long

Private Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long

Private Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal ModuleName As String, ByVal nSize As Long) As Long

Private Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

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

'User defined types
'Process
Private Type PROCESSENTRY32
pe32Size As Long
pe32Usage As Long
pe32ProcessID As Long ' This process
pe32DefaultHeapID As Long
pe32ModuleID As Long ' Associated exe
pe32Threads As Long
pe32ParentProcessID As Long ' This process's parent process
pe32PriClassBase As Long ' Base priority of process threads
pe32Flags As Long
pe32ExeFile As String * 260 ' MAX_PATH
End Type

'Operating system
Private Type OSVERSIONINFO
oviOSVersionInfoSize As Long
oviMajorVersion As Long
oviMinorVersion As Long
oviBuildNumber As Long
oviPlatformId As Long '1 = Windows 95.
'2 = Windows NT
oviCSDVersion As String * 128
End Type

'Constants
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const lngNull = 0
Private Const PROCESS_TERMINATE = &H1& ' Used to kill a process

Private Function KillProgramme(strProgrammeName As String) As Boolean
'****************************************
'Purpose : Kill programme from process list
'Input : Programme name
'Output : -
'Date : 07.05.2002
'Author : Murat Aras
'****************************************

'Get windows version
Select Case GetVersion()

Case 1 'Windows 95/98

Dim lngReturn As Long 'Return value
Dim strName As String 'Process image name
Dim lngSnap As Long 'Snapshot value (smiling :-) )
Dim pe32Process As PROCESSENTRY32 'Process value

'Process snapshot (smiling :-))
lngSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)

'If nothing exit sub
If lngSnap = lngNull Then Exit Function

'Get process size
pe32Process.pe32Size = Len(pe32Process)
'Iterate through the processes
lngReturn = Process32First(lngSnap, pe32Process)
'Start do-loop to find our file
Do While lngReturn
'Prepear image name to match
strName = ClearString(pe32Process.pe32ExeFile)
strName = Trim(Replace(strName, Chr(0), ""))
'Is it our file
'If yes
If Right(strName, Len(strProgrammeName)) = strProgrammeName Then
'Kill it
If KillProcess(pe32Process.pe32ProcessID) Then KillProgramme = True
'Exit
Exit Function
End If
'If no, continue
lngReturn = Process32Next(lngSnap, pe32Process)
Loop

Case 2 'Windows NT

Dim lngCB As Long
Dim lngCBNeeded As Long
Dim lngNumElements As Long
Dim arrProcessIDs() As Long
Dim lngCBNeeded2 As Long
Dim arrModules(1 To 200) As Long
Dim lngReturn2 As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngProcess As Long
Dim lngCounter As Long

'Get the array containing the process id's for each process object
lngCB = 8
lngCBNeeded = 96
Do While lngCB <= lngCBNeeded
lngCB = lngCB * 2
ReDim arrProcessIDs(lngCB / 4) As Long
lngReturn2 = EnumProcesses(arrProcessIDs(1), lngCB, lngCBNeeded)
Loop
lngNumElements = lngCBNeeded / 4

'Start for - next
For lngCounter = 1 To lngNumElements
'Get a handle to the Process
lngProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, arrProcessIDs(lngCounter))
'Got a Process handle
If lngProcess <> 0 Then
'Get an array of the module handles for the specified process
lngReturn2 = EnumProcessModules(lngProcess, arrModules(1), 200, lngCBNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lngReturn2 <> 0 Then
'Prepear module name to match
strModuleName = Space(MAX_PATH)
lngSize = 500
lngReturn2 = GetModuleFileNameExA(lngProcess, arrModules(1), strModuleName, lngSize)
strModuleName = Trim(Replace(strModuleName, Chr(0), ""))
'Is it our file
'If yes
If Right(strModuleName, Len(strProgrammeName)) = strProgrammeName Then
'Hey yeaah, kill it man
If KillProcess(arrProcessIDs(lngCounter)) Then KillProgramme = True
'Operation completed , let's go
Exit Function
End If
End If
End If
'Close the handle to the process
lngReturn2 = CloseHandle(lngProcess)
'Return
Next

End Select

End Function

Private Function KillProcess(lProcessID As Long) As Boolean
'****************************************
'Purpose : Kill Target Dll
'Input : Targetdll.exe process id
'Output : -
'Date : 07.05.2002
'Author : Murat Aras
'****************************************

Dim lngHandle As Long 'Handle to a process
Dim lngReturn As Long 'Return value for API calls
Dim lngExitCode As Long 'Exit code

' First we need to create a handle to the desired process
lngHandle = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
' Get the process' exit code
lngReturn = GetExitCodeProcess(lngHandle, lngExitCode)
' Terminate the process! This might lead to screwy results, so be warned
lngReturn = TerminateProcess(lngHandle, lngExitCode)
' Close the handle
lngReturn = CloseHandle(lngHandle)
' Set function value
If lngReturn <> 0 Then KillProcess = True

End Function

Private Function ProgrammeIsRunning(strProgrammeName) As Long
'****************************************
'Purpose : Control programme is running
'Input : Programme name
'Output : if yes ; programme process id, else = 0
'Date : 07.05.2002
'Author : Murat Aras
'****************************************

Select Case GetVersion()

Case 1 'Windows 95/98

Dim lngReturn As Long
Dim strName As String
Dim lngSnap As Long
Dim pe32Process As PROCESSENTRY32

lngSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)

If lngSnap = lngNull Then Exit Function

pe32Process.pe32Size = Len(pe32Process)
' Iterate through the processes
lngReturn = Process32First(lngSnap, pe32Process)
Do While lngReturn
strName = ClearString(pe32Process.pe32ExeFile)
strName = Trim(Replace(strName, Chr(0), ""))
If Right(strName, Len(strProgrammeName)) = strProgrammeName Then
'Found
ProgrammeIsRunning = pe32Process.pe32ProcessID
'Exit
Exit Function
End If
lngReturn = Process32Next(lngSnap, pe32Process)
Loop

Case 2 'Windows NT

Dim lngCB As Long
Dim lngCBNeeded As Long
Dim lngNumElements As Long
Dim arrProcessIDs() As Long
Dim lngCBNeeded2 As Long
Dim lngNumElements2 As Long
Dim arrModules(1 To 200) As Long
Dim lngReturn2 As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngProcess As Long
Dim hProcess As Long

'Get the array containing the process id's for each process object
lngCB = 8
lngCBNeeded = 96
Do While lngCB <= lngCBNeeded
lngCB = lngCB * 2
ReDim arrProcessIDs(lngCB / 4) As Long
lngReturn2 = EnumProcesses(arrProcessIDs(1), lngCB, lngCBNeeded)
Loop
lngNumElements = lngCBNeeded / 4

For hProcess = 1 To lngNumElements
'Get a handle to the Process
lngProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, arrProcessIDs(hProcess))
'Got a Process handle
If lngProcess <> 0 Then
'Get an array of the module handles for the specified process
lngReturn2 = EnumProcessModules(lngProcess, arrModules(1), 200, lngCBNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lngReturn2 <> 0 Then
strModuleName = Space(MAX_PATH)
lngSize = 500
lngReturn2 = GetModuleFileNameExA(lngProcess, arrModules(1), strModuleName, lngSize)
strModuleName = Trim(Replace(strModuleName, Chr(0), ""))
If Right(strModuleName, Len(strProgrammeName)) = strProgrammeName Then
'Found
ProgrammeIsRunning = arrProcessIDs(hProcess)
'Exit
Exit Function
End If
End If
End If
'Close the handle to the process
lngReturn2 = CloseHandle(lngProcess)
Next

End Select

End Function

Function ClearString(strString As String) As String
'****************************************
'Purpose : Remove null character and clear the string
'Input : String
'Output : String
'Date : 07.05.2002
'Author : Murat Aras
'****************************************

ClearString = Left$(strString, Len(strString) - 1)

End Function

Private Function GetVersion() As Long
'****************************************
'Purpose : Get windows version
'Input : -
'Output : Windows version
'Date : 07.05.2002
'Author : Murat Aras
'****************************************

Dim oviOSInfo As OSVERSIONINFO
Dim lngReturn As Integer

oviOSInfo.oviOSVersionInfoSize = 148
oviOSInfo.oviCSDVersion = Space$(128)
lngReturn = GetVersionExA(oviOSInfo)
GetVersion = oviOSInfo.oviPlatformId

End Function





Private Sub Command1_Click()

If ProgrammeIsRunning("winamp.exe") = 0 Then
MsgBox "Calculator programı açık değil!"
Else
If KillProgramme("winamp.exe") Then
MsgBox "Winamp programı kapatıldı!"
Else
MsgBox "Winamp programı kapatılamadı!"
End If
End If
End Sub