Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Internet / LAN / ASP.NET (https://www.delphipraxis.net/23-library-internet-lan-asp-net/)
-   -   Delphi ICQ 5: Eigenen Status setzen (https://www.delphipraxis.net/73837-icq-5-eigenen-status-setzen.html)

Eichhoernchen 24. Jul 2006 19:19


ICQ 5: Eigenen Status setzen
 
Liste der Anhänge anzeigen (Anzahl: 1)
Ziel: Setzen einer neuen "custom" Statusnachricht mit Nachricht, Titel und Icon in ICQ 5.x.

Das ganze ist nicht so einfach, da ICQ diese Statusnachrichten über eine InternetExplorer "Komponente" verwaltet.
Daher ist dieser Lösungsweg auch nicht schön aber soweit ich weiß geht es nicht anders, außer mit der ICQ API, welche dem kleinem Programmierer nicht zu Verfügung gestellt wird.

Code: (geupdated! Danke an Florian Bernd)
Delphi-Quellcode:
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;
Beispielaufruf:
Delphi-Quellcode:
//Wenn die deutsche ICQ 5 version installiert ist:
  case Radiobutton1.Checked of
    True:
      if SetCustomMsg(memText.Text, edTitle.Text, cmbIcon.ItemIndex, englisch);
    False:
      SetCustomMsg(memText.Text, edTitle.Text, cmbIcon.ItemIndex, deutsch);
  end;
Ich glaube viel mehr muss ich nicht erklären, der Code sollte hinreichend Kommentiert sein.

Im Anhang befindet sich noch eine Beispielapplication.

Viel Spaß damit, bei Interesse auch noch für andere ICQ versionen die normale Statusänderung.

Eichhoernchen


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:10 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz