如何在一个进程中控制其它的进程（监控运行状态、启动、停止）？

Question

主进程监控其他进程，可以选择启动及停止特定进程。
大概如下的控制界面。进程名称      进程状态      启动进程      停止进程
---------------------------------------------------
进程1         启动/停止     启动按钮      停止按钮
进程2         启动/停止     启动按钮      停止按钮
进程3         启动/停止     启动按钮      停止按钮
进程4         启动/停止     启动按钮      停止按钮
进程5         启动/停止     启动按钮      停止按钮
进程6         启动/停止     启动按钮      停止按钮

Answer 1

它说我的代码太长了，不让贴，mail to u?

Answer 2

unit ExeItem;interfaceuses
  Windows, Messages, SysUtils, Classes, ShellAPI, ShlObj, Contnrs, Menus;type
  //***********************************************************************//
  // Data Type Define
  //***********************************************************************//
  TFileType = (ftNormal,ftExec,ftDir,ftShot,ftUnknow);
  //***********************************************************************//
  // Class TMonitor Define
  //***********************************************************************//
TMonitor = class(TThread)
  private
  { Private declarations }
    FProcHandle: THandle;
    FFileName: TFileName;
    FParams: TStringList;
    FFileType: TFileType;
    FStartTime: TDateTime;
    FEndTime: TDateTime;
    FMonitor: Boolean;
    FDoMonitor: Boolean;
    function GetProcHandle: THandle;
    function GetFileName: TFileName;
    function GetParams: TStringList;
    function GetFileType: TFileType;
    function ListToStr(sList:TStringList):String;
    function Run: Boolean;
    procedure DoMonitor;
    function  GetEndTime: TDatetime;
    function  GetStartTime: TDatetime;
    procedure SetMonitor(const Value: Boolean);
  protected
    procedure DoTerminate;override;
  public
  { Public declarations }
    constructor Create(FileName:String;Params:TStringList;
     AMonitor:Boolean = True); overload;
    destructor  Destroy;override;
procedure  Execute; override;
    procedure   Start;
    procedure   Stop(StopApp:Boolean = False);
  published
{ Published declarations }
    property StartTime:TDateTime read GetStartTime;
    property EndTime:TDateTime read GetEndTime;
  property ProcHandle:THandle read GetProcHandle;
    property FileName:TFileName read GetFileName;
    property Params:TStringList read GetParams;
    property FileType:TFileType read GetFileType;
    property Monitor:Boolean read FMonitor write SetMonitor;
  end;
  TClone = TMonitor;
  //***********************************************************************//
  // Data Type Define
  //***********************************************************************//
  TCloneClosed = procedure(Clone:TClone) of object;
  TCloneAllOver = procedure of object;
  //***********************************************************************//
  // Class TMonitorList Define
  //***********************************************************************//
  TMonitorList = class(TObject)
  private
   FList: TObjectList;
    FOnCloneClosed: TCloneClosed;
    FMonitorOver: TCloneAllOver;
   function  AddItem(AMonitor: TMonitor):Integer;
    function  Get(Index: Integer): TMonitor; reintroduce;
    procedure Put(Index: Integer; const Value: TMonitor); reintroduce;
    function  GetCloneCount: Integer;
    procedure OnMonitorClosed(Sender:TObject);
    procedure SetOnCloneClosed(const Value: TCloneClosed);
    procedure SetMonitorOver(const Value: TCloneAllOver);
  public
   constructor Create; overload;
    destructor  Destroy; override;
    property  CloneCount:Integer read GetCloneCount;
  property  Monitors[Index: Integer]: TMonitor read Get write Put;
    function    NewClones(FileName:String;Params:TStringList;
     AMonitor:Boolean):TClone;
    function    NewMonitor(FileName:String;Params:TStringList;
     AMonitor:Boolean):TMonitor;
    property    OnCloneClosed:TCloneClosed read FOnCloneClosed write SetOnCloneClosed;
    property    MonitorOver:TCloneAllOver read FMonitorOver write SetMonitorOver;
  end;
  TClones = TMonitorList;
  //***********************************************************************//
  // Class TExeItem Define
  //***********************************************************************//
  TExeItem = class(TComponent)
  private
    { Private declarations }
    FMonitors: TMonitorList;
    FExeFile: TFileName;
    FParams: TStringList;
    FDisplayLabel: String;
    FPopupMenu: TPopupMenu;
    FOnCloneClosed: TCloneClosed;
    FOnAllCloneAll: TCloneAllOver;
    procedure SetExeFile(const Value: TFileName);
    procedure SetParams(const Value: TStringList);
    function  GetClones: TClones;
    function  GetCloneCount: Integer;
    procedure SetDisplayLabel(const Value: String);
    procedure SetPopupMenu(const Value: TPopupMenu);
    procedure SetOnCloneClosed(const Value: TCloneClosed);
    procedure OnAllCloneOver;
    procedure SetOnAllCloneAll(const Value: TCloneAllOver);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy;override;
    procedure   OpenClone(Monitor:Boolean);
  published
    { Published declarations }
    property ExeFile:TFileName read FExeFile write SetExeFile;
    property Params:TStringList read FParams write SetParams;
    property Clones:TClones read GetClones;
    property CloneCount:Integer read GetCloneCount;
    property DisplayLabel:String read FDisplayLabel write SetDisplayLabel;
    property PopupMenu:TPopupMenu read FPopupMenu write SetPopupMenu;
    property OnCloneClosed:TCloneClosed read FOnCloneClosed write SetOnCloneClosed;
    property OnAllCloneAll:TCloneAllOver read FOnAllCloneAll write SetOnAllCloneAll;
  end;
  //***********************************************************************//
  // Function & Procedure Define
  //***********************************************************************//
function IsItExecutableFile(FileName:String):Boolean;
function IsItDircetory(FileName:String):Boolean;
function TerminateExe(Proc:THandle;IsProcID:Boolean = True):Boolean;
function RunExe(ExeFile:String;strParam:String):Integer;
function RunNotExe(Handle:Integer;strFileName:String;strParam:String;
strVerb:String;var hProc:THandle):Boolean;

Answer 3

implementationfunction IsItExecutableFile(FileName:String):Boolean;
var
  hFile:Integer;
  dosHeader:_IMAGE_DOS_HEADER;
  winHeaderOffset:DWORD;
  FlagBuff:array[0..1] of char;
const
FIRSTPOS = $3C;
PE_FLAG='PE';
    NE_FLAG='NE';
begin
hFile:=FileOpen(FileName,fmOpenRead);    if(hFile<=0)then
    begin
     Result:=False;
        Exit;
    end;
    FileRead(hFile,dosHeader,sizeof(_IMAGE_DOS_HEADER)); winHeaderOffset:=dosHeader._lfanew;    FileSeek(hFile,winHeaderOffset,0);
    FileRead(hFile,FlagBuff,2);
    FileClose(hFile);    if((FlagBuff = PE_FLAG)or(FlagBuff = NE_FLAG))then
     Result:=True
    else
     Result:=False;
end;function IsItDircetory(FileName:String):Boolean;
var
fInfo:ShFileInfo;
begin
ShGetFileInfo(pChar(FileName),0,fInfo,sizeof(ShFileInfo),SHGFI_ATTRIBUTES );
  if((fInfo.dwAttributes and SFGAO_FOLDER)=SFGAO_FOLDER )then
   Result:=True
  else
   Result:=False;
end;function TerminateExe(Proc:THandle;IsProcID:Boolean):Boolean;
var
hProc:Integer;
begin
hProc := 0;
Result := False;
  try
   if(IsProcID)then
      hProc := OpenProcess(PROCESS_TERMINATE,TRUE,Proc)
   else
   hProc := Proc;
   try
   if hProc <> 0 then begin
       Result := TerminateProcess(hProc,0);
        Sleep(50);
      end;
    except
     Raise;
    end;
  finally
  if hProc <> 0 then CloseHandle(hProc);
end;
end;function RunExe(ExeFile:String;strParam:String):Integer;
var
  si:StartupInfo;
  pi:TProcessInformation;
  iResult:LongBool;
  strCommLines:String;
begin
  if(not FileExists(ExeFile))then begin
   Result := 0;
    Exit;
  end; FillChar(si,Sizeof(StartupInfo),#0);
si.cb:=sizeof(TStartupInfo);  strCommLines:=ExeFile+' '+strParam;
iResult := CreateProcess(nil, PChar(strCommLines),nil, nil, True,NORMAL_PRIORITY_CLASS,nil, nil, si,pi);
  Sleep(50);  if(not iResult)then
   Result := 0
  else
   Result := pi.dwProcessId;
end;function RunNotExe(Handle:Integer;strFileName:String;strParam:String;
strVerb:String;var hProc:THandle):Boolean;
var
ErrorMsg: String;
  PShExeInfo: PShellExecuteInfo;
begin
new(PShExeInfo);
  PShExeInfo^.cbSize := sizeof(TShellExecuteInfo);
  PShExeInfo^.fMask := SEE_MASK_NOCLOSEPROCESS;
  PShExeInfo^.Wnd := Handle;
  PShExeInfo^.lpVerb := pChar(strVerb);
  PShExeInfo^.lpFile := pChar(strFileName);
  PShExeInfo^.lpParameters := PChar(strParam);
  PShExeInfo^.lpDirectory := PChar(ExtractFileDir(strFileName));
  PShExeInfo^.nShow := SW_SHOWNORMAL;
Result := ShellExecuteEx(PShExeInfo);  hProc := PShExeInfo^.hProcess;  ErrorMsg:='系统提示：'+#13+#10;
  ErrorMsg:=ErrorMsg+'在运行文件：%s'+#13+#10;
  ErrorMsg:=ErrorMsg+'      参数：%s'+#13+#10;
  ErrorMsg:=ErrorMsg+'错误原因：'+#13+#10;
  ErrorMsg:=Format(ErrorMsg,[strFileName,strParam]);  case PShExeInfo^.hInstApp of
   0: //The operating system is out of memory or resources.
    begin
      ErrorMsg:=ErrorMsg+'内存溢出！'
    end;
ERROR_BAD_FORMAT: //The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).
    begin
      ErrorMsg:=ErrorMsg+'这不是一个WIN32下的可执行文件！'
    end;
SE_ERR_ACCESSDENIED: //The operating system denied access to the specified file.
    begin
      ErrorMsg:=ErrorMsg+'由于你没有访问该文件的权限，操作失败！'
    end;
SE_ERR_ASSOCINCOMPLETE: //The filename association is incomplete or invalid.
    begin
      ErrorMsg:=ErrorMsg+'文件名无效！老兄，你的注册表有问题了！'
    end;
SE_ERR_DDEBUSY: //The DDE transaction could not be completed because other DDE transactions were being processed.
    begin
      ErrorMsg:=ErrorMsg+'DDE传送环境已被其它程序占用！'
    end;
SE_ERR_DDEFAIL: //The DDE transaction failed.
    begin
      ErrorMsg:=ErrorMsg+'DDE传送失败！'
    end;
SE_ERR_DDETIMEOUT: //The DDE transaction could not be completed because the request timed out.
    begin
      ErrorMsg:=ErrorMsg+'DDE传送超时！'
    end;
SE_ERR_DLLNOTFOUND: //The specified dynamic-link library was not found.
    begin
      ErrorMsg:=ErrorMsg+'所需的动态接连库（*.DLL）未找到！'
    end;
SE_ERR_FNF: //The specified file was not found.
    begin
      ErrorMsg:=ErrorMsg+'文件未找到！'
    end;
SE_ERR_NOASSOC: //There is no application associated with the given filename extension.
    begin
      ErrorMsg:=ErrorMsg+'无法打开一个这种后缀名的文件！'+#13+#10;
      ErrorMsg:=ErrorMsg+'噢，天呀！你放了些什么垃圾？:P'+#13+#10;
    end;
SE_ERR_OOM: //There was not enough memory to complete the operation.
    begin
      ErrorMsg:=ErrorMsg+'没有足够的内存完成该项操作！'+#13+#10;
      ErrorMsg:=ErrorMsg+'那么夸张！你多大的内存？换机器吧？:P'+#13+#10;
    end;
SE_ERR_PNF: //The specified path was not found.
    begin
      ErrorMsg:=ErrorMsg+'路径未找到！'
    end;
SE_ERR_SHARE: //A sharing violation occurred.
    begin
      ErrorMsg:=ErrorMsg+'公共冲突？不会吧？你打开什么文件呀？'
    end;
  end;
end;

Answer 4

{ TExeItem }constructor TExeItem.Create(AOwner: TComponent);
begin
  inherited;
Params := TStringList.Create;
FMonitors := TMonitorList.Create;
  FMonitors.MonitorOver := OnAllCloneOver;
end;destructor TExeItem.Destroy;
begin
try
if Assigned(FMonitors) then Freeandnil(FMonitors);
if Assigned(FParams) then Freeandnil(FParams);
  finally
  inherited;
  end;
end;function TExeItem.GetCloneCount: Integer;
begin
Result := FMonitors.CloneCount;
end;function TExeItem.GetClones: TClones;
begin
Result := TClones(FMonitors)
end;procedure TExeItem.OnAllCloneOver;
begin
if Assigned(FOnAllCloneAll) then FOnAllCloneAll;
end;procedure TExeItem.OpenClone(Monitor:Boolean);
begin
Clones.NewMonitor(FExeFile,FParams,Monitor);
end;procedure TExeItem.SetDisplayLabel(const Value: String);
begin
  FDisplayLabel := Value;
end;procedure TExeItem.SetExeFile(const Value: TFileName);
begin
  FExeFile := Value;
end;procedure TExeItem.SetOnAllCloneAll(const Value: TCloneAllOver);
begin
  FOnAllCloneAll := Value;
end;procedure TExeItem.SetOnCloneClosed(const Value: TCloneClosed);
begin
  FOnCloneClosed := Value;
  Clones.OnCloneClosed := Value;
end;procedure TExeItem.SetParams(const Value: TStringList);
begin
  if Assigned(FParams) then
    FParams.Assign(Value)
  else
    FParams := Value;
end;procedure TExeItem.SetPopupMenu(const Value: TPopupMenu);
begin
  FPopupMenu := Value;
end;