{ ----------------------------------- Windowを列挙するユニット 2004/12/28 作成 2006/07/05(水) ・Duplicationフラグを実装してListに 重複書き込みできない機能を付けた //----------------------------------- } unit EnumWinUnit; interface uses Windows, Messages, Classes, Forms, //TWindowStateの為 // SysUtils, Contnrs, SysUtils, WindowUnit, SystemUnit, XPtest; type TWinInfo = class private FHandle: HWND; FLevel: Integer; FWindowClass: String; FText: String; FOwner: Integer; FVisible: Boolean; FIconHandle: DWORD; FWindowState: TWindowState; FProcessFilePath: String; FProcessID: Cardinal; FTopMost: Boolean; FRect: TRect; FGotClassNameFlag: Boolean; FGotTextFlag: Boolean; FGotOwnerFlag: Boolean; FGotVisibleFlag: Boolean; FGotIconHandleFlag: Boolean; FGotWindowStateFlag: Boolean; FGotProcessFilePathFlag: Boolean; FGotTopMostFlag: Boolean; FGotProcessIDFlag: Boolean; FGotRectFlag: Boolean; function GetTopMost: Boolean; function GetProcessFilePath: String; function GetWindowClass: String; function GetText: String; function GetOwner: Integer; function GetVisible: Boolean; function GetIconHandle: DWORD; function GetWindowState: TWindowState; function GetProcessID: Cardinal; function GetRect: TRect; function GetNowRect: TRect; public constructor Create(h: HWND; LevelValue: Integer = 0); destructor Destroy; override; function GetNowTopMost: Boolean; function GetNowProcessFilePath: String; function GetNowWindowClass: String; function GetNowText: String; function GetNowOwner: Integer; function GetNowVisible: Boolean; function GetNowIconHandle: DWORD; function GetNowWindowState: TWindowState; function GetNowProcessID: Cardinal; property Handle: HWND read FHandle; property Level: Integer read FLevel; property WindowClass: String read GetWindowClass; property Text: String read GetText; property Owner: Integer read GetOwner; property Visible: Boolean read GetVisible; property IconHandle: DWORD read GetIconHandle; property WindowState: TWindowState read GetWindowState; property ProcessFilePath: String read GetProcessFilePath; property TopMost: Boolean read GetTopMost; property ProcessID: Cardinal read GetProcessID; property Rect: TRect read GetRect; end; procedure EnumWindowInfo(WinInfoList: TList; SearchLevel: Integer = 0; Duplication: Boolean = True); function WinInfoListIndexOf(h: HWND; WinList: TList): Integer; var UEnumWinRunningFlag: Boolean; implementation var UWinInfoTempList: TList; UEnumSearchLevel: Integer; {------------------------------- // Windowを列挙する // EnumWndProc/EnumChildWndProc // EnumWindowInfo 機能: Windowsで動作中のWindow情報を取得、列挙します 引数説明: EnumWndProc/EnumChildWndProc h: コールバックで取得出来る他アプリのハンドル l: コールバックの呼び出し階層 0ならTopWindowのみ 1ならTopWindowと一つ下の子Windowを列挙する EnumWindowInfo SearchLevel: 0ならTopWindowのみ 1ならTopWindowと一つ下の子Windowを列挙する 戻り値: EnumWndProc/EnumChildWndProcは API呼び出しなので常にTrueを返すことにしている。 処理: EnumWindowInfoが呼び出されて コールバック関数の EnumWndProc/EnumChildWndProc が呼び出される 備考: uses Classes必要 2005/11/10 タスクマネージャのアプリケーションタブに 列挙されるアプリケーションは、 Window列挙で次の条件に適合したものになる。 Visible=True/Text<>''/Owner=0 履歴: 2000/09/17 2004/12/28 改めて実装チェック修正 Window階層指定列挙と動作確認を行った SerchLevel=0なら一番上のWindowが列挙される 2006/07/05(水) Duplicationフラグにより重複書込不許可機能を付けた //------------------------------} function WinInfoListIndexOf(h: HWND; WinList: TList): Integer; var i: Integer; begin Result := -1; for i := 0 to WinList.Count - 1 do begin if TWinInfo(WinList.Items[i]).Handle = h then begin Result := i; break; end; end; end; function EnumChildWndProc(h: HWND; l: Integer): BOOL; stdcall; var WindowInfo: TWinInfo; begin Result := False; try if UEnumWinRunningFlag = False then Exit; WindowInfo := TWinInfo.Create(h, l); UWinInfoTempList.Add(WindowInfo); //GetWindowThreadProcessID(h, @processID); {↑よくわからないが、動作がなめらかになる? よくわからないのでコメントアウトしてみている} if l+1 <= UEnumSearchLevel then begin EnumChildWindows(h, @EnumChildWndProc, l+1); end; finally Result := true; end; end; function EnumWndProc(h: HWND; l: Integer): BOOL; stdcall; var WindowInfo: TWinInfo; begin Result := False; try if UEnumWinRunningFlag = False then Exit; WindowInfo := TWinInfo.Create(h, l); UWinInfoTempList.Add(WindowInfo); //GetWindowThreadProcessID(h, @processID); {↑よくわからないが、これがあると動作がなめらかになる? よくわからないのでコメントアウトしてみている} if l+1 <= UEnumSearchLevel then begin EnumChildWindows(h, @EnumChildWndProc, l+1); end; finally Result := True; end; // DebugPrintNotepad(IntToStr(h) + ' ' + IntToStr(l)); end; procedure EnumWindowInfo(WinInfoList: TList; SearchLevel: Integer = 0; Duplication: Boolean = True); var i: Integer; // DeleteItem: TWinInfo; begin UWinInfoTempList := TList.Create; try UEnumSearchLevel := SearchLevel; UEnumWinRunningFlag := True; try EnumWindows(@EnumWndProc, 0); {←Topレベルウィンドウなので0を指定} finally UEnumWinRunningFlag := False; end; // DebugPrintNotepad('EnumWindows通過'); if Duplication then begin for i := 0 to UWinInfoTempList.Count-1 do begin WinInfoList.Add(UWinInfoTempList.Items[0]); UWinInfoTempList.Delete(0); end; end else begin {↓キャッシュの中から現状OS上に存在していないWindowを消去} for i := WinInfoList.Count-1 downto 0 do begin if WinInfoListIndexOf( TWinInfo(WinInfoList.Items[i]).FHandle, UWinInfoTempList)=-1 then begin if WinInfoList is TObjectList then begin WinInfoList.Delete(i); end else begin TWinInfo(WinInfoList.Items[i]).Free; WinInfoList.Delete(i); end; end; end; {↓キャッシュの中にない現状OS上に存在しているWindowを追加} {↓For downtoでやってもよかったがAddが逆順になるのでこれで行った} i := 0; while i <= (UWinInfoTempList.Count-1) do begin if WinInfoListIndexOf( TWinInfo(UWinInfoTempList.Items[i]).FHandle, WinInfoList)=-1 then begin WinInfoList.Add(UWinInfoTempList.Items[i]); UWinInfoTempList.Delete(i); end else begin Inc(i); end; end; end; finally {↓列挙した一時リストの不要分を破棄する} for i := UWinInfoTempList.Count-1 downto 0 do TWinInfo(UWinInfoTempList.Items[i]).Free; UWinInfoTempList.Free; end; end; //------------------------------ {------------------------------- // TWinInfo 機能: Create時に指定したWindowハンドルから Windowの様々な情報を取得するクラス 備考: APIを直接指定してWin情報を取得するのは スマートじゃないので作った 履歴: 2005/09/25 ・TWindowInfoからTWinInfoに名称変更 TWindowInfoだとWindows.pasのクラスと名前がかぶる //------------------------------} {↓元々の動作していたコード} //{ TWindowInfo } //constructor TWindowInfo.Create(h: HWND; LevelValue: Integer); //var // WindowClassName, WindowCaption: array [0..255] of Char; //begin // inherited Create; // //ウィンドウクラスの情報を取得 // GetClassname(h, WindowClassName, 255); // SendMessage(h, WM_GETTEXT, 255, Integer(@WindowCaption)); // // with Self do // begin // ClassName := WindowClassName; // Caption := WindowCaption; // Owner := GetWindow(h, GW_OWNER); // Visible := IsWindowVisible(h); // Handle := h; // Level := LevelValue; // end; //end; constructor TWinInfo.Create(h: HWND; LevelValue: Integer = 0); begin inherited Create; FHandle := h; FLevel := LevelValue; FGotClassNameFlag := False; FGotTextFlag := False; FGotOwnerFlag := False; FGotVisibleFlag := False; FGotIconHandleFlag := False; FGotWindowStateFlag := False; FGotProcessFilePathFlag := False; FGotTopMostFlag := False; FGotProcessIDFlag := False; end; destructor TWinInfo.Destroy; begin inherited; end; function TWinInfo.GetWindowClass: String; begin if not FGotClassNameFlag then begin FWindowClass := GetNowWindowClass; FGotClassNameFlag := True; end; Result := FWindowClass; end; function TWinInfo.GetNowWindowClass: String; var WindowClass: String; //ComCtrls.pasのクラス名取得方法をまねてみた begin //ウィンドウクラスの情報を取得 SetLength(WindowClass, 80); Windows.GetClassname(FHandle, PChar(WindowClass), Length(WindowClass)); Result := String(PChar(WindowClass)); end; //このコードでも取得できるとは思うが... //function TWinInfo.GetClassName: String; //var // WindowClassName: array [0..255] of Char; //begin // if not FGotClassNameFlag then // begin // //ウィンドウクラスの情報を取得 // Windows.GetClassname(FHandle, WindowClassName, 255); // FClassName := WindowClassName; // FGotClassNameFlag := True; // end; // Result := FClassName; //end; function TWinInfo.GetText: String; begin if not FGotTextFlag then begin FText := GetNowText; FGotTextFlag := True; end; Result := FText; end; function TWinInfo.GetNowText: String; var WindowText: array [0..255] of Char; begin SendMessage(FHandle, WM_GETTEXT, 255, Integer(@WindowText)); Result := WindowText; end; function TWinInfo.GetOwner: Integer; begin if not FGotOwnerFlag then begin FOwner := GetNowOwner; FGotOwnerFlag := True; end; Result := FOwner end; function TWinInfo.GetNowOwner: Integer; begin Result := GetWindow(FHandle, GW_OWNER); end; function TWinInfo.GetVisible: Boolean; begin if not FGotVisibleFlag then begin FVisible := GetNowVisible; FGotVisibleFlag := True; end; Result := FVisible end; function TWinInfo.GetNowVisible: Boolean; begin Result := IsWindowVIsible(FHandle); end; function TWinInfo.GetIconHandle: DWORD; begin if not FGotIconHandleFlag then begin FIconHandle := GetNowIconHandle; FGotIconHandleFlag := True; end; Result := FIconHandle; end; function TWinInfo.GetNowIconHandle: DWORD; begin Result := GetClassLong(FHandle, GCL_HICONSM); end; function TWinInfo.GetWindowState: TWindowState; begin if not FGotWindowStateFlag then begin FWindowState := GetNowWindowState; FGotWindowStateFlag := True; end; Result := FWindowState; end; function TWinInfo.GetNowWindowState: TWindowState; begin Result := WindowUnit.GetWindowState(FHandle); end; function TWinInfo.GetProcessFilePath: String; begin if not FGotProcessFilePathFlag then begin FProcessFilePath := GetNowProcessFilePath; FGotProcessFilePathFlag := True; end; Result := FProcessFilePath; end; function TWinInfo.GetNowProcessFilePath: String; begin Result := WindowUnit.GetProcessFileNameFromWinHandle(FHandle); end; function TWinInfo.GetProcessID: Cardinal; begin if not FGotProcessIDFlag then begin FProcessID := GetNowProcessID; FGotProcessIDFlag := True; end; Result := FProcessID; end; function TWinInfo.GetNowProcessID: Cardinal; begin Result := GetProcessIDFromWinHandle(FHandle); end; function TWinInfo.GetRect: TRect; begin if not FGotRectFlag then begin FRect := GetNowRect; FGotRectFlag := True; end; Result := FRect; end; function TWinInfo.GetNowRect: TRect; begin Result := GetWinRect(FHandle); end; function TWinInfo.GetTopMost: Boolean; begin if not FGotTopMostFlag then begin FTopMost := GetNowTopMost; FGotTopMostFlag := True; end; Result := FTopMost; end; function TWinInfo.GetNowTopMost: Boolean; begin Result := WindowUnit.IsTopMostWnd(FHandle); end; //------------------------------ initialization UEnumWinRunningFlag := False; end.