Einzelnen Beitrag anzeigen

TUX_der_Pinguin

Registriert seit: 1. Jun 2005
Ort: Anholt (NRW)
608 Beiträge
 
Delphi 11 Alexandria
 
#1

Alle Fenster jedes Threads einer Anwendung

  Alt 22. Aug 2014, 09:32
Hallo DPler,

ich möchte in meiner Anwendung alle Fenster einer anderen Anwendung auflisten. Dazu habe ich u.a. hier im Forum gesucht und jemand schrieb man sollte erst alle Threads eines Prozesses auflisten um anschließend alle Fenster der einzelnen Threads zu bekommen.

Für den ersten Teil, Auflistung aller Threads habe ich hier folgenden Code gefunden. Wie mir scheint klappt das auflisten der Threads auch nur beim ermitteln der Fenster der jeweiligen Threads happert es noch gewaltig.
Delphi-Quellcode:
type
  TDWordList = array of DWord;


function GetThreadID(const FileName: String): TDWordList;
var
  ToolHnd, MToolHnd: THandle;
  PE32: TProcessEntry32;
  ME32: TModuleEntry32;
  TE32: TThreadEntry32;
  PIDArray, ThreadArray: TDWordList;
  a: Integer;
  PID: DWord;

begin
  //init
  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);

    { 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;

    { Jetzt werden alle Threads des Prozesses ermittelt                                         }

    TE32.dwSize := SizeOf(ThreadEntry32);
    if not Thread32First(ToolHnd, TE32) then RaiseLastOSError;
    repeat
      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
    Result := ThreadArray;
  end
  else
    Result := nil;

end;
Lasse ich im ersten Schritt in der Schleife nur die Thread IDs ausgeben erhalte ich eine Liste von Nummern, will ich jetzt dazu die Fenster auflisten tritt nach der Ausgabe der ersten Thread ID ein Bereichsprüfungs Fehler auf.
Delphi-Quellcode:
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmMain = class(TForm)
    Memo1: TMemo;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

function EnumThreadWinProc(Wnd: HWND; LParam: LPARAM): Boolean;
var
  WinCaption: String;
  Len: Integer;

begin
  result := True;

  Len := GetWindowTextLength(Wnd);
  SetLength(WinCaption, Len);
  GetWindowText(Wnd, PChar(WinCaption), Len+1);
  if Trim(WinCaption) <> EmptyStr then
    TMemo(LParam).Lines.Add(' '+Trim(WinCaption));

end;

procedure TfrmMain.Button3Click(Sender: TObject);
var
  TL: TDWordList;
  Idx: Integer;

begin
  //Alle Threads einer Anwendung ermitteln
  TL := GetThreadID('c:\Programme\totalcmd\totalcmd.exe');

  //Alle Fenster jedes Threads einer Anwendung auflisten
  for Idx := 0 to High(TL) do begin
    Memo1.Lines.Add('Thread ID: '+IntToStr(TL[Idx])); //<-- Fehler in der Bereichsprüfung
    EnumThreadWindows(TL[Idx], @EnumThreadWinProc, Integer(Memo1));
  end;{for}

end;

end.
Ich habe keinen Schimmer wo der Fehler liegt.

Es geht mir ganz allgemein darum zu Prüfen ob zu einer Anwendung, ich kenne Name und Ort der Exe-Datei, noch Fenster geöffnet sind. Sind keine Fenster mehr geöffnet und nur noch der Prozess vorhanden könnte man annehmen beim Beenden der Anwendung sei etwas schief gegangen und der Prozess hängt.
  Mit Zitat antworten Zitat