Prozesse eines PCs im Netzwerk auflisten

[Matze]

Michael hat hier einen Code veröffentlicht, um die Prozesse, die auf einem PC, der im Netzwerk angeschlossen ist, aktiv sind, auflisten zu lassen.

Für dieses Beispiel benötigt ihr eine TListView, eine TStatusBar (jeweils Register Win32), drei TEdits (Name 1: edtComputer, Name 2: edtUser, Name 3: edtPW) und einen TButton. Zusätzlich benötigt man die Unit WbemScripting.pas. Diese könnt ihr entweder direkt im Anhnag herunterladen oder auch über Delphi selbst importieren.

Delphi-Quellcode:

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;