获取进程路径

uses Tlhelp32, PsAPI;
var
  ProcArr: array of TProcessEntry32;
  ColumnToSort: Integer;

procedure EnumProcess(pNameList, PidList: TStrings);
var
  hProcess: THandle;
  Find: Boolean;
  Proc: TProcessEntry32;
  i: DWORD;
begin
  try
    hProcess := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    Proc.dwSize := SizeOf(Proc);
    Find := Process32First(hProcess, Proc);
    i := 0;
    while Find do
    begin
      SetLength(ProcArr, i + 1);
      ProcArr[i] := Proc;
      inc(i);
      pNameList.Add(Proc.szExeFile);
      PidList.Add(inttostr(Proc.th32ProcessID));
      Find := Process32Next(hProcess, Proc);
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  PnList, PidList: TStringList;
  i, d, lpc: DWORD;
  hProc: THandle;
  hModu: HMODULE;
  cb: Cardinal;
  exeName: array[0..MAX_PATH] of Char;
  item: TListItem;
begin
  lv1.Clear;
  try
    d := 1;
    PnList := TStringList.Create;
    PidList := TStringList.Create;
    PnList.Clear;
    PidList.Clear;
    EnumProcess(PnList, PidList);
    for i := Low(ProcArr) to High(ProcArr) do
    begin
      Item := lv1.Items.Add;
      item.Caption := IntToStr(d);
      item.SubItems.Add(ProcArr[i].szExeFile);
      item.SubItems.Add(IntToStr(ProcArr[i].th32ProcessID));
      hProc := OpenProcess(PROCESS_QUERY_INFORMATION
        or PROCESS_VM_READ, False, ProcArr[i].th32ProcessID);
      if hProc > 0 then
      begin
        EnumProcessModules(hProc, @hModu, SizeOf(hModu), Lpc);
        if GetModuleFileNameEx(hProc, hModu, exeName, SizeOf(exeName)) > 0 then
          item.SubItems.Add(ExtractFileDir(exeName) + exeName);
      end;
      inc(D);
    end;
    stat1.Panels[0].Text := Format('当前系统共有 %D 个进程', [D - 1]);
  finally
    FreeAndNil(PnList);
    FreeAndNil(PidList);
    CloseHandle(Hproc);
  end;
end;

procedure TForm1.lv1ColumnClick(Sender: TObject; Column: TListColumn);       //排序
begin
  ColumnToSort := Column.Index;
  (Sender as TCustomListView).AlphaSort;
end;

procedure TForm1.lv1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
  ix: Integer;
begin
  try
    if ColumnToSort = 0 then
      Compare := CompareText(Item1.Caption, Item2.Caption)                  //排序
    else
    begin
      ix := ColumnToSort - 1;
      Compare := CompareText(Item1.SubItems[ix], Item2.SubItems[ix]);
    end;
  except
    //Beep;
    //Exit;
  end;
end;