uses
ActiveX, MSHTML, SHDocVw;
// Hilfsfunktion zum finden von Childfenstern
function FindWindowEx2(hParent: HWND; ChildClassName:
string; ChildNr: Word): HWND;
var
i: Word;
hChild: HWND;
begin
hChild := 0;
Result := 0;
ChildNr := ChildNr - 1;
for i := 0
to ChildNr
do
begin
hChild := FindWindowEx(hParent, hChild, PChar(ChildClassName),
nil);
if hChild = 0
then
Exit;
Result := hChild;
end;
end;
type
TObjectFromLResult =
function(LRESULT: lResult;
const IID: TIID; WPARAM: wParam;
out pObject): HRESULT;
stdcall;
// IHTMLDocument2 vom Handle Internet Explorer_Server ermitteln
function GetHTMLDocumentFromHWND(wnd: HWND): IHTMLDocument2;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
ObjectFromLresult: TObjectFromLresult;
pDoc: IHTMLDocument2;
begin
Result :=
nil;
hInst := LoadLibrary('
Oleacc.dll');
@ObjectFromLresult := GetProcAddress(hInst, '
ObjectFromLresult');
if @ObjectFromLresult <>
nil then begin
try
MSG := RegisterWindowMessage('
WM_HTML_GETOBJECT');
SendMessageTimeOut(wnd, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
if ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc) = S_OK
then
Result := pDoc;
finally
FreeLibrary(hInst);
end;
end;
end;
function GetICQChatDoc(DisplayName:
string): IHTMLDocument2;
var
wndICQChat, wnd: HWND;
htmlDoc: IHTMLDocument2;
Params: OleVariant;
begin
Result :=
nil;
// ICQ Chatfenster suchen
if DisplayName = '
'
then
wndICQChat := FindWindow('
__oxFrame.class__',
nil)
else
wndICQChat := FindWindow('
__oxFrame.class__', PChar(DisplayName));
if wndICQChat <> 0
then
begin
wnd := FindWindowEx2(wndICQChat, '
__oxFrame.class__', 2);
if wnd <> 0
then
begin
// Internet Explorer_Server vom Chatfenster suchen
wnd := FindWindowEx(wnd, 0, '
Internet Explorer_Server',
nil);
if wnd <> 0
then
begin
// htmlDoc vom Handle ermitteln
htmlDoc := GetHTMLDocumentFromHWnd(wnd);
// body.innerText zurückgeben
if htmlDoc <>
nil then
Result := htmlDoc
//htmlDoc.body.innerText;
end;
end;
end;
end;
function GetICQChatText(DisplayName:
string):
string;
var
ICQhtmlDoc: IHTMLDocument2;
begin
ICQhtmlDoc := GetICQChatDoc('
');
if ICQhtmlDoc <>
nil then
Result := ICQhtmlDoc.body.innerText;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Showmessage(GetICQChatText('
'));
// hier kannst du ICQ Anzeigenamen übergeben
end;