uses
WbemScripting_TLB,
ActiveX;
type
TProcesInformation =
packed record
Name:
string;
Path:
string;
ProcID: DWORD;
ParentProcID: DWORD;
SessionID: DWORD;
ThreadCount: DWORD;
Priority: DWORD;
end;
type
TPIArray =
array of TProcesInformation;
const
WMI_HOST_COMPUTER = '
.';
WMI_SYSTEM_NAMESPACE = '
root\CIMV2';
WMI_CLASS_NIC = '
Win32_Process';
WMI_ATTRIB_CAPTION = '
Name';
WMI_ATTRIB_PATH = '
ExecutablePath';
WMI_ATTRIB_PROCID = '
ProcessID';
WMI_ATTRIB_PARENT_PROCID = '
ParentProcessId';
WMI_ATTRIB_SESSIONID = '
SessionID';
WMI_ATTRIB_THREAD_CNT = '
ThreadCount';
WMI_ATTRIB_PRIORITY = '
Priority';
function WMIEnumProcesses(Computer, User, Password:
string): TPIArray;
function GetCompName:
string;
var
Buf :
array[0..MAX_COMPUTERNAME_LENGTH]
of Char;
Size : DWORD;
begin
Size := SizeOf(Buf);
if GetComputerName(Buf, Size)
then
Result := Buf
else
Result := '
';
end;
var
FComputer:
String;
FUser:
String;
FPassword:
String;
Locator : ISWbemLocator;
Services : ISWbemServices;
ObjectDefinition: ISWbemObject;
ObjectSet : SWbemObjectSet;
ObjectInstances: IEnumVariant;
WMIObject : ISWbemObject;
PropertySet : ISWbemPropertySet;
WMIProperty : ISWbemProperty;
TempObj : OleVariant;
ObjValue : Cardinal;
i : Integer;
resourcestring
rsWMIError = '
WMI-Fehler';
begin
if AnsiUpperCase(GetCompName) = AnsiUpperCase(Computer)
then
begin
FComputer := '
';
FUser := '
';
FPassword := '
';
end
else
begin
FComputer := Computer;
FUser := user;
FPassword := Password;
end;
i := 0;
Locator := CoSWbemLocator.CreateRemote(Computer);
try
try
Services := Locator.ConnectServer(FComputer, WMI_SYSTEM_NAMESPACE,
FUser, FPassword, '
', '
', 0,
nil);
if Services <>
nil then
begin
Services.Security_.Set_ImpersonationLevel(wbemImpersonationLevelImpersonate);
Services.Security_.Privileges.Add(wbemPrivilegeDebug, True);
ObjectDefinition := Services.Get(WMI_CLASS_NIC,
wbemFlagUseAmendedQualifiers,
nil);
ObjectSet := ObjectDefinition.Instances_(0,
nil);
ObjectInstances := (ObjectSet._NewEnum)
as IEnumVariant;
while (ObjectInstances.Next(1, TempObj, ObjValue) = S_OK)
do
begin
WMIObject := IUnknown(TempObj)
as SWBemObject;
PropertySet := WMIObject.Properties_;
setlength(result, length(result) + 1);
WMIProperty := PropertySet.Item(WMI_ATTRIB_CAPTION, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].
Name := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_PATH, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].Path := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_PROCID, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].ProcID := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_PARENT_PROCID, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].ParentProcID := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_SESSIONID, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].SessionID := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_THREAD_CNT, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].ThreadCount := WMIProperty.Get_Value;
WMIProperty := PropertySet.Item(WMI_ATTRIB_PRIORITY, 0);
if not VarIsNull(WMIProperty.Get_Value)
then
result[i].Priority := WMIProperty.Get_Value;
Inc(i);
end;
end;
finally
Locator :=
nil;
Services :=
nil;
end;
except
on e:
Exception do
raise e.Create(e.
message);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
PIArray : TPIArray;
i : Integer;
NewItem : TListItem;
resourcestring
rsPorcsCnt = '
Prozesse: %d';
begin
PIArray :=
nil;
Listview1.Items.Clear;
try
PIArray := WMIEnumProcesses(edtComputer.Text, edtUser.Text, edtPW.Text);
Listview1.Items.BeginUpdate;
for i := 0
to length(PIArray) - 1
do
begin
NewItem := Listview1.Items.Add;
NewItem.Caption := PIArray[i].
Name;
NewItem.SubItems.Add(PIArray[i].Path);
NewItem.SubItems.Add(IntToStr(PIArray[i].ProcID));
NewItem.SubItems.Add(IntToStr(PIArray[i].ParentProcID));
NewItem.SubItems.Add(IntToStr(PIArray[i].SessionID));
NewItem.SubItems.Add(IntToStr(PIArray[i].ThreadCount));
NewItem.SubItems.Add(IntToStr(PIArray[i].Priority));
end;
Listview1.Items.EndUpdate;
Statusbar1.SimpleText := Format(rsPorcsCnt, [length(PIArray)]);
except
on e:
Exception do
begin
NewItem := Listview1.Items.Add;
NewItem.Caption := e.
Message;
end;
end;
end;