Methode (Process SID) klappt nur als Debug Release

[KodeZwerg]

Hallo miteinander,
ich bin auf ein seltsames problem gestossen was mich ein wenig aus der Bahn wirft.

Referenz: stackoverflow
Code:

Delphi-Quellcode:

function GetUserAndDomainFromPID(ProcessId: DWORD;
  var User, Domain: string): Boolean;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  ProcessHandle: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
  if ProcessHandle <> 0 then
  begin
  //  EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
    begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      ptiUser  := nil;
      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
      begin
        ReallocMem(ptiUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
      end;
      CloseHandle(hToken);

      if not bSuccess then
      begin
        Exit;
      end;

      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
      if (UserSize <> 0) and (DomainSize <> 0) then
      begin
        SetLength(User, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
          PChar(Domain), DomainSize, snu) then
        begin
          Result := True;
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
        end;
      end;

      if bSuccess then
      begin
        FreeMem(ptiUser);
      end;
    end;
    CloseHandle(ProcessHandle);
  end;
end;

Bei der oben gezeigten Methode wirft mir nt.dll dauernd einen Fehler (Schreibfehler) wenn das Projekt auf "Release" steht, wenn ich nun debugge um herauszufinden an welcher stelle der Fehler produziert wird, was soll ich sagen, da klappt alles so wie es sein sollte.
Nun meine Frage, wie bekomme ich es zum laufen ohne entweder zu debuggen oder einen Debug-Release zu erschaffen, hat da jemand eine Idee?

Ps: Ich möchte mit dieser Funktion sicherstellen das meine Applikation nur einmal pro Login-Account gestartet werden kann bzw. auch gut für einen Prozess-Lister :-)

Grüße!

[Dalai]

Hilft es, wenn du den Aufruf der Funktion in einen try..except-Block packst und bei Auftreten einer Exception diese mit raise (RaiseLastOsError wäre Overkill) anzeigen lässt? Ist die Überlaufprüfung aktiviert und schlägt die an?

Grüße
Dalai

[Luckie]

API Aufrufe lösen keine Exceptions aus.

Was gibt denn LookupAccountSid zurück? Und statt bei Misserfolg mit einem Exit auszusteigen, würde ich mir GetLastError anzeigen lassen.

[KodeZwerg]

Es tut mir leid für die sehr verspätete Rückmeldung. Internet Provider probleme...

Ich habe nun den Fehler einigermaßen lokalisieren können aber benötige dennoch etwas Hilfe beim korrigieren.

Das Problem scheint bei mir die Art und Weise zu sein wie ich die PID herhole.

Wenn ich über einen Snapshot die Prozesse ermittel und mir von dort die PID herhole klappt alles wie am Schnürchen.
Wenn ich über FindWindow() mir das Handle hole und vom Handle die PID, da wirft mir NT.DLL beim Aufruf der obigen Methode einen Schreibfehler.

Ich lad morgen mal meine beiden PID "Ermittler" hoch, vielleicht hat ja da jemand einen Vorschlag oder sieht gleich das da irgendwo der Wurm drinnen ist.

Einen schönen Tag Euch allen.

[KodeZwerg]

Ich konnte mein Problem selbst lösen, hier sind meine Methoden die ich anwende:

Delphi-Quellcode:

// Auszug der betroffenen Methoden

// Diese Methode holt per Window-Caption die entsprechende ProcessID ab
function TTarget._GetPIDByCaption(const _Caption: string): Cardinal;
var
  Win: HWND;
  _PID: DWORD;
begin
  Result := 0;
  if _Caption = '' then
    Exit;
  Win := FindWindow(nil, PChar(_Caption));
  if Win > 0 then
  begin
    GetWindowThreadProcessID(Win, @_PID);
    if ((_PID > 0) and (_GetUserNameFromPID(_PID) = _GetLocalUserName)) then
      Result := _PID;
  end;
end;

// Diese Methode holt per Dateinamen die entsprechende ProcessID ab
function TTarget._GetPIDByName(const ExeName: string): Cardinal;
var
  Process: THANDLE;
  ProcessEntry: TProcessEntry32;
begin
  Result := 0;
  if ExeName = '' then
    Exit;
  ProcessEntry.dwSize := SizeOf(TProcessEntry32);
  Process := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (Process32First(Process, ProcessEntry)) then
    repeat
      if ((LowerCase(ProcessEntry.szExeFile) = LowerCase(ExeName)) and
        (_GetUserNameFromPID(ProcessEntry.th32ProcessID) = _GetLocalUserName))
      then
      begin
        Result := ProcessEntry.th32ProcessID;
        CloseHandle(Process);
        Exit;
      end;
    until (not Process32Next(Process, ProcessEntry));
  CloseHandle(Process);
end;

// Diese Methode steuert die beiden oberen
function TTarget.GetPID: DWORD;
var
  PID: DWORD;
begin
  Result := 0;
  PID := _GetPIDByName('Dateiname.exe');      // diese methode versteht es mehrere prozesse mit dem selben Dateiname.exe zu durchforsten
  if PID = 0 then                             // falls Dateiname.exe umbenannt wurde (oder tatsächlich noch nicht gestartet wurde)
    PID := _GetPIDByCaption('Fenster Titel'); // zusätzlich nach einem Fenster ausschau halten, man weiß ja nie
  if PID > 0 then
    Result := PID;
end;

// Diese Methode holt den aktuell angemeldeten User-Namen ab
function TTarget._GetLocalUserName: string;
var
  aLength: DWORD;
  aUserName: array [0 .. MAX_PATH - 1] of WideChar;
begin
  aLength := MAX_PATH;
  if GetUserName(@aUserName, aLength) then
    Result := aUserName
  else
    raise Exception.Create(SysErrorMessage(GetLastError));
end;

// eine reparierte Version die für beide Methoden (Caption/Filename) gleich gut arbeitet
// Diese Methode gibt den User-Namen wieder der die ProzessID gestartet hat
function TTarget._GetUserNameFromPID(PID: DWORD): string;
var
  hToken: THANDLE;
  cbBuf: Cardinal;
  pUser: PTokenUser; // dies war vorher eine fehlerquelle, danke windows.pas, wer lesen kann ist klar im vorteil :-)
  snu: SID_NAME_USE;
  ProcessHandle: THANDLE;
  UserSize: DWORD;
  DomainSize: DWORD;
  bSuccess: Boolean;
  User, Domain: string;
begin
  Result := '';
  UserSize := 0;
  DomainSize := 0;
  pUser := nil;
  if PID = 0 then
    PID := GetCurrentProcessId();
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, PID);
  if ProcessHandle <> INVALID_HANDLE_VALUE then
  begin
    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
    begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
      begin
        ReallocMem(pUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, pUser, cbBuf, cbBuf);
      end;
      CloseHandle(hToken);
      if not bSuccess then
        Exit;
      LookupAccountSid(nil, pUser^.User.Sid, nil, UserSize, nil,
        DomainSize, snu);
      if (UserSize <> 0) and (DomainSize <> 0) then
      begin
        SetLength(User, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, pUser^.User.Sid, PChar(User), UserSize,
          PChar(Domain), DomainSize, snu) then
        begin
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
          Result := User;
        end;
      end;
      if bSuccess then
        FreeMem(pUser);
    end;
    CloseHandle(ProcessHandle);
  end;
end;

Die Fehlerquelle im Original lag zwischen:

Delphi-Quellcode:

       begin
          Result := True;
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
        end;
      end;

      if bSuccess then
      begin
        FreeMem(ptiUser);
      end;

Näher konnte ich den Fehler nicht eingrenzen.
Der Fehler äußerte sich wie im Bild im Anhang, allerdings nur wenn ich per Caption die PID abgeholt habe. Da fehlt mir doch ein wenig das Verständnis aber nun gut, dem sei so :-)

[Michael II]

Hallo KodeZwerg

ich habe deinen Code aus #1 mit Delphi 10.3.3 und Win 10 Home 19035.1 mit allen momentan auf meiner Kiste laufenden Prozessen durchgetestet. Das Ding läuft (und funktioniert) unter Debug wie Release.

Du müsstest also ein Miniprojekt erstellen und veröffentlichen, damit man vielleicht sehen könnte, woran es liegt.

Da du eine Lösung hast, ist das Thema aber wohl durch ;-).