uses
ActiveX, Shdocvw_tlb, MSHTML_TLB;
type
TObjectFromLResult =
function(LRESULT: lResult;
const IID: TIID; WPARAM: wParam;
out pObject): HRESULT;
stdcall;
function GetIEFromHWND(WHandle: HWND;
var IE: IWebbrowser2): HRESULT;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
pDoc: IHTMLDocument2;
ObjectFromLresult: TObjectFromLresult;
begin
hInst := LoadLibrary('
Oleacc.dll');
@ObjectFromLresult := GetProcAddress(hInst, '
ObjectFromLresult');
if @ObjectFromLresult <>
nil then begin
try
MSG := RegisterWindowMessage('
WM_HTML_GETOBJECT');
SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
if Result = S_OK
then
(pDoc.parentWindow
as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
finally
FreeLibrary(hInst);
end;
end;
end;
procedure GetIEWindows(lb: TListBox);
function EnumWindowsProc (Wnd: HWND; lb: TListBox): BOOL;
stdcall;
var
theClassname:
array [0..128]
of Char;
caption:
Array [0..128]
of Char;
IE: IWebbrowser2;
WndChild: HWND;
begin
Result := True;
Windows.GetClassname( Wnd, theClassname, Sizeof( theclassname ));
if theClassname='
IEFrame'
then
begin
WndChild := FindWindowEX(Wnd, 0, '
Shell DocObject View',
nil);
if WndChild <> 0
then
begin
WndChild := FindWindowEX(WndChild, 0, '
Internet Explorer_Server',
nil);
if WndChild <> 0
then
begin
if GetIEFromHWND(WndChild, IE)=S_OK
then
if IE<>
nil then
lb.Items.Add(IE.LocationURL);
end;
end;
end;
end;
begin
lb.Clear;
EnumWindows(@EnumWindowsProc, integer(lb));
end;