Code funktioniert mit WindowsXP, nicht mit WindowsXP 64

[Shark99]

Hi!

Dieser Code funktioniert mit WindowsXP.

In WindowsXP 64 jedoch, geht er nur mit PIDs von 32 bit Prozessen.

Hier ist der Code:

Delphi-Quellcode:

function GetProcessFilePath(pid:cardinal):string;
var
  hp: THandle;
  Buffer1: array[0..MAX_PATH] of Char;
begin
  Result := '';

  if pid > 0 then
  begin
    hp := OpenProcess(PROCESS_ALL_ACCESS,False,pid);

    if hp > 0 then
    begin
      if GetModuleFileNameEx(hp,0,Buffer1,SizeOf(Buffer1)) > 0 then
      begin
        Result := PathGetLongName(ExtractFilePath(Buffer1));
        CloseHandle(hp);
        Exit;
      end else
      begin
          Result := SysErrorMessage(GetLastError);
      end;
      CloseHandle(hp);
    end;
  end;
end;

GetModuleFileNameEx schlägt fehl wenn PID zu einem 64bit Prozess gehört (z.B. Notepad.exe).

GetLastError gibt dann: Only part of ReadProcessMemory or WriteProcessMemory request was completed

Was ich bis jetzt versuchte (hat alles nicht geholfen).

Priviliges geändert mit:

Delphi-Quellcode:

procedure EnableAllPrivileges;
var c1, c2 : dword;
    ptp    : PTokenPrivileges;
    i1     : integer;
begin
  if OpenProcessToken(windows.GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, c1) then
    try
      c2 := 0;
      GetTokenInformation(c1, TokenPrivileges, nil, 0, c2);
      if c2 <> 0 then begin
        ptp := AllocMem(c2);
        if GetTokenInformation(c1, TokenPrivileges, ptp, c2, c2) then begin
          for i1 := 0 to integer(ptp^.PrivilegeCount) - 1 do
            ptp^.Privileges[i1].Attributes := ptp^.Privileges[i1].Attributes or SE_PRIVILEGE_ENABLED;
          AdjustTokenPrivileges(c1, false, ptp^, c2, PTokenPrivileges(nil)^, cardinal(pointer(nil)^));
        end;
        FreeMem(ptp);
      end;
    finally CloseHandle(c1) end;
end;

und auch

File System 64 -> 32 bit Redirection abgeschaltet:

Delphi-Quellcode:

function ChangeFSRedirection(bDisable: Boolean): Boolean;
type
     TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
     TWow64EnableWow64FsRedirection  = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
var
    hHandle: THandle;
    Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
    Wow64EnableWow64FsRedirection:  TWow64EnableWow64FsRedirection;
    Wow64FsEnableRedirection:       LongBool;
begin
  Result := false;

  if not IsWindows64 then
     Exit;

  try
    hHandle := GetModuleHandle('kernel32.dll');
    @Wow64EnableWow64FsRedirection  := GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection');
    @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');

    if bDisable then
    begin
     if (hHandle <> 0) and (@Wow64DisableWow64FsRedirection <> nil) then
     begin
       Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
       Result := True;
     end;
    end else
    begin
     if (hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) then
     begin
       Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
       Result := True;
     end;
    end;
  Except
  end;
end;

p.s.

alles andere (64 Bit Prozess beenden, andere Infos wie CPU Usage holen) funktioniert ohne Probleme!