Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Nach Variablenaufruf wird Variableninhalt gelöscht (https://www.delphipraxis.net/579-nach-variablenaufruf-wird-variableninhalt-geloescht.html)

Chewie 10. Aug 2002 16:04


Nach Variablenaufruf wird Variableninhalt gelöscht
 
Es gibt Tage, an denen zweifle ich an meinem Verstand...
Ich hab jetzt wieder ein ähnliches Problem wie das mit den Arrays (s.u.), aber diesmal hab ich nicht anstelle einer Variablen eine Zahl hingeschrieben.
Wieder einmal scheint ein Code zu funktionieren, solange, bis ich mir das Ergebnis testweise ausgegen will. Folgende Funnktion benutz ich:
Code:
[b]function[/b] GetThreadID(FileName: [b]String[/b]): DWord;
[b]var[/b]
  ToolHnd, MToolHnd: THandle;
  PE32: TProcessEntry32;
  ME32: TModuleEntry32;
  TE32: TThreadEntry32;
  PIDArray, ThreadArray: [b]Array[/b] [b]of[/b] Dword;
  a: Integer;
  PID: DWord;
[b]begin[/b]
  ToolHnd := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS [b]or[/b] TH32CS_SNAPTHREAD, 0); [i]//Handle auf Snapshot[/i]
  PE32.dwSize := SizeOf(ProcessEntry32);
  Process32First(ToolHnd, PE32); [i]//erster Prozess[/i]
  [b]if[/b] PE32.szExeFile = ExtractFileName(FileName) [b]then[/b]
  [b]begin[/b]
    SetLength(PIDArray, 1);
    PIDArray[0] := PE32.th32ProcessID;
  [b]end[/b];
  [b]while[/b] Process32Next(ToolHnd, PE32) [b]do[/b]
  [b]begin[/b]
    [b]if[/b] PE32.szExeFile = ExtractFileName(FileName) [b]then[/b]
    [b]begin[/b]
      SetLength(PIDArray, Length(PIDArray) + 1);
      PIDArray[Length(PIDARRAY) - 1] := PE32.th32ProcessID;
    [b]end[/b];
  [b]end[/b];
  [i]//ShowMessage(InttoStr(PIDArray[0]));
  { Jetzt sind alle PIDs der Prozesse, deren Dateinamen gleich dem gesuchten ist, gespeichert }
  { Jetzt wird für jeden Prozess anhand der Modulliste der vollständige Pfad ermittelt und so }
  { die endgültige, richtige ProcessID ermittelt.                                            }[/i]

  PID := 0;
  [b]for[/b] a := 0 [b]to[/b] Length(PIDArray) -1 [b]do[/b]
  [b]begin[/b]
    MToolHnd := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PIDArray[a]); [i]//Modulliste des gewählten Prozesses[/i]
    Module32First(MToolhnd, ME32);
    [b]if[/b] ME32.szExePath = FileName [b]then[/b]
    [b]begin[/b]
      PID := ME32.th32ProcessID;
    [b]end[/b]
    [b]else[/b]
    [b]while[/b] Module32Next(MToolHnd, ME32) [b]do[/b]
    [b]begin[/b]
      [b]if[/b] ME32.szExePath = FileName [b]then[/b]
      [b]begin[/b]
        PID := ME32.th32ProcessID;
        break;
      [b]end[/b];
    [b]end[/b];
    CloseHandle(MToolHnd);
    [b]if[/b] PID <> 0 [b]then[/b] break;
  [b]end[/b];
  [i]//ShowMessage(InttoStr(PID));

  { Jetzt werden alle Threads des Prozesses ermittelt                                        }[/i]

  TE32.dwSize := SizeOf(ThreadEntry32);
  Thread32First(ToolHnd, TE32);
  [i]//Form1.Listbox1.Items.Add(InttoStr(TE32.th32OwnerProcessID) + 'Thread ' + InttoStr(TE32.th32ThreadID) + ' gehört zu Prozess ' + InttoStr(TE32.th32OwnerProcessID));[/i]
  [b]if[/b] TE32.th32OwnerProcessID = PID [b]then[/b]
  [b]begin[/b]
    SetLength(ThreadArray,1);
    ThreadArray[0] := TE32.th32ThreadID;
  [b]end[/b];
  [b]while[/b] Thread32Next(ToolHnd, TE32) [b]do[/b]
  [b]begin[/b]
    [i]//Form1.Listbox1.Items.Add(InttoStr(TE32.th32OwnerProcessID) + 'Thread ' + InttoStr(TE32.th32ThreadID) + ' gehört zu Prozess ' + InttoStr(TE32.th32OwnerProcessID));[/i]
    [b]if[/b] TE32.th32OwnerProcessID = PID [b]then[/b]
    [b]begin[/b]
      SetLength(ThreadArray,1);
      ThreadArray[0] := TE32.th32ThreadID;
    [b]end[/b];
  [b]end[/b];
  CloseHandle(ToolHnd);
  ShowMessage(InttoStr(ThreadArray[0]));
  Result := ThreadArray[0];
[b]end[/b];
Das blöde ist, dass ich leider nicht so ganz testen kann, ob sie funktioniert. Weil wenn ich gegen Ende der Funktion mir das Ergebnis ausgeben lasse, komme ich zu dem gewünschten Wert. Wenn ich mir aber den Rückgabewert der Funktion nach dem Aufruf ausgeben will, bekomme ich 0. Damit nicht genug, auch der ShowMessage-Aufruf in der Funktion liefert 0.
Doch es ist nicht nur bei der Thread-ID so. Auch die Prozess-ID ist bei mehrmaligem Ausgeben 0.
Deswegen kann ich nicht testen, ob die Funktion den richtigen Wert zurückliefert. Na ja, OK, ich könnt ihn in ne Datei schreiben, vielleicht würde das gehen. Aber trotzdem würd ich brennend gerne wissen, warum in aller welt sowas passiert. Ihr könnt die Funktion gern mal testen, sie liefert die ThreadID des ersten Threads der laufenden Anwendung, die per filename an die Funktion übergeben wurde. Vergleicht mal, was passiert, wenn ihr die Funnktion einnfach so aufruft und was passiert, wenn ihr den Rückgabewert euch anzeigen lasst. Würd mich wirklich interessieren, ob das Problem auch bei anderen auftaucht oder ob mein WinXP Schuld ist.

Nachtrag: Wenn ich die Funktion auf die eigene Anwendung anwende, scheint das Problem nicht aufzutauchen.

jbg 10. Aug 2002 17:35

Du hast da ein paar wichtige Sachen vergessen.

1. Du musst dein Array PIDArray und ThreadArray zuerst initialisieren, da es sonst, wenn kein entsprechender Prozess gefunden wird, zu einer Schutzverletzung kommen kann.

2. Du musst auch vor dem Aufruf von Module32First das Feld dwSize von ME32 auf SizeOf(TModuleEntry32) setzen.

3. Deine Dateinamen-Vergleiche haben das Manko, dass sie zwischen Groß-/Kleinschreibung unterscheiden, was sie aber nicht sollten, da der Dateiname 'delphi32.exe' gleichbedeutend mit 'DELPHI32.EXE' ist.

4. Es fehlen die try/finally sowie Fehler-Auswertungsroutinen. Z.B. kann es vorkommen, dass du keinen Berechtigung für das Auflisten der Module eines Prozess hast...

Hier hast du eine von mir überarbeitete Version deines Codes.
Code:
function GetThreadID(const FileName: String): DWord;
var
  ToolHnd, MToolHnd: THandle;
  PE32: TProcessEntry32;
  ME32: TModuleEntry32;
  TE32: TThreadEntry32;
  PIDArray, ThreadArray: Array of Dword;
  a: Integer;
  PID: DWord;
begin
  PIDArray := nil;
  ThreadArray := nil;
  ToolHnd := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD, 0); //Handle auf Snapshot
  if ToolHnd = INVALID_HANDLE_VALUE then RaiseLastOSError;
  try
    PE32.dwSize := SizeOf(ProcessEntry32);
    if not Process32First(ToolHnd, PE32) then RaiseLastOSError; //erster Prozess
    repeat
      if CompareText(PE32.szExeFile, ExtractFileName(FileName)) = 0 then
      begin
        SetLength(PIDArray, Length(PIDArray) + 1);
        PIDArray[Length(PIDARRAY) - 1] := PE32.th32ProcessID;
      end;
    until not Process32Next(ToolHnd, PE32);
    //ShowMessage(InttoStr(PIDArray[0]));
    { Jetzt sind alle PIDs der Prozesse, deren Dateinamen gleich dem gesuchten ist, gespeichert }
    { Jetzt wird für jeden Prozess anhand der Modulliste der vollständige Pfad ermittelt und so }
    { die endgültige, richtige ProcessID ermittelt.                                            }

    PID := 0;
    for a := 0 to Length(PIDArray) -1 do
    begin
      MToolHnd := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PIDArray[a]); //Modulliste des gewählten Prozesses
      if MToolHnd = INVALID_HANDLE_VALUE then RaiseLastOSError;
      try
        ME32.dwSize := SizeOf(TModuleEntry32);
        if not Module32First(MToolhnd, ME32) then RaiseLastOSError;
        repeat
          if CompareText(ME32.szExePath, FileName) = 0 then
          begin
            PID := ME32.th32ProcessID;
            Break;
          end;
        until not Module32Next(MToolHnd, ME32);
      finally
        CloseHandle(MToolHnd);
      end;
      if PID <> 0 then Break;
    end;
    //ShowMessage(IntToStr(PID));

    { Jetzt werden alle Threads des Prozesses ermittelt                                        }

    TE32.dwSize := SizeOf(ThreadEntry32);
    if not Thread32First(ToolHnd, TE32) then RaiseLastOSError;
    repeat
      //Form1.Listbox1.Items.Add(InttoStr(TE32.th32OwnerProcessID) + 'Thread ' + InttoStr(TE32.th32ThreadID) + ' gehört zu Prozess ' + InttoStr(TE32.th32OwnerProcessID));
      if TE32.th32OwnerProcessID = PID then
      begin
        SetLength(ThreadArray, Length(ThreadArray) + 1);
        ThreadArray[Length(ThreadArray) - 1] := TE32.th32ThreadID;
      end;
    until not Thread32Next(ToolHnd, TE32);
  finally
    CloseHandle(ToolHnd);
  end;
  if Length(ThreadArray) > 0 then
  begin
    ShowMessage(IntToStr(ThreadArray[0]));
    Result := ThreadArray[0];
  end else Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(GetThreadID('C:\Programme\Borland\Delphi6\Bin\Delphi32.exe')));
end;

Chewie 10. Aug 2002 18:00

Hi! Erstmal danke für deine Überarbeitung. Ich hab jetzt noch nicht die neue Version ausprobiert, werd dies aber noch tun um zu sehen, ob der gleiche Fehler immer noch auftaucht. Nachfolgendes mal zur "Rechtfertigung": :mrgreen:

zu 1. Ist mir auch klar, aber da das Programm nur für mich selbst ist und ich weiß, wann ich es einsetze, würde der Fehler wohl nicht auftauchen. Deswegen hab ich mir die Mühe gespart.

zu 2. Hab ich wirklich vergessen.

zu 3. siehe 2

zu 4. Brauch ich eigentlich nicht, da wie bei 1. beschrieben, das Dingens für mich ist und nur für den Optimalablauf entwickelt ist. Aber schaden kanns ja nicht. Ist vielleicht ganz gut, auch Fehlerabfangroutinen einzubauen, wenn man sie nicht unbedingt braucht, einfach zur Gewöhnung.

Chewie 11. Aug 2002 12:07

Na ja, ich weiß nicht genau warum, aber jetzt scheint es zu funktionieren. Ich denk mal, es lag an der fehlenden Initialisierung des dwSize-Felds der ME32-Struktur. Wie auch immer, ich danke dir.


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:14 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz