//Хранение информации о окне в файле
 PWindowData = ^TWindowData;
 TWindowData = record
   winOther: Word;
   winText, winClass: string;
   winRect: TRect;
   //Вспомогательные данные
   winHandle: THandle;
   winEnabled, winVisible: Boolean;
 end;

 PPWD = PWindowData;

 TFindObject = class(TObject)
 private
   FListObjects: TList;
   FobjClass: string;
   FTopLevel: HWND;
   FWindowData: PPWD;
   FLastHwnd: HWND;
   function Find(hLast: HWND): HWND;
   procedure Add(h: HWND);
   function Search(h: HWND): bool;
   procedure FreeMemory();
 public
   function GetHWND(): HWND;
   function FindFirst(): HWND;
   function FindNext(): HWND;
   procedure SetClass(objClass: string);
   procedure CopyWindowData(var outPointer: PPWD);
   constructor Create(objClass: string);
   destructor Destroy(); override;
 end;

{ TFindObject }

procedure TFindObject.Add(h: HWND);
var
 p: PHWND;
begin
 new(p);
 p^ := h;
 FListObjects.Add(p);
end;

procedure TFindObject.CopyWindowData(var outPointer: PPWD);
begin
 with outPointer^ do begin
   winOther :=   FWindowData.winOther;
   winText  :=   FWindowData.winText;
   winClass :=   FWindowData.winClass;
   winRect  :=   FWindowData.winRect;
   winHandle  := FWindowData.winHandle;
   winEnabled := FWindowData.winEnabled;
   winVisible := FWindowData.winVisible;
 end;
end;

constructor TFindObject.Create(objClass: string);
begin
 FobjClass := objClass;
 FListObjects := TList.Create;
 FLastHWND := 0;
 FTopLevel := FindWindow('Progman', 'Program Manager');
 New(FWindowData);
end;

destructor TFindObject.Destroy;
begin
 FreeMemory();
 FListObjects.Free;
 Dispose(FWindowData);
 inherited;
end;

function TFindObject.Find(hLast: HWND): HWND;
begin
 result := 0;
 if hLast = 0 then exit;
 WindowData(hLast, FWindowData);
 if (FWindowData.winClass = FobjClass) and (not Search(hLast)) then begin
   Add(hLast);
   FLastHWND := hLast;
   result := hLast;
   exit;
 end;
 result := Find(GetWindow(GetWindow(hLast, GW_CHILD), GW_HWNDFIRST));
 if result <> 0 then exit;
 result := Find(GetWindow(hLast, GW_HWNDNEXT));
end;

function TFindObject.FindFirst: HWND;
begin
 FreeMemory;
 Result := Find(GetWindow(FTopLevel, GW_HWNDFIRST));
end;

function TFindObject.FindNext: HWND;
begin
 result := Find(GetWindow(FTopLevel, GW_HWNDFIRST));
end;

procedure TFindObject.FreeMemory;
var
 p: PHWND;
begin
 while FListObjects.Count <> 0 do begin
   p := PHWND(FListObjects.First);
   Dispose(p);
   FListObjects.Delete(0);
 end;
end;

function TFindObject.GetHWND: HWND;
begin
 Result := FLastHWND;
end;

function TFindObject.Search(h: HWND): bool;
var
 a: integer;
begin
 result := false;
 if FListObjects.Count = 0 then exit;
 for a := 0 to FListObjects.Count - 1 do
   if HWND(FListObjects.Items[a]^) = h then begin
     result := true;
     exit;
   end;
end;

procedure TFindObject.SetClass(objClass: string);
begin
 FreeMemory;
 FobjClass := objClass;
end;

//функция собирает информацию об окне
//её нужно будет объявить перед реализацией класса
procedure WindowData(handle: THandle; var p: PWindowData);
var
 Buffer: PChar;
begin
 if (handle = 0) or (p = nil) then exit;
 Buffer := StrAlloc(256);
 //WinText
 GetWindowText(handle, Buffer, 256);
 p^.winText := Trim(StrPas(Buffer));
 GetClassName(handle, Buffer, 255);
 //WinClass
 p^.winClass := Trim(StrPas(Buffer));
 //WinRect
 GetWindowRect(handle, p^.winRect);
 //WinHandle
 p^.winHandle := Handle;
 //WinEnabled
 p^.winEnabled := IsWindowEnabled(handle);
 //WinVisibled
 p^.winVisible := isWindowVisible(handle);
 p^.winOther := MakeWord(WD_TEMP, 0);
 StrDispose(Buffer);
end;

unit unFindObjects;

interface

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

type
 PHWND = ^HWND;
 PWindowData = ^TWindowData;
 TWindowData = record
   winText, winClass: string;
   winRect: TRect;
   winHandle: THandle;
   winEnabled, winVisible: Boolean;
 end;

 TEventFindProc = function(sText, sClass: string; pData: PWindowData): bool;
 
 //инструмент для поиска окон    
 TFindObjects = class(TObject)
 protected
   FListObjects: TList;
   FobjClass, FobjText: string;
   FTopLevel: HWND;
   FWindowData: PWindowData;
   FLastHwnd: HWND;
   FEventFindProc: TEventFindProc;
   function Find(hLast: HWND): HWND;
   procedure Add(h: HWND);
   function Search(h: HWND): bool;
   procedure FreeMemory();
 public    
   //получение информации об окне
   class procedure WindowData(handle: THandle; var p: PWindowData);    
   //проверка принадлежит окно windows окну parent,
   //буквально можно проверить принадлежит кнопка (window) форме (parent)
   class function FindParentWindow(Window, Parent: HWND): bool;    
   //найти первое окно по условию
   function FindFirst(): HWND;
   //следущее окно
   function FindNext(): HWND;
   //найти сразу все окна  
   procedure FindAll();      
   //доступ к найденным окнам
   procedure Item(index: integer; var outPointer: PWindowData);
   //количество найденных окон
   function Count(): integer;  
   //указатель на последнее наденное окно
   function GetLastHWND(): HWND;      
   //установить новые параметры для поиска окон
   procedure SetClass(objClass: string);
   procedure SetText(objText: string);    
   constructor Create(objClass, objText: string; EventFindProc: TEventFindProc);
   destructor Destroy(); override;
 end;
 
 function DefEventFindProc(sText, sClass: string; pData: PWindowData): bool;
 function DefEventFindProcB(sText, sClass: string; pData: PWindowData): bool;

var
 hGRYM: TFindObjects;
 
implementation  
 
{ TFindObjects }

class procedure TFindObjects.WindowData(handle: THandle; var p: PWindowData);
var
 Buffer: PChar;
begin
 if (handle = 0) or (p = nil) then exit;
 Buffer := StrAlloc(256);
 GetWindowText(handle, Buffer, 256);
 p^.winText := Trim(StrPas(Buffer));
 GetClassName(handle, Buffer, 255);
 p^.winClass := Trim(StrPas(Buffer));
 GetWindowRect(handle, p^.winRect);
 p^.winHandle := Handle;
 p^.winEnabled := IsWindowEnabled(handle);
 p^.winVisible := isWindowVisible(handle);
 StrDispose(Buffer);  
end;  

procedure TFindObjects.Add(h: HWND);
var
 p: PHWND;
begin
 new(p);
 p^ := h;
 FListObjects.Add(p);
end;

function TFindObjects.Count: integer;
begin
 result := FListObjects.Count;
end;

constructor TFindObjects.Create(objClass, objText: string; EventFindProc: TEventFindProc);
begin
 FobjClass := objClass;
 FobjText := objText;
 if Assigned(EventFindProc) then
   FEventFindProc := EventFindProc
 else
   FEventFindProc := DefEventFindProc;
 FListObjects := TList.Create;
 FLastHWND := 0;
 FTopLevel := FindWindow('Progman', 'Program Manager');
 new(FWindowData);
end;

destructor TFindObjects.Destroy;
begin
 FreeMemory();
 FListObjects.Free;
 Dispose(FWindowData);
 inherited;
end;

function TFindObjects.Find(hLast: HWND): HWND;
begin
 result := 0;
 if hLast = 0 then exit;
 WindowData(hLast, FWindowData);
 if (FEventFindProc(FobjText, FobjClass, FWindowData)) and (not Search(hLast)) then begin
   Add(hLast);
   FLastHWND := hLast;
   result := hLast;
   exit;
 end;
 result := Find(GetWindow(GetWindow(hLast, GW_CHILD), GW_HWNDFIRST));
 if result <> 0 then exit;
 result := Find(GetWindow(hLast, GW_HWNDNEXT));
end;

procedure TFindObjects.FindAll;
var
 h: HWND;
begin
 h := FindFirst();
 while h <> 0 do h := FindNext();  
end;

function TFindObjects.FindFirst: HWND;
begin
 FreeMemory;
 Result := Find(GetWindow(FTopLevel, GW_HWNDFIRST));
end;

function TFindObjects.FindNext: HWND;
begin
 result := Find(GetWindow(FTopLevel, GW_HWNDFIRST));
end;

class function TFindObjects.FindParentWindow(Window, Parent: HWND): bool;
begin
 result := false;
 while (Window <> parent) do begin
   Window := GetParent(Window);
   if window = 0 then exit;
 end;
 result := true;
end;

procedure TFindObjects.FreeMemory;
var
 p: PHWND;
begin
 while FListObjects.Count <> 0 do begin
   p := PHWND(FListObjects.First);
   Dispose(p);
   FListObjects.Delete(0);
 end;
end;

function TFindObjects.GetLastHWND: HWND;
begin
 Result := FLastHWND;
end;

procedure TFindObjects.Item(index: integer; var outPointer: PWindowData);
var
 pData: PWindowData;
begin
 outPointer.winHandle := 0;
 if (index < 0) or (index >= FListObjects.Count) then exit;
 pData := PWindowData(FListObjects[index]);
 with outPointer^ do begin
   winText  :=   pData.winText;
   winClass :=   pData.winClass;
   winRect  :=   pData.winRect;
   winHandle  := pData.winHandle;
   winEnabled := pData.winEnabled;
   winVisible := pData.winVisible;
 end;
end;

function TFindObjects.Search(h: HWND): bool;
var
 a: integer;
begin
 result := false;
 if FListObjects.Count = 0 then exit;
 for a := 0 to FListObjects.Count - 1 do
   if HWND(FListObjects.Items[a]^) = h then begin
     result := true;
     exit;
   end;
end;

procedure TFindObjects.SetClass(objClass: string);
begin
 FreeMemory;
 FobjClass := objClass;
end;  

procedure TFindObjects.SetText(objText: string);
begin
 FreeMemory;
 FobjText:= objText;
end;
     
function DefEventFindProc(sText, sClass: string; pData: PWindowData): bool;
begin
 result := true;
 if (sText = pData.winText) or (sClass = pData.winClass) then exit;
 result := false;
end;

function DefEventFindProcB(sText, sClass: string; pData: PWindowData): bool;
begin
 result := true;
 if (Pos(sText, pData.winText) <> 0) and (Pos(sClass, pData.winClass) <> 0) then exit;
 result := false;
end;

initialization
 //находим главное окно программы
 //Астрахань (январь 2009) - ДубльГИС    
 //[Afx:00400000:b:00010011:00000006:00060758]
 hGRYM := TFindObjects.Create('Afx', 'ДубльГИС', DefEventFindProcB);
 hGRYM.FindFirst();
 
finalization
 hGRYM.Destroy;

end.