{ --▽---------------------------▼--
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;
    FParent: Integer;
    FVisible: Boolean;
    FIconHandle: DWORD;
    FWindowState: TWindowState;
    FProcessFilePath: String;
    FProcessID: Cardinal;
    FTopMost: Boolean;
    FRect: TRect;
    FIsHung: Boolean;

    FGotClassNameFlag: Boolean;
    FGotTextFlag: Boolean;
    FGotOwnerFlag: Boolean;
    FGotParentFlag: 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: HWND;
    function GetVisible: Boolean;
    function GetIconHandle: DWORD;
    function GetWindowState: TWindowState;
    function GetProcessID: Cardinal;
    function GetRect: TRect;
    function GetParent: HWND;
    function GetIsHung: Boolean;
  public
    constructor Create(h: HWND; LevelValue: Integer = 0);
    destructor Destroy; override;
    function GetNowTopMost: Boolean;
    function GetNowProcessFilePath: String;
    function GetNowWindowClass: String;
    function GetNowText(out IsHung: Boolean): String;
    function GetNowOwner: Integer;
    function GetNowVisible: Boolean;
    function GetNowIconHandle: DWORD;
    function GetNowWindowState: TWindowState;
    function GetNowProcessID: Cardinal;
    function GetNowRect: TRect;
    function GetNowParent: Integer;
    function GetNowIsHung: Boolean;
    property Handle: HWND read FHandle;
    property Level: Integer read FLevel;
    property WindowClass: String read GetWindowClass;
    property Text: String read GetText;
    property Owner: HWND read GetOwner;
    property Parent: HWND read GetParent;
    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;
    property IsHung: Boolean read GetIsHung;
  end;

//procedure EnumWindowInfo(WinInfoList: TList; SearchLevel: Integer = 0;
// Duplication: Boolean = True);
procedure EnumWindowInfo(WinInfoList: TList;
 SearchLevel: Integer = 0;
 Duplication: Boolean = True);

function WinInfoListIndexOf(h: HWND; WinList: TList): Integer;

function WindowInTaskBar(WinInfo: TWinInfo): Boolean;

function GetWindowHandleEX(Path: String;
 ClassName: String = ''; Title: String = ''): HWND;

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;
  FGotRectFlag := 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;

const
  HungText: String = '(応答なし)';

function TWinInfo.GetText: String;
begin
  if not FGotTextFlag then
  begin
    FText := GetNowText(FIsHung);
    FGotTextFlag := True;
  end;
  Result := FText;
end;
function TWinInfo.GetNowText(out IsHung: Boolean): String;
var
  WindowText: array [0..255] of Char;
  APIResult: DWORD;
begin
  //SendMessage(FHandle, WM_GETTEXT, 255, Integer(@WindowText));

  if 0 <> SendMessageTimeout(FHandle, WM_GETTEXT, 255, Integer(@Windowtext),
            SMTO_ABORTIFHUNG, 1000, APIResult) then
  begin
    Result := WindowText;
    IsHung := False;
  end else
  begin
    Result := HungText;
    IsHung := True;
  end;
end;
//SendMessageだとGhostWindowの次のウィンドウにメッセージを
//投げて呼び出すと、停止することがわかっている
//PostMessageならひとつもとれないこともわかっている。
(*
SendMessageTimeout
http://msdn.microsoft.com/library/ja/default.asp?url=/library/ja/jpwinui/html/_win32_sendmessagetimeout.asp
*)

//ハング確認処理はGetTextと同時に行っている。
function TWinInfo.GetIsHung: Boolean;
begin
  GetText;
  Result := FIsHung;
end;

function TWinInfo.GetNowIsHung: Boolean;
begin
  GetNowText(Result);
end;

function TWinInfo.GetOwner: HWND;
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.GetParent: HWND;
begin
  if not FGotParentFlag then
  begin
    FParent := GetNowParent;
    FGotParentFlag := True;
  end;
  Result := FParent
end;
function TWinInfo.GetNowParent: Integer;
begin
  Result := GetWindowLong(FHandle, GWL_HWNDPARENT);
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;
//--△----------------------▲--

{-------------------------------
//  タスクバーに登録されるWindowかどうかをチェックする
機能:
備考:
履歴:       2007/12/21(金) 02:09
//--▼----------------------▽--}
function WindowInTaskBar(WinInfo: TWinInfo): Boolean;
begin
  Result := False;
  if WinInfo.Visible = False then Exit;
  if WinInfo.Owner <> 0 then Exit;

  if WinInfo.WindowClass = 'Shell_TrayWnd' then Exit;
  if WinInfo.WindowClass = 'Progman' then Exit;

  Result := True;
end;
//--△----------------------▲--

{---------------------------------------
    Windowハンドルをリストアップしたものの中から見つける処理
機能:   Path/ClassName/Titleはどれか一つだけで指定しても
        条件に合うものがあればそれを返す
        Pathは必須指定だが EmptyStr を指定してもよい
備考:   
履歴:   
2012/10/15(月)
・  作成
}//(*-----------------------------------
function GetWindowHandleEX(Path: String;
 ClassName: String = ''; Title: String = ''): HWND;
var
  WindowList: TObjectList;
  WinInfo: TWinInfo;
  I: Integer;
begin
  Result := 0;
  if (ClassName = EmptyStr)
    and (Path = EmptyStr)
    and (Title = EmptyStr) then Exit;

  WindowList := TObjectList.Create; try
  EnumWindowInfo(WindowList);
  for I := 0 to WindowList.Count - 1 do
  begin
    WinInfo := TWinInfo(WindowList[I]);

    if (SameText(ClassName,WinInfo.WindowClass)) or (ClassName = EmptyStr) then
      if (SameText(Path,WinInfo.ProcessFilePath)) or (Path = EmptyStr)
        or (SameText(Path, ExtractFileName(WinInfo.ProcessFilePath))) then
        if (SameText(Title,WinInfo.Text)) or (Title = EmptyStr) then
        begin
          Result := WinInfo.Handle;
          Exit;
        end;
  end;
  finally WindowList.Free; end;
end;
//------------------------------------*)

initialization
  UEnumWinRunningFlag := False;

end.