unit kzProc;
interface
uses
Winapi.Windows,
Winapi.Messages,
Winapi.PsAPI,
Winapi.TlHelp32,
System.Classes, System.SysUtils;
type
TPIDList =
array of DWORD;
TProcessInfo =
packed record
PID: Cardinal;
Parent: Cardinal;
Filename:
string;
Filepath:
string;
Owner:
string;
ClassName:
string;
Threads: Cardinal;
Modules: Cardinal;
Priority: Cardinal;
Memory: SIZE_T;
Version:
string;
end;
TProcesses =
array of TProcessInfo;
TGetProcessesEvent =
procedure(Sender: TObject; Processes: TProcesses)
of object;
TGetProcesses =
class(TThread)
private
FOnChange: TGetProcessesEvent;
public
property OnChange: TGetProcessesEvent
read FOnChange
write FOnChange;
procedure Execute;
override;
end;
TkzProcessEvent =
procedure(Sender: TObject)
of object;
TkzProcess =
class(TPersistent)
strict private
FPreviousDebugState: Boolean;
FProcesses: TProcesses;
FHasProcesses: Boolean;
FIsBusy: Boolean;
FGetProcessThread: TGetProcesses;
protected
procedure DoOnGetProcesses(Sender: TObject; Processes: TProcesses);
private
FOnChange: TkzProcessEvent;
public
constructor Create;
destructor Destroy;
override;
procedure Refresh;
function KillProcess(PID: DWORD; Wait: DWORD): Boolean;
public
property OnGetProcesses: TkzProcessEvent
read FOnChange
write FOnChange;
property IsBusy: Boolean
read FIsBusy;
property Processes: TProcesses
read FProcesses;
property HasProcesses: Boolean
read FHasProcesses;
end;
// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(
const APName:
string): THandle;
// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(
const APName:
string): THandle;
// Get Window Handle By ProcessID
function GetHWndByPID(
const hPID: THandle): THandle;
// Get ProcessID By Window Handle
function GetPIDByHWnd(
const hWnd: THandle): THandle;
// Get Process Handle By Window Handle
function GetProcessHndByHWnd(
const hWnd: THandle): THandle;
// Get Process Handle By Process ID
function GetProcessHndByPID(
const hAPID: THandle): THandle;
implementation
// Get Window Handle By ProgramName (Include Path or Not Include)
function GetHWndByProgramName(
const APName:
string): THandle;
begin
Result := GetHWndByPID(GetPIDByProgramName(APName));
end;
// Get Process Handle By Window Handle
function GetProcessHndByHWnd(
const hWnd: THandle): THandle;
var
PID: DWORD;
AhProcess: THandle;
begin
if hWnd <> 0
then
begin
GetWindowThreadProcessID(hWnd, @PID);
AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, PID);
Result := AhProcess;
CloseHandle(AhProcess);
end
else
Result := 0;
end;
// Get Process Handle By Process ID
function GetProcessHndByPID(
const hAPID: THandle): THandle;
var
AhProcess: THandle;
begin
if hAPID <> 0
then
begin
AhProcess := OpenProcess(PROCESS_ALL_ACCESS, false, hAPID);
Result := AhProcess;
CloseHandle(AhProcess);
end
else
Result := 0;
end;
// Get Window Handle By ProcessID
function GetPIDByHWnd(
const hWnd: THandle): THandle;
var
PID: DWORD;
begin
if hWnd <> 0
then
begin
GetWindowThreadProcessID(hWnd, @PID);
Result := PID;
end
else
Result := 0;
end;
// Get Window Handle By ProcessID
function GetHWndByPID(
const hPID: THandle): THandle;
type
PEnumInfo = ^TEnumInfo;
TEnumInfo =
record
ProcessID: DWORD;
HWND: THandle;
end;
function EnumWindowsProc(Wnd: DWORD;
var EI: TEnumInfo): BOOL;
stdcall;
var
PID: DWORD;
begin
GetWindowThreadProcessID(Wnd, @PID);
Result := (PID <> EI.ProcessID)
or (
not IsWindowVisible(WND))
or (
not IsWindowEnabled(WND));
if not Result
then
EI.HWND := WND;
//break on return FALSE
end;
function FindMainWindow(PID: DWORD): DWORD;
var
EI: TEnumInfo;
begin
EI.ProcessID := PID;
EI.HWND := 0;
// EnumWindows(@EnumWindowsProc, Integer(@EI));
EnumWindows(@EnumWindowsProc, LPARAM(@EI));
Result := EI.HWND;
end;
begin
if hPID <> 0
then
Result := FindMainWindow(hPID)
else
Result := 0;
end;
// Get ProcessID By ProgramName (Include Path or Not Include)
function GetPIDByProgramName(
const APName:
string): THandle;
var
isFound: boolean;
AHandle, AhProcess: THandle;
ProcessEntry32: TProcessEntry32;
APath:
array[0..MAX_PATH]
of char;
begin
Result := 0;
AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
isFound := Process32First(AHandle, ProcessEntry32);
while isFound
do
begin
AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ,
false, ProcessEntry32.th32ProcessID);
GetModuleFileNameEx(AhProcess, 0, @APath[0], sizeof(APath));
if (UpperCase(StrPas(APath)) = UpperCase(APName))
or
(UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName))
then
begin
Result := ProcessEntry32.th32ProcessID;
break;
end;
isFound := Process32Next(AHandle, ProcessEntry32);
CloseHandle(AhProcess);
end;
finally
CloseHandle(AHandle);
end;
end;
function GetSecurityInfo(
handle: THandle; ObjectType: DWord; SecurityInfo: SECURITY_INFORMATION; ppsidOwner: PSID; ppsidGroup: PSID; ppDacl: PACL; ppSacl: PACL; ppSecurityDescriptor: PSECURITY_DESCRIPTOR): DWORD;
stdcall;
external '
advapi32.dll';
//function ConvertSidToStringSid(SID: PSID; var StringSid: PWideChar): Boolean; stdcall; external 'advapi32.dll' name 'ConvertSidToStringSidW';
//function ConvertStringSidToSid(StringSid: PWideChar; var Sid: PSID): Boolean; stdcall; external 'advapi32.dll' name 'ConvertStringSidToSidW';
function SidToString(ASID: PSID): WideString;
var
sDummy : PWideChar;
begin
ConvertSidToStringSid(ASID, sDummy);
Result :=
string(sDummy);
end;
function StrSIDToName(
const StrSID: Widestring;
var Name: WideString;
var SIDType: DWORD): Boolean;
var
SID : PSID;
Buffer, Temp : PWideChar;
NameLen, TempLen : Cardinal;
succes : Boolean;
begin
SID :=
nil;
succes := ConvertStringSIDToSID(PWideChar(StrSID), SID);
if succes
then
begin
NameLen := 0;
TempLen := 0;
LookupAccountSidW(
nil, SID,
nil, NameLen,
nil, TempLen, SIDType);
if NameLen > 0
then
begin
GetMem(Buffer, NameLen * sizeOf(WideChar));
GetMem(Temp, TempLen * sizeof(WideChar));
try
succes := LookupAccountSidW(
nil, SID, Buffer, NameLen, Temp, TempLen, SIDType);
if succes
then
begin
Name := WideString(Buffer);
end;
finally
FreeMem(Buffer);
FreeMem(Temp);
end;
end;
LocalFree(Cardinal(SID));
end;
result := succes;
end;
function EnablePrivilege(
const Privilege:
string; fEnable: Boolean;
out PreviousState: Boolean): Boolean;
var
ok : Boolean;
Token : THandle;
NewState : TTokenPrivileges;
Luid : TLargeInteger;
PrevState : TTokenPrivileges;
Return : DWORD;
begin
PreviousState := True;
if (GetVersion() > $80000000)
then // Win9x
Result := True
else // WinNT
begin
ok := OpenProcessToken(GetCurrentProcess(), MAXIMUM_ALLOWED, Token);
if ok
then
begin
try
ok := LookupPrivilegeValue(
nil, PChar(Privilege), Luid);
if ok
then
begin
NewState.PrivilegeCount := 1;
NewState.Privileges[0].Luid := Luid;
if fEnable
then
NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
NewState.Privileges[0].Attributes := 0;
ok := AdjustTokenPrivileges(Token, False, NewState, SizeOf(TTokenPrivileges), PrevState, Return);
if ok
then
begin
PreviousState := (PrevState.Privileges[0].Attributes
and SE_PRIVILEGE_ENABLED <> 0);
end;
end;
finally
CloseHandle(Token);
end;
end;
Result := ok;
end;
end;
procedure TGetProcesses.Execute;
function _GetClassName(
const AValue:
string):
string;
var
ClassName:
string;
LhWnd: THandle;
begin
LhWnd := GetHWndByProgramName(AValue);
SetLength(ClassName, 255);
//get the class name and reset the
//memory area to the size of the name
SetLength(ClassName, GetClassName(LhWnd, PChar(className), Length(className)));
Result := ClassName;
if Result = '
'
then
Result := Integer(LhWnd).ToString;
end;
function GetMemory(
const APID: DWORD): SIZE_T;
var
hProcess: THandle;
PMC: PPROCESS_MEMORY_COUNTERS;
cb: DWORD;
begin
Result := 0;
cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(PMC, cb);
try
PMC^.cb := cb;
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, APID);
begin
if ( hProcess = 0 )
then
Exit;
if ( GetProcessMemoryInfo(hProcess, PMC, SizeOf(PMC^)) )
then
Result := (PMC^.WorkingSetSize
Div 1024)
else
Result := 0;
end;
finally
CloseHandle(hProcess);
FreeMem(PMC, SizeOf(_PROCESS_MEMORY_COUNTERS));
end;
end;
function GetPriority(
const APID: DWORD): DWORD;
var
hProcess : THandle;
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or GENERIC_READ, False, APID);
if (hProcess <> 0)
then
begin
Result := GetPriorityClass(hProcess);
CloseHandle(hProcess);
end
else
Result := 0;
end;
function GetParentPID(
const APID: DWORD): DWORD;
const
BufferSize = 4096;
var
HandleSnapShot : THandle;
EntryParentProc : TProcessEntry32;
HandleParentProc: THandle;
ParentProcessId : DWORD;
ParentProcessFound : Boolean;
ParentProcPath :
String;
begin
Result := 0;
ParentProcessFound := False;
HandleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
//enumerate the process
if HandleSnapShot <> INVALID_HANDLE_VALUE
then
begin
EntryParentProc.dwSize := SizeOf(EntryParentProc);
if Process32First(HandleSnapShot, EntryParentProc)
then //find the first process
begin
repeat
if EntryParentProc.th32ProcessID = APID
then
begin
ParentProcessId := EntryParentProc.th32ParentProcessID;
//get the id of the parent process
HandleParentProc := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, ParentProcessId);
if HandleParentProc <> 0
then
begin
ParentProcessFound := True;
CloseHandle(HandleParentProc);
end;
Break;
end;
until not Process32Next(HandleSnapShot, EntryParentProc);
end;
CloseHandle(HandleSnapShot);
end;
if ParentProcessFound
then
Result := ParentProcessId
else
Result := 0;
end;
function GetVersion(
const Filename:
string):
string;
type
PDWORDArr = ^DWORDArr;
DWORDArr =
array[0..0]
of DWORD;
var
VerInfoSize : DWORD;
VerInfo : Pointer;
VerValueSize : DWORD;
VerValue : PVSFixedFileInfo;
LangID : DWORD;
begin
result := '
';
VerInfoSize := GetFileVersionInfoSizeW(PWideChar(Filename), LangID);
if VerInfoSize <> 0
then
begin
VerInfo := Pointer(GlobalAlloc(GPTR, VerInfoSize * 2));
if Assigned(VerInfo)
then
try
if GetFileVersionInfoW(PWideChar(Filename), 0, VerInfoSize, VerInfo)
then
begin
if VerQueryValueW(VerInfo, '
\', Pointer(VerValue), VerValueSize)
then
begin
with VerValue^
do
begin
result := Format('
%d.%d.%d.%d', [dwFileVersionMS
shr 16, dwFileVersionMS
and $FFFF,
dwFileVersionLS
shr 16, dwFileVersionLS
and $FFFF]);
end;
end
else
result := '
';
end;
finally
GlobalFree(THandle(VerInfo));
end;
end;
end;
function GetThreads(
const APID: DWORD): DWORD;
var
hSnapShot : Thandle;
pe32 : TProcessEntry32W;
begin
Result := 0;
hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapShot <> INVALID_HANDLE_VALUE
then
begin
pe32.dwSize := SizeOf(TProcessEntry32W);
if not Process32FirstW(hSnapShot, pe32)
then
begin
CloseHandle(hSnapShot);
end
else
repeat
if APID = pe32.th32ProcessID
then
begin
Result := pe32.cntThreads;
Break;
end;
until not Process32NextW(hSnapShot, pe32);
CloseHandle(hSnapShot);
end;
end;
function GetModulePath(
const APID: DWORD):
string;
var
hSnapShot : Thandle;
hModuleSnapShot : THandle;
pe32 : TProcessEntry32W;
me32 : TModuleEntry32W;
begin
hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, APID);
if hSnapShot <> INVALID_HANDLE_VALUE
then
begin
pe32.dwSize := SizeOf(TProcessEntry32W);
if not Process32FirstW(hSnapShot, pe32)
then
begin
CloseHandle(hSnapShot);
end
else
begin
if APID <> 0
then // Process 0 is no real process!
begin
hModuleSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, APID);
if hModuleSnapShot <> INVALID_HANDLE_VALUE
then
begin
me32.dwSize := SizeOf(TModuleEntry32W);
if Module32FirstW(hModuleSnapShot, me32)
then
begin
Result := me32.szExePath;
end
else
begin
Result := '
';
CloseHandle(hModuleSnapShot);
end;
CloseHandle(hModuleSnapShot);
end
else
Result := '
';
end;
end;
CloseHandle(hSnapShot);
end;
end;
function GetModules(
const APID: DWORD): DWORD;
var
hProcess : THandle;
ModuleList :
array[0..1024]
of DWORD;
cbNeeded : DWORD;
begin
cbNeeded := 0;
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, APID);
if hProcess <> 0
then
begin
if EnumProcessModules(hProcess, @ModuleList, SizeOf(ModuleList), cbNeeded)
then
begin
Result := cbNeeded
div SizeOf(DWORD);
end
else
begin
Result := 0;
end;
CloseHandle(hProcess);
end
else
begin
Result := 0;
end;
end;
function GetOwnerName(
const APID: DWORD):
string;
var
hProcess : THandle;
ppsidOwner : PSID;
SecDescriptor : PSECURITY_DESCRIPTOR;
err : DWord;
s :
string;
SIDType : DWORD;
Owner : WideString;
const
SE_UNKNOWN_OBJECT_TYPE: DWord = 0;
SE_FILE_OBJECT : DWord = 1;
SE_SERVICE : DWord = 2;
SE_PRINTER : DWord = 3;
SE_REGISTRY_KEY : DWord = 4;
SE_LMSHARE : DWord = 5;
SE_KERNEL_OBJECT : DWord = 6;
SE_WINDOW_OBJECT : DWord = 7;
begin
Owner := '
';
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or GENERIC_READ, False, APID);
if (hProcess <> 0)
then
begin
err := GetSecurityInfo(hProcess, SE_KERNEL_OBJECT, OWNER_SECURITY_INFORMATION, @ppsidOwner,
nil,
nil,
nil, @SecDescriptor);
if (err = 0)
then
begin
s := SidToString(ppsidOwner);
StrSIDToName(s, Owner, SIDType);
LocalFree(Cardinal(SecDescriptor));
end;
CloseHandle(hProcess);
end;
Result := Owner;
end;
function GetProcessName(PID: DWORD;
var ProcessName:
string): DWORD;
var
dwReturn : DWORD;
hProc : Cardinal;
buffer :
array[0..MAX_PATH - 1]
of Char;
begin
dwReturn := 0;
Zeromemory(@buffer, sizeof(buffer));
hProc := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, FALSE, PID);
if hProc <> 0
then
begin
GetModulebaseName(hProc, 0, buffer, sizeof(buffer));
ProcessName := (
string(buffer));
CloseHandle(hProc);
end
else
dwReturn := GetLastError;
result := dwReturn;
end;
var
ProcessList: TPIDList;
PidProcess: PDWORD;
cb: DWORD;
cbNeeded: DWORD;
BufferSize: Cardinal;
dwReturn: DWORD;
cntProcesses: Cardinal;
PidWork: PDWORD;
i: Cardinal;
ProcessName:
string;
LPID: DWORD;
LProcesses: TProcesses;
LPreviousDebugState: Boolean;
begin
EnablePrivilege('
SeDebugPrivilege', True, LPreviousDebugState);
cbNeeded := 0;
BufferSize := 1024;
GetMem(PidProcess, BufferSize);
// make sure memory is allocated
if Assigned(PidProcess)
then
begin
try
// enumerate the processes
if EnumProcesses(PidProcess, BufferSize, cbNeeded)
then
begin
dwReturn := 0;
cntProcesses := cbNeeded
div sizeof(DWORD) - 1;
PidWork := PidProcess;
SetLength(ProcessList, cntProcesses);
// walk the processes
for i := 0
to cntProcesses - 1
do
begin
ProcessList[i] := PidWork^;
Inc(PidWork);
end;
end
else // EnumProcesses = False
dwReturn := GetLastError;
finally
// clean up no matter what happend
FreeMem(PidProcess, BufferSize);
end;
end
else // GetMem = nil
dwReturn := GetLastError;
SetLength(LProcesses, Length(ProcessList));
for i := 0
to Length(ProcessList) - 1
do
begin
LPID := ProcessList[i];
LProcesses[i].PID := LPID;
if (GetProcessName(LPID, ProcessName) <> 0)
then
ProcessName := '
Unknown';
LProcesses[i].Parent := GetParentPID(LPID);
LProcesses[i].Filename := ProcessName;
LProcesses[i].Owner := GetOwnerName(LPID);
// LProcesses[i].ClassName := _GetClassName(LPID);
// LProcesses[i].ClassName := _GetClassName(ProcessName);
LProcesses[i].Modules := GetModules(LPID);
LProcesses[i].Filepath := GetModulePath(LPID);
if (Length(LProcesses[i].Filepath) > 0)
then
LProcesses[i].Version := GetVersion(LProcesses[i].Filepath);
LProcesses[i].Threads := GetThreads(LPID);
LProcesses[i].Priority := GetPriority(LPID);
end;
SetLength(ProcessList, 0);
Synchronize(
procedure
begin
if Assigned(FOnChange)
then
FOnChange(Self, LProcesses);
end);
SetLength(LProcesses, 0);
EnablePrivilege('
SeDebugPrivilege', LPreviousDebugState, LPreviousDebugState);
end;
constructor TkzProcess.Create;
begin
inherited Create;
EnablePrivilege('
SeDebugPrivilege', True, FPreviousDebugState);
Self.Refresh;
Self.Refresh;
end;
destructor TkzProcess.Destroy;
begin
inherited Destroy;
EnablePrivilege('
SeDebugPrivilege', FPreviousDebugState, FPreviousDebugState);
end;
procedure TkzProcess.DoOnGetProcesses(Sender: TObject; Processes: TProcesses);
begin
FProcesses := Processes;
FHasProcesses := (Length(FProcesses) > 0);
FIsBusy := False;
if Assigned(FOnChange)
then
FOnChange(Self);
end;
procedure TkzProcess.Refresh;
begin
FGetProcessThread := TGetProcesses.Create(False);
try
FIsBusy := True;
FHasProcesses := False;
FGetProcessThread.OnChange := Self.DoOnGetProcesses;
FGetProcessThread.FreeOnTerminate := True;
FGetProcessThread.Execute;
finally
FGetProcessThread.Terminate;
end;
end;
function TkzProcess.KillProcess(PID: DWORD; Wait: DWORD): Boolean;
var
hProcess: THandle;
wfso: DWORD;
begin
hProcess := OpenProcess(SYNCHRONIZE
or PROCESS_TERMINATE, False, PID);
if (hProcess <> 0)
then
begin
if TerminateProcess(hProcess, 1)
then
begin
// TerminateProcess returns immediately, verify if we have killed the process
wfso := WaitForSingleObject(hProcess, Wait);
Result := (
not wfso = WAIT_FAILED);
end
else
Result := False;
end
else
Result := False;
end;
end.