Win7 下DELPHI如何通过进程名获取路径?

Question

uses TLHelp32,psapi;function FindProcess(AFileName: string;var ID:Cardinal): boolean;
var
   hSnapshot: THandle;//用于获得进程列表
   lppe: TProcessEntry32;//用于查找进程
   Found: Boolean;//用于判断进程遍历是否完成
begin
   Result :=False;
   hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);//获得系统进程列表
   lppe.dwSize := SizeOf(TProcessEntry32);//在调用Process32First API之前，需要初始化lppe记录的大小
   Found := Process32First(hSnapshot, lppe);//将进程列表的第一个进程信息读入ppe记录中
   while Found do
   begin
     if ((UpperCase(ExtractFileName(lppe.szExeFile))=UpperCase(AFileName)) or (UpperCase(lppe.szExeFile )=UpperCase(AFileName))) then
     begin
       ID:=lppe.th32ProcessID;       Result :=True;
     end;
     Found := Process32Next(hSnapshot,lppe);//将进程列表的下一个进程信息读入lppe记录中
   end;end; 
function GetProcessPath(ProcessID: DWORD): string;
var
     Hand: THandle;
     ModName: Array[0..Max_Path-1] of Char;
     hMod: HModule;
     n: DWORD;
begin
     Result:='';
     Hand:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcessID);
     if Hand>0 then
     try
       ENumProcessModules(Hand,@hMod,Sizeof(hMod),n);
       if GetModuleFileNameEx(Hand,hMod,ModName,Sizeof(ModName))>0 then
         Result:=ExtractFilePath(ModName);
     except
     end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  Test:Dword;
  Path:string;
begin
  FindProcess('Test.exe',Test);
  Path:= GetProcessPath(Test);
  ShowMessage(Path);
end;此代码 XP 上通过。。 但是 win7 下不能用！~~  为什么呢？？  win7 下如何通过进程名取路径呢？

Answer 1

win7打开了uac。。
如果你的程序没有相关设置，win7下不会报错，但是不会执行相关语句。
如果需要uac相关的rc或者res文件，可以联系我。

Answer 2

http://hi.baidu.com/wojiubaibudu/blog/item/908d3fd2f622a43f970a16b9.html
我是通过上面的介绍，添加了关于uac的res文件，就可以。应该是这个问题。

Answer 3

我是xp系统，用网上的添加Uac的方法，在虚拟机Win7运行老出错！

Answer 4

报错倒是没有，按楼主的代码Win7下 查看explorer.exe无效，查看本程序Project1.exe还是可以的。

Answer 5

我也是win7用了上面的代码，没有报错。。32位开发，64位测试都没有问题。
楼主在确认一下。uac的资源文件，是不是生成正确。

Answer 6

添加了 UAC.res， 程序也出现了小盾牌。。
可是，，照常在 WIN7 下不行~~

Answer 7

给你一段 小牛远控中的相关代码//获取进程列表
function GetProcessListStr : String;
var
  Process32 : TProcessEntry32;
  ProcessSnapshot : THandle;
  Module32 : TModuleEntry32;
  ModuleSnapshot : THandle;
  ExeShortName, ExeFileName : String;
  Summ, i : Word;
begin
  GetDebugPrivs;
  Result := '<?xml version="1.0" encoding="UNICODE"?><tree2xml app="SVCHOST.exe">';
  ProcessSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  Process32.dwSize := SizeOf(TProcessEntry32);
  Process32First(ProcessSnapshot, Process32);
  Process32Next(ProcessSnapshot, Process32);
  Summ := 0;
  repeat
    ModuleSnapshot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, Process32.th32ProcessID);
    Module32.dwSize := SizeOf(TModuleEntry32);
    Module32First(ModuleSnapshot, Module32);
    ExeFileName := String(Module32.szExePath);
    //返回进程名称
    ExeShortName := Process32.szExeFile;
    //转换非法字符串
    if ExeShortName <> '' then
      for i := 1 to Length(ExeShortName) do
        if (ExeShortName[i] = '&') then
          ExeShortName[i] := '?';
    if ExeFileName <> '' then
      for i := 1 to Length(ExeFileName) do
        if (ExeFileName[i] = '&') then
          ExeFileName[i] := '?';
    Result := Result +
      '<item Index="' + IntToStr(Summ) +
      '" ExeShortName="' + ExeShortName +
      '" ProcessID="' + IntToStr(Process32.th32ProcessID) +
      '" ExeFileName="' + ExeFileName +
      '"/>';
    CloseHandle(ModuleSnapshot); 
  until not (Process32Next(ProcessSnapshot, Process32)); 
  CloseHandle(ProcessSnapshot);
  Result := Result + '</tree2xml>';
end; 
其中的进程路径就是 ExeFileName

Answer 8

估计还是进程权限的问题，先试试提权到Debug权限试试，如果不行，用CreateProcessAsUser以管理员身份运行
LZ也可以先右键——管理员身份运行，看看结果是不是正确的

Answer 9

关闭UAC，看看程序能否执行？
如果确定已成功为程序打上标识（manifest），可能需要提升自身的完整性级别(Integrity level).
参考 http://book.51cto.com/art/201003/189534.htm