如何获取当前运行的进程的全路经？？？我的代码好像有问题。请指教！(50分)

mazheng · 2006-11-25

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Buttons,  //----------------------  WinSvc,TlHelp32, Menus, PsApi; type  TForm1 = class(TForm)    ListBox1: TListBox;    procedure FormCreate(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  gbCanClose: Boolean;  SvcHandle: SC_HANDLE;  porFile: String;  ESS: Array of TEnumServiceStatus;  nBytesNeeded,nServices,nResumeHandle: Cardinal;  i: Integer;  pList1,pList2,pList3 : TStringList; implementation {$R *.DFM}  function   GetProcessFullFileName(pID:Integer):String;  var   s:String;          hProcess:THandle;  begin          Result:='';          SetLength(s,256);          hProcess:=OpenProcess(PROCESS_ALL_ACCESS   or   PROCESS_QUERY_INFORMATION   ,FALSE,pID);          if(hProcess>0)   then          begin                if(GetModuleFileNameEx(hProcess,0,PChar(s),255)>0)   then                begin                      SetLength(s, StrLen(PCHAR(s)));                      Result:=s;                end;                          end;          CloseHandle(hProcess);  end; procedure EnumProcess(List: TListBox); //枚举进程 var ContinueLoop    : BOOL; FSnapshotHandle : THandle; FProcessEntry32 : TProcessEntry32; begin FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); try   List.Clear;   FProcessEntry32.dwSize := Sizeof(FProcessEntry32);   ContinueLoop           := Process32First(FSnapshotHandle,FProcessEntry32);   while integer(ContinueLoop)<>0 do   begin     //进程名称     List.Items.Add(FProcessEntry32.szExeFile);     List.Items.Add('-');     //包含全路经的进程名称     // 但不知道为何返回空？请指教     List.Items.add(GetProcessFullFileName(FProcessEntry32.th32ProcessID) );     ContinueLoop  :=  Process32Next(FSnapshotHandle,FProcessEntry32);   end; finally   CloseHandle(FSnapshotHandle); end; end; procedure TForm1.FormCreate(Sender: TObject); begin EnumProcess(ListBox1); end; end.

cqwty · 2006-11-25

你的程序不要放在oncreate事件中,窗体正在建立,怎么处理你的代码嘛! 还有就是你声明的几个TStringList,用完了记住释放就可以了!

mazheng · 2006-11-25

和这么样关系吧

cqwty · 2006-11-25

你测试了再来说,我已经测试过了,问题就是这个.

linuxping · 2006-11-25

unit untEnumProc; interface uses Windows, Messages, SysUtils,StrUtils, Variants, Classes,Dialogs,TLHelp32; Procedure SwitchToThisWindow(hwnd:HWND;bRestore:Integer);stdcall; type TEnumProc=class     private        FProcCount:Integer; //系统进程总数        FProcList:TList; //系统进程列表     public        constructor Create;        destructor Destroy;        procedure AllProcs; //枚举所有进程(结果放入FProcList)        function  GetParentProcID(hProc:THandle):THandle; //根据子进程ID 获取父进程ID        function GetNameFromID(hProcName:THandle):string;    //根据进程ID 获得进程名        function GetParentProcName(hProc:THandle):string; //根据子进程ID 获取父进程名        Function GetIDFromName(ProcName:String):THandle; //根据进程名获取进程ID.        function GetPrior(hProc:THandle):LongInt;  //根据进程ID 获得进程优先级        //激活窗体(变成前台窗体).        function ActWindow(sWinName:string):Boolean;overload;//指定窗口名        procedure ActWindow(hFrmHandle:THandle);overload;//指定窗口句柄     published        {只读属性}        property ProcCount:Integer  read FProcCount;   //进程总数        property ProcInfo:TList read FProcList; //所有进程的信息列表. end; implementation Procedure SwitchToThisWindow(hwnd:HWND;bRestore:Integer);external 'user32.dll' name 'SwitchToThisWindow';stdcall; { TEnumProc } function TEnumProc.ActWindow(sWinName: string):Boolean; var  hHandle:THandle; begin  Result:=False;  hHandle:=FindWindow(nil,PAnsiChar(sWinName));  if hHandle=0 then Exit; //没有名称为sWinName的窗体,则退出  Result:=True;  ActWindow(hHandle); end; procedure TEnumProc.ActWindow(hFrmHandle: THandle); var  i:Integer; begin  SwitchToThisWindow(hFrmHandle,1);  for i:=0 to 5 do  begin     FlashWindow(hFrmHandle,LongBool(True));     Sleep(300);  end; end; {   TPROCESSENTRY32的结构. 下面是VB里的声明~  } {Private Type PROCESSENTRY32  dwSize As Long                 '结构大小  cntUsage As Long               '自身引用记数  th32ProcessID As Long          '此进程ID  th32DefaultHeapID As Long      '进程默认堆ID  th32ModuleID As Long           '进程模块ID。DLL的模块ID与进程ID相同  cntThreads As Long             '开启的线程计数  th32ParentProcessID As Long    '父进程ID  pcPriClassBase As Long         '线程优先权  dwFlags As Long                'preserve  szExeFile As String * MAX_PATH 'full name End Type} procedure TEnumProc.AllProcs; var  hSnapShot:THandle;  bExist:Boolean;  curProcName:String;  pProcess

PROCESSENTRY32;  i:Integer; begin   if Assigned(FProcList) then     {释放以前分配的内存}     if FProcList.count>0 then       for i:=FProcList.count-1 downto 0 do       begin         FreeMem(PPROCESSENTRY32(FProcList.Items));         FProcList.Delete(i);       end;   hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);  //创建进程快照   If hSnapShot = 0 Then Exit;   GetMem(pProcess,SizeOf(TProcessEntry32));   //FillChar(pProcess,SizeOf(TProcessEntry32),0);   //ShowMessage(IntToStr(SizeOf(TProcessEntry32)));   pProcess^.dwSize := SizeOf(TProcessEntry32);   bExist:=Process32First(hSnapShot, pProcess^);   if (not bExist) then FreeMem(pProcess);   While (bExist) do   begin        FProcList.Add(pProcess); //找到的进程的信息加进列表        GetMem(pProcess,SizeOf(TProcessEntry32));  //getMem必须用freeMem释放        //FillChar(pProcess,SizeOf(TProcessEntry32),0);        pProcess^.dwSize := SizeOf(TProcessEntry32);        bExist:=Process32Next(hSnapShot, pProcess^);   end;   CloseHandle(hSnapShot);   FProcCount:=FProcList.Count; end; constructor TEnumProc.Create; begin  FProcList:=TList.Create;  FProcCount:=-1; {为表示没有调用AllProcs函数,设FProcCount为-1 .                      请务必保证在使用ProcCount属性前,间接或直接调用AllProcs函数. } end; destructor TEnumProc.Destroy; var  i:Integer; begin  for i:=FProcList.count-1 downto 0 do      FreeMem(PPROCESSENTRY32(FProcList.Items));  FProcList.Free;  inherited; end; function TEnumProc.GetIDFromName(ProcName: String): THandle; var  i:Integer;  curProcName:string;  pProcessPROCESSENTRY32; begin  Result:=0;  //没有找到  AllProcs;  for i:=0 to FProcList.Count-1 do  begin    pProcess:=PPROCESSENTRY32(FProcList.Items);    curProcName:= pProcess.szExeFile;    if Pos('.',curProcName)>0 then       curProcName:= LeftStr(curProcName,Pos('.',curProcName)-1); //smss.exe-->smss          If LowerCase(curProcName) = LowerCase(Trim(ProcName)) Then        begin            Result:= pProcess^.th32ProcessID;            break;        end;  end; end; function TEnumProc.GetNameFromID(hProcName: THandle):string ; var  i:Integer;  pProcessPROCESSENTRY32; begin   Result:='';  //没有找到   AllProcs;   for i:=0 to FProcList.Count-1 do   begin      pProcess:=PPROCESSENTRY32(FProcList.Items);      if  pProcess.th32ProcessID=hProcName then      begin          Result:=pProcess.szExeFile;          Exit;      end;   end; end; function TEnumProc.GetParentProcID(hProc: THandle): THandle; var  i:Integer;  pProcessPROCESSENTRY32; begin  Result:=0;  AllProcs;  for i:=0 to FProcList.Count-1 do   begin      pProcess:=PPROCESSENTRY32(FProcList.Items);      if pProcess.th32ProcessID=hProc then      begin         Result:=pProcess.th32ParentProcessID;         Exit;      end;   end; end; function TEnumProc.GetParentProcName(hProc: THandle): string; var  hHandle:THandle; begin  hHandle:=GetParentProcID(hProc);  Result:=GetNameFromID(hHandle); end; function TEnumProc.GetPrior(hProc: THandle): LongInt; var  i:Integer;  pProcessPROCESSENTRY32; begin  Result:=0;  AllProcs;  for i:=0 to FProcList.Count-1 do   begin      pProcess:=PPROCESSENTRY32(FProcList.Items);      if pProcess.th32ProcessID=hProc then      begin         Result:=pProcess.pcPriClassBase;         Exit;      end;   end; end; end.

linuxping · 2006-11-25

实验表明PROCESSENTRY32结构中的szExeFile并不是全路径,只是应用程序名----比如: IE.exe

如何获取当前运行的进程的全路经？？？我的代码好像有问题。请指教！(50分)

mazheng

Unregistered / Unconfirmed

cqwty

Unregistered / Unconfirmed

mazheng

Unregistered / Unconfirmed

cqwty

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

linuxping

Unregistered / Unconfirmed

Similar threads