控制台编程

开发平台：
Delphi

ProcessNotify.pas：源码内容
							unit ProcessNotify;
interface
uses
  Windows, SysUtils, Classes, TLHelp32, PSApi;
type
   EProcessNotifyError = class(Exception);
   TProcessNotifyEvent = procedure(Sender :TObject; const ProcessInfo :TProcessEntry32)
      of object;
   TOnProcessCreated   = procedure(StrInfo:string) of Object;
   TOnProcessTerminated= procedure(StrInfo:string) of Object;
   TProcessNotify = class(TComponent)
   private
      FPollInterval  :Integer;
      FPollThread    :TThread;
      FAsyncNotify   :Boolean;
      FEnabled       :Boolean;
      FOnProcessCreated:TOnProcessCreated;
      FOnProcessTerminated:TOnProcessTerminated;
      procedure SetPollInterval(Value :Integer);
      function GetPollPriority :TThreadPriority;
      procedure SetPollPriority(Value :TThreadPriority);
      procedure SetEnabled(Value :Boolean);
   protected
      procedure Loaded; override;
      procedure ProcessCreated(const ProcessInfo :TProcessEntry32); virtual;
      procedure ProcessTerminated(const ProcessInfo :TProcessEntry32); virtual;
   public
      constructor Create(Aowner :TComponent); override;
      destructor Destroy; override;
   published
      property AsyncNotify :Boolean
         read FAsyncNotify write FAsyncNotify;
      property Enabled :Boolean
         read FEnabled write SetEnabled;
      property PollInterval :Integer
         read FPollInterval write SetPollInterval;
      property PollPriority :TThreadPriority
         read GetPollPriority write SetPollPriority;
      property OnProcessCreated     :TOnProcessCreated
        read FOnProcessCreated write FOnProcessCreated;
      property OnProcessTerminated  :TOnProcessTerminated
        read FOnProcessTerminated write FOnProcessTerminated;
   end;
implementation
type
   TProcessList = class(TList)
   private
      function GetEntries(Index :Integer):TPROCESSENTRY32;
      function GetIndexOfProcessID(ID :THandle):Integer;
      function GetProcessIDs(Index :Integer):Integer;
      function GetTags(Index :Integer):Integer;
      procedure SetTags(Index, Value :Integer);
   protected
      procedure ValidateIndex(Index :Integer);
   public
      destructor Destroy; override;
      procedure DeleteEntry(Index :Integer);
      procedure AddEntry(const AEntry :TPROCESSENTRY32);
      property Entries[Index :Integer] :TPROCESSENTRY32
         read GetEntries;
      property ProcessIDs[Index :Integer] :Integer
         read GetProcessIDs;
      property IndexOfProcessID[ID :cardinal] :Integer
         read GetIndexOfProcessID;
      property Tags[Index :Integer] :Integer
         read GetTags write SetTags;
   end;
   TPollThread = class(TThread)
   private
      FOwner :TProcessNotify;
      FProcessList :TProcessList;
      FEntry       :TProcessEntry32;
      procedure DoProcessCreated;
      procedure DoProcessTerminated;
   protected
      procedure Execute; override;
      procedure DoTerminate; override;
   public
      constructor Create(AOwner :TProcessNotify);
   end;
const
   sErrInvalidInterval      = 'Invalid poll interval value';
   sErrIndexOutOfBounds     = 'Index out of bounds';
{ TPollThread }
procedure TPollThread.DoProcessCreated;
begin
   FOwner.ProcessCreated(FEntry);
end;
procedure TPollThread.DoProcessTerminated;
begin
   FOwner.ProcessTerminated(FEntry);
end;
procedure TPollThread.Execute;
var
   S:THandle;
   I:Integer;
   R:Bool;
begin
   while not Terminated do
      with FProcessList do
      begin
         //sleep(FOwner.FPollInterval);
         sleep(1);
         for I := 0 to Count-1 do Tags[I] := 0;
         S := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
         if S <> -1 then
         try
            FEntry.dwSize := sizeof(FEntry);
            R := Process32First(S, FEntry);
            while R do
            begin
               I := IndexOfProcessID[FEntry.th32ProcessID];
               if I < 0 then
               begin
                  AddEntry(FEntry);
                  Tags[FProcessList.Count-1] := 1;
                  if FOwner.FAsyncNotify then
                     FOwner.ProcessCreated(FEntry)
                  else
                     Synchronize(DoProcessCreated);
               end
               else
                  Tags[I] := 1;
               FEntry.dwSize := sizeof(FEntry);
               R := Process32Next(S, FEntry);
            end;
         finally
            CloseHandle(S);
         end;
         for I := Count-1 downto 0 do
         begin
            if Tags[I] = 0 then
            begin
               FEntry := Entries[I];
               if FOwner.FAsyncNotify then
                  FOwner.ProcessTerminated(FEntry)
               else
                  Synchronize(DoProcessTerminated);
               DeleteEntry(I);
            end;
         end;
   end;
end;
constructor TPollThread.Create(AOwner :TProcessNotify);
var
   S :Thandle;
   R :Bool;
begin
   assert(assigned(AOwner));
   inherited Create(true);
   FOwner := AOwner;
   S := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   try
      FEntry.dwSize := sizeof(FEntry);
      FProcessList := TProcessList.Create;
      R := Process32First(S, FEntry);
      while R do
      with FProcessList do
      begin
         AddEntry(FEntry);
         Tags[Count-1] := 0;
         R := Process32Next(S, FEntry);
      end;
   finally
      CloseHandle(S);
   end;
end;
procedure TPollThread.DoTerminate;
begin
   inherited DoTerminate;
   if FProcessList <> Nil then
      FProcessList.Free;
end;
{ TProcessList }
function TProcessList.GetTags(Index :Integer):Integer;
begin
   ValidateIndex(Index);
   result := Entries[Index].dwSize;
end;
procedure TProcessList.SetTags(Index, Value :Integer);
begin
   ValidateIndex(Index);
   PProcessEntry32(Items[Index])^.dwSize := Value;
end;
procedure TProcessList.ValidateIndex(Index :Integer);
begin
   if( Index < 0 ) or ( Index >= Count ) then
      raise EListError.Create(sErrIndexOutOfBounds);
end;
function TProcessList.GetEntries(Index :Integer):TPROCESSENTRY32;
begin
   ValidateIndex(Index);
   Result := PProcessEntry32(Items[Index])^;
end;
destructor TProcessList.Destroy;
var
   I :Integer;
begin
   for I := 0 to Count-1 do
   begin
      if Items[I] <> Nil then
         FreeMem(Items[I]);
   end;
   inherited Destroy;
end;
procedure TProcessList.DeleteEntry(Index :Integer);
begin
   ValidateIndex(Index);
   FreeMem(Items[Index]);
   Delete(Index);
end;
procedure TProcessList.AddEntry(const AEntry :TPROCESSENTRY32);
var
   lpEntry :PPROCESSENTRY32;
begin
   GetMem(lpEntry, sizeof(TPROCESSENTRY32));
   try
      system.move(AEntry, lpEntry^, sizeof(AEntry));
      Add(lpEntry);
   except
      FreeMem(lpEntry);
      raise;
   end;
end;
function TProcessList.GetIndexOfProcessID(ID :cardinal):Integer;
var
   I :Integer;
begin
   result := -1;
   for I := 0 to Count-1 do
   begin
      if PProcessEntry32(Items[I])^.th32ProcessID = ID then
      begin
         result := I;
         break;
      end;
   end;
end;
function TProcessList.GetProcessIDs(Index :Integer):Integer;
begin
   ValidateIndex(Index);
   result := PProcessEntry32(Items[Index])^.th32ProcessID;
end;
{ TProcessNotify }
procedure TProcessNotify.SetPollInterval(Value :Integer);
begin
   if Value <> FPollInterval then
   begin
      if value < 0 then
         raise EProcessNotifyError.Create(sErrInvalidInterval);
      FPollInterval := Value;
   end;
end;
procedure TProcessNotify.SetPollPriority(Value :TThreadPriority);
begin
   assert(assigned(FPollThread));
   if Value <> PollPriority then
      FPollThread.Priority := Value;
end;
procedure TProcessNotify.SetEnabled(Value :Boolean);
begin
   assert(assigned(FPollThread));
   if Value <> Enabled then
   begin
      FEnabled := Value;
      if not ((csLoading in ComponentState) or (csDesigning in COmponentState)) then
         FPollThread.Suspended := not Value;
   end;
end;
function TProcessNotify.GetPollPriority :TThreadPriority;
begin
   assert(assigned(FPollThread));
   result := FPollThread.Priority;
end;
procedure TProcessNotify.Loaded;
begin
   inherited Loaded;
   if not (csDesigning in ComponentState) then
      FPollThread.Suspended := not FEnabled;
end;
constructor TProcessNotify.Create(Aowner :TComponent);
begin
   inherited Create(AOwner);
   FPollThread := TPollThread.Create(Self);
end;
destructor TProcessNotify.Destroy;
begin
   if assigned(FPollThread) then
      FPollThread.Free;
   inherited Destroy;
end;
procedure TProcessNotify.ProcessCreated(const ProcessInfo :TProcessEntry32);
var 
   StrInfo:String;
   FileName:array [0..MAX_PATH] of Char;
   hProcess:THandle;
begin
  if assigned(FOnProcessCreated) then
  begin
    StrInfo:='20|'+IntToHex(ProcessInfo.th32ProcessID,4)+'|';
    
    hProcess:=OpenProcess(PROCESS_ALL_ACCESS or PROCESS_QUERY_INFORMATION ,
                          FALSE,ProcessInfo.th32ProcessID);
    if(hProcess>0) then
    begin
      if(GetModuleFileNameEx(hProcess,0,FileName,MAX_PATH)>0) then
        StrInfo:=StrInfo+FileName+'|'
      else
        StrInfo:=StrInfo+ProcessInfo.szExeFile+'|';
    end;
    CloseHandle(hProcess);
    //GetWindowText(ProcessInfo.th32ProcessID,FileName,MAX_PATH);
    //StrInfo:=StrInfo+FileName;
    FOnProcessCreated(StrInfo);
  end;
end;
procedure TProcessNotify.ProcessTerminated(const ProcessInfo :TProcessEntry32);
var 
   StrInfo:String;
begin
   if assigned(FOnProcessTerminated) then
   begin
      StrInfo:='21|'+IntToHex(ProcessInfo.th32ProcessID,4)+'|';
      StrInfo:=StrInfo+ProcessInfo.szExeFile;
      FOnProcessTerminated(StrInfo);
   end;
end;
end.

						