AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Methode (Process SID) klappt nur als Debug Release
Thema durchsuchen
Ansicht
Themen-Optionen

Methode (Process SID) klappt nur als Debug Release

Ein Thema von KodeZwerg · begonnen am 26. Nov 2019 · letzter Beitrag vom 7. Dez 2019
Antwort Antwort
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#1

Methode (Process SID) klappt nur als Debug Release

  Alt 26. Nov 2019, 16:16
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!
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
Benutzerbild von Dalai
Dalai

Registriert seit: 9. Apr 2006
1.682 Beiträge
 
Delphi 5 Professional
 
#2

AW: Methode (Process SID) klappt nur als Debug Release

  Alt 26. Nov 2019, 17:27
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

Geändert von Dalai (26. Nov 2019 um 17:30 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#3

AW: Methode (Process SID) klappt nur als Debug Release

  Alt 26. Nov 2019, 17:58
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.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: Methode (Process SID) klappt nur als Debug Release

  Alt 5. Dez 2019, 08:33
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.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: Methode (Process SID) klappt nur als Debug Release [fixed]

  Alt 6. Dez 2019, 08:03
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
Miniaturansicht angehängter Grafiken
screenshot-05_12.png  
Gruß vom KodeZwerg

Geändert von KodeZwerg ( 6. Dez 2019 um 08:06 Uhr)
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: CH BE Eriswil
758 Beiträge
 
Delphi 11 Alexandria
 
#6

AW: Methode (Process SID) klappt nur als Debug Release

  Alt 7. Dez 2019, 23:24
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 .
Michael Gasser
  Mit Zitat antworten Zitat
Antwort Antwort

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:39 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz