uses
ActiveX, MSHTML_TLB, Shdocvw_tlb, StrUtils;
{MSHTML_TBL = Komponente Importieren->ActiveX->Microsoft HTML OBjects Libary}
{SHDocVW_tbl = Komponente Imporieren->ActiveX->Microsoft Internet Controls}
type
TObjectFromLResult =
function(LRESULT: lResult;
const IID: TIID; WPARAM: wParam;
out pObject): HRESULT;
stdcall;
TLanguage = (Englisch, Deutsch);
TIcon = 0..23;
{Quelle: [url]http://www.dsdt.info/tipps/?id=587[/url]
Jedoch leicht abgeändert}
function GetHTMLFromHWND(WHandle: HWND;
var html: IHTMLDocument3): HRESULT;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
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, IHTMLDocument3, 0,
html);
finally
FreeLibrary(hInst);
end;
end;
end;
function gethwnd(
name:
string): HWND;
Begin
result := FindWindow('
#32770', PChar(
name));
result := FindWindowEx(result, 0, '
Shell Embedding',
nil);
result := FindWindowEx(result, 0, '
Shell DocObject View',
nil);
result := FindWindowEx(result, 0, '
Internet Explorer_Server',
nil);
end;
function SetCustomMsg(msg, title :
string; icon : TIcon; lang: TLanguage): boolean;
const
StatusWndName:
array[0..1]
of String = ('
Status Manager', '
Statusverwaltung');
StatusWndID = 15330;
var
IDoc: IHTMLDocument3;
IcqMSgApiW: hwnd;
Thread, ChildThread: DWORD;
windowtext:
string;
size, i: integer;
begin
IcqMSgApiW := FindWindow(
NIL, '
Lite Session Window');
//Ist icq an?
if icqMsgApiw > 0
then
Begin
//Brauchen wir um das richtige ICQ handle zu finden
GetWindowThreadProcessId(IcqMSgApiW, Thread);
{Man kann nur das 'Lite Session Window' finden, dass andere nicht
da man die ICQNummer bräuchte, also muss man sich durchhangeln
da aber der Thread des 'Lite Session Window' der selbe ist wie der des
ICQ Hauptfensters ist das kein Problem}
windowtext := '
';
repeat
IcqMSgApiW := FindWindowEx(0, IcqMsgApiW, '
#32770',
NIL);
GetWindowThreadProcessId(IcqMSgApiW, ChildThread);
//Fenstertitel um zu gucken ob auch jemand Angemeldet ist.
size := SendMessage(IcqMsgApiW, WM_GETTEXTLENGTH, 0, 0);
setlength(windowtext, size);
SendMessage(IcqMsgApiW, WM_GETTEXT, size + 1, Longint(windowtext));
if ( Thread = ChildThread )
and (posEx('
-', windowtext, 5) > 0)
then
break;
until false;
{Kann nicht im Endlosen enden, da ICQ AN ist, s.o.}
SendMessage(IcqMSgApiW, WM_COMMAND, StatusWndID, 0);
while gethwnd(StatusWndName[Integer(lang)]) = 0
do
Application.ProcessMessages;
{das Fenster ist etwas träge, daher müssen wir warten}
GetHTMLFromHWND(gethwnd(StatusWndName[Integer(lang)]), IDoc);
if IDoc <>
nil then
with Idoc
do
begin {Nun nur noch die Werte einsetzen und abschicken}
//Ist das icon schon vorhanden? Dann deaktivieren wir das Feld!
for i := 0
to 4
do
if getElementByID('
i'+IntToStr(i)).getAttribute('
src', 2) = '
icons/'+IntToStr(icon)+'
.gif'
then
begin
getElementById('
c'+Inttostr(i)).setAttribute('
checked', '
', 0);
getElementById('
i'+Inttostr(i)).setAttribute('
src', '
images/e.gif', 0);
end;
getElementById('
c0').setAttribute('
disabled', false, 0);
getElementById('
c0').setAttribute('
checked', '
checked', 0);
getElementById('
n0').setAttribute('
value', title, 0);
getElementById('
t0').setAttribute('
value', msg, 0);
getElementById('
i0').setAttribute('
src', '
icons/'+IntToStr(icon)+'
.gif', 0);
getElementbyid('
apply_btn').setAttribute('
disabled', false, 0);
getElementbyid('
apply_btn').click();
getElementById('
ok_btn').click();
end
else
begin
result := false;
exit;
end;
{Jetzt setzen wir die richtige Nachricht mit dem richtigen Icon}
SendMessage(IcqMSgApiW, WM_COMMAND, 63871+icon, 0);
result := true;
end
else
result := false;
end;