unit Process;
interface
uses
windows,tlhelp32;
type
tprocessarray=array
of tprocessentry32;
procedure actprocesses;
var
processes:tprocessarray;
implementation
function EnableDebugPrivileges(bEnable: Boolean;
var PreviousState: Boolean): DWORD;
const
SE_DEBUG_NAME = '
SeDebugPrivilege';
var
Token: THandle;
NewState: TTokenPrivileges;
Luid: TLargeInteger;
PrevState: TTokenPrivileges;
Return: DWORD;
begin
PreviousState := TRUE;
if (GetVersion() > $80000000)
then
// Win9x
Result := ERROR_SUCCESS
else
begin
// WinNT
if not OpenProcessToken(GetCurrentProcess(), MAXIMUM_ALLOWED, Token)
then
Result := GetLastError()
else
try
if not LookupPrivilegeValue(
nil, SE_DEBUG_NAME, Luid)
then
Result := GetLastError()
else
begin
NewState.PrivilegeCount := 1;
NewState.Privileges[0].Luid := Luid;
if bEnable
then
NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
NewState.Privileges[0].Attributes := 0;
if not AdjustTokenPrivileges(Token, False, NewState,
SizeOf(TTokenPrivileges), PrevState, Return)
then
Result := GetLastError()
else
begin
Result := ERROR_SUCCESS;
PreviousState := (PrevState.Privileges[0].Attributes
and SE_PRIVILEGE_ENABLED <> 0);
end;
end;
finally
CloseHandle(Token);
end;
end;
end;
function Getprocesses(
var processes:tprocessarray): Integer;
var
hSnapShot : Cardinal;
pe32 : TProcessEntry32;
cntP : Integer;
v : boolean;
begin
setlength(processes,0);
EnableDebugPrivileges(true,v);
result := 0;
hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if hSnapShot <> 0
then
begin
ZeroMemory(@pe32, sizeof(pe32));
pe32.dwSize := sizeof(ProcessEntry32);
cntP := 0;
if Process32First(hSnapShot, pe32) = true
then
begin
while Process32Next(hSnapShot, pe32) = true
do
begin
setlength(processes,length(processes)+1);
processes[length(processes)-1]:=pe32;
Inc(cntP);
end;
result := cntP;
end;
end;
EnableDebugPrivileges(false,v);
end;
procedure actprocesses;
begin
getprocesses(processes);
end;
initialization
getprocesses(processes);
end.