AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

ICQ 5: Eigenen Status setzen

Ein Thema von Eichhoernchen · begonnen am 24. Jul 2006
Antwort Antwort
Eichhoernchen

Registriert seit: 22. Apr 2004
Ort: Hagen
322 Beiträge
 
Turbo Delphi für Win32
 
#1

ICQ 5: Eigenen Status setzen

  Alt 24. Jul 2006, 19:19
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)+'.gifthen
          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
Angehängte Dateien
Dateityp: zip icqstatchanger_166.zip (311,0 KB, 178x aufgerufen)
Jan
  Mit Zitat antworten Zitat
Antwort Antwort

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:17 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