AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi Nach Variablenaufruf wird Variableninhalt gelöscht
Thema durchsuchen
Ansicht
Themen-Optionen

Nach Variablenaufruf wird Variableninhalt gelöscht

Ein Thema von Chewie · begonnen am 10. Aug 2002 · letzter Beitrag vom 11. Aug 2002
Antwort Antwort
Chewie

Registriert seit: 10. Jun 2002
Ort: Deidesheim
2.886 Beiträge
 
Turbo Delphi für Win32
 
#1

Nach Variablenaufruf wird Variableninhalt gelöscht

  Alt 10. Aug 2002, 17:04
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.
Martin Leim
Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
  Mit Zitat antworten Zitat
jbg

Registriert seit: 12. Jun 2002
3.483 Beiträge
 
Delphi 10.1 Berlin Professional
 
#2
  Alt 10. Aug 2002, 18: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;
  Mit Zitat antworten Zitat
Chewie

Registriert seit: 10. Jun 2002
Ort: Deidesheim
2.886 Beiträge
 
Turbo Delphi für Win32
 
#3
  Alt 10. Aug 2002, 19: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":

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.
Martin Leim
Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
  Mit Zitat antworten Zitat
Chewie

Registriert seit: 10. Jun 2002
Ort: Deidesheim
2.886 Beiträge
 
Turbo Delphi für Win32
 
#4
  Alt 11. Aug 2002, 13: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.
Martin Leim
Egal wie dumm man selbst ist, es gibt immer andere, die noch dümmer sind
  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 06:53 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