AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi TICQClient Neues Protokoll - BugFix
Thema durchsuchen
Ansicht
Themen-Optionen

TICQClient Neues Protokoll - BugFix

Offene Frage von "delphinia"
Ein Thema von MisterNiceGuy · begonnen am 30. Jan 2007 · letzter Beitrag vom 9. Mär 2008
Antwort Antwort
Benutzerbild von MisterNiceGuy
MisterNiceGuy

Registriert seit: 1. Jul 2003
Ort: Mannheim
919 Beiträge
 
Delphi 7 Personal
 
#1

TICQClient Neues Protokoll - BugFix

  Alt 30. Jan 2007, 20:18
Hi ich hab grad mit einem Bekannten die Quelltext der ICQ-Komponente von cobans gefixt.

Ersetzt die HSnac0407 Procedure durch die folgende und kompiliert die Unit neu, dann läuft die Komponente wieder

Getestet mit D7 und ICQ 2005.

Delphi-Quellcode:
procedure TICQClient.HSnac0407(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
var
  ITime, IRandomID: LongWord;
  ULen: Word;
  c, i: Word;
  TlvType:Word;
  ft_pkt, ack_pkt: TRawPkt;
  chunks: array[0..49] of Byte;
  CharsetNumber, CharsetSubset: Word;
  Msg, UIN: String;
  Status: LongWord;
  MsgType: Word;
  MsgFlag: Byte;
  Answer: LongWord;
  aPort: Word;
  aIP: DWord;
  extIP: DWORD;
  wAck: Word;
  Request: Boolean;
// dwOnlineSince: DWORD;
  Desc, URL: String;
  v: Byte;
  atype: String;
  XML: String;
  XMLTime, XMLSource, XMLSender, XMLText: String;
  FName, FDesc: String;
  FSize: LongWord;
  FFSeq, FFSeq2: Word;
  Rec: TFTRequestRec;
  TCMD: String;
  List: TStringList;
  PSender, PEmail, PSenderIP: string;
  chan:integer;
begin
  Request := False;
  ITime := GetInt(Pkt, 4); //Time(system up since): time(NULL) - ITime div 1000
                                                //'System up since: ' + DateTimeToStr(DateTimeToUnix(Now) - ITime div 1000);
                                                //Seen by ICQ2003x

  IRandomID := GetInt(Pkt, 2); //RandomID
  Inc(Pkt^.Len, 2); //Unknown: empty
  Msg := '';
  {Subtypes}
  chan:=GetInt(Pkt, 2);
  UIN := GetStr(Pkt, GetInt(Pkt, 1));
  Inc(Pkt^.Len, 2);
      c := GetInt(Pkt, 2); //A count of the number of following TLVs.
      for i := 0 to c - 1 do //Skip all TLVs
      begin
        Inc(Pkt^.Len, 2);
        if (Pkt^.Len>=Flap.DataLen) then exit;
        Inc(Pkt^.Len, GetInt(Pkt, 2));
      end;
  case chan of
    1: //Simply(old-type) message
    begin
      if GetInt(Pkt, 2) = 2 then //TLV with message remain
      begin
        Inc(Pkt^.Len, 4); //TLV length + Unknown const
        Inc(Pkt^.Len, GetInt(Pkt, 2)); //Counts of following bytes + following bytes
        Inc(Pkt^.Len, 2); //x0101, Unknown, constant
        ULen := GetInt(Pkt, 2) - 4; //Length of the message + 4

        // Support for other charsets by Yegor
        CharsetNumber:=GetInt (Pkt, 2); //The encoding used for the message.
                                                //0x0000: US-ASCII
                                                //0x0002: UCS-2BE (or UTF-16?)
                                                //0x0003: local 8bit encoding, eg iso-8859-1, cp-1257, cp-1251.
                                                //Beware that UCS-2BE will contain zero-bytes for characters in the US-ASCII range.
        CharsetSubset:=GetInt (Pkt, 2); //Unknown; seen: 0x0000 = 0, 0xffff = -1.

// Inc(Pkt^.Len, 4); //Unknown seems to be constant

        Msg := GetStr(Pkt, ULen); //The actual message text. There will be no ending NULL.
        if not ((CharsetNumber=0) or (CharsetNumber=3))
           then Msg:=UTF8ToStrSmart (Msg);
        if FDoPlain
           then Msg:=RTF2Plain (Msg);
        if (Length(Msg) > 0) and Assigned(OnMessageRecv) then
          FOnMsg(Self, Msg, UIN);
      end;
    end;
    2: //Advanced(new-type)
    begin
      while(Pkt^.Len<Flap.DataLen)do
      begin
        if GetInt(Pkt, 2) = 5 then
        begin
          Inc(Pkt^.Len, 2);
          if GetInt(Pkt, 2) <> 0 then //ACKTYPE: 0x0000 - This is a normal message
            Exit;
          Inc(Pkt^.Len, 16); //File signature
          Inc(Pkt^.Len, 8); //TIME + RANDOM
          for i := 0 to 5 do
          begin
            TlvType := GetInt(Pkt, 2);

            if TlvType = $2711 then //Searching for TLV(2711) (with sources)
            begin
              // * eraser 21.04.2004
              // todo: AdvancedOnlineInfo event: aIP, aPort, ITime, Online Since
              Inc(Pkt^.Len, 2); //TLV Length
              Move(Ptr(LongWord(Pkt) + Pkt^.Len)^, chunks, 47);
              if GetInt(Pkt, 1) <> $1B then //If this value is not present, this is not a message packet. Also, ICQ2001b does not send an ACK, SNAC(4,B), if this is not 0x1B.
                Exit;
              Inc(Pkt^.Len, 26);
              FFSeq := GetInt(Pkt, 2);
              Inc(Pkt^.Len, 16);
              // * eraser 21.04.2004
              MsgType := GetInt(Pkt, 1); //message type (e.g. ea = AWAY)
              MsgFlag := GetInt(Pkt, 1); //message flags (e.g. 03 = MFLAG_AUTO)
              Answer := GetInt(Pkt, 4); //Read away-msg: seen 00 00 00 00
                                                //Send away-msg: seen zero and non zero

              //Away-Msgs respond from ICQ Lite
              if ((MsgType and $E0) = $E0) and (MsgFlag = MFLAG_AUTO) then
              begin
                if Request = False then begin
                  Msg := GetLNTS(Pkt); //message string (null-terminated)
                  if Assigned(OnAutoMsgResponse) then
                    FOnAutoMsgResponse(Self, UIN, IRandomID, MsgType, Msg);
                 // Exit;
                end;
                (*
                  else (todo) who is reading my away-msg event
                *)

              end else
              //
              if MsgType = M_FILE then //File request
              begin
                FDesc := GetLNTS(Pkt); //File description
                Inc(Pkt^.Len, 4); //Unknown: 00 00 00 00
                FName := GetLNTS(Pkt); //File name
                FSize := GetLInt(Pkt, 4); //File size

                {Set the records' items}
                Rec.ITime := ITime;
                Rec.IRandomID := IRandomID;
                Rec.UIN := StrToInt64(UIN);
                Rec.FileSize := FSize;
                Rec.Description := FDesc;
                Rec.FileName := FName;
                Rec.Seq := FFSeq;
                Rec.ReqType := $01;
                if Assigned(OnFTRequest) then
                  FOnFTRequest(Self, Rec);
                Exit;
              end else
              if MsgType = M_ADVANCED then //Advanced message container
              begin
                GetLNTS(Pkt); //Empty message (contains only a null terminator)
                Inc(Pkt^.Len, 2); //Following length
                Inc(Pkt^.Len, 16); //Signature
                Inc(Pkt^.Len, 2); //Unknown: empty
                TCMD := GetDWStr(Pkt); //Text command
                If (Pos('File', TCmd) > 0) or (Pos(#$D4#$E0#$E9#$EB, TCmd) > 0) Then {Fix for russian users from Yegor}          //Someone is sending us a file
                begin
                  Inc(Pkt^.Len, 19);
                  fDesc := GetDWStr(Pkt);
                  aPort := GetInt(Pkt, 2);
                  FFSeq2:= GetInt(Pkt, 2);
                  fName := GetWStr(Pkt);
                  fSize := GetInt(Pkt, 4);
                  Rec.Port := aPort;
                  Rec.ITime := ITime;
                  Rec.IRandomID := IRandomID;
                  Rec.UIN := StrToInt64(UIN);
                  Rec.FileSize := FSize;
                  Rec.Description := FDesc;
                  Rec.FileName := FName;
                  Rec.Seq := FFSeq;
                  // Send Ack through Server.
                  Rec.ReqType := $01; //
                  //NOTE From NighTrader: This is not working correctly,
                  //I was doing this wrong, if you have any knowladge of
                  //how this works please ICQ me @ 30391169.
                  if Assigned(OnFTRequest) then
                    FOnFTRequest(Self, Rec);
                  Exit;
                end else
                if (Pos('Request For Contacts', TCMD) > 0) or (Pos(#$C7#$E0#$EF#$F0#$EE#$F1#$20#$CA#$EE#$ED#$F2#$E0#$EA#$F2#$EE#$E2, TCmd) > 0) then
                begin
                  Inc(Pkt^.Len, 15); //15 unknown bytes
                  Inc(Pkt^.Len, 4); //Following length
                  Msg := GetDWStr(Pkt); //Message containing a reason
                  if Assigned(OnContactListRequest) then
                    FOnContactListReq(Self, UIN, Msg);
                end else
                if (Pos('Contacts',TCMD) > 0 ) or (Pos(#$CA#$EE#$ED#$F2#$E0#$EA#$F2#$FB, TCMD) > 0) then
                begin
                  Inc(Pkt^.Len, 4); //Following length
                  Msg := GetDWStr(Pkt); //Message containing a list with contacts
                  List := TStringList.Create; //Create temporary list
                  ParseContacts(Msg, List); //Parse message with contacts
                  if Assigned(OnContactListRecv) then
                    FOnContactListRecv(Self, UIN, List);
                end else
                if (Pos('Web Page Address (URL)',TCMD) > 0) or (Pos(#$CF#$EE#$F1#$EB#$E0#$F2#$FC#$20#$D1#$F1#$FB#$EB#$EA#$F3#$20#$ED#$E0#$20#$E2#$E5#$E1#$2D#$F1#$F2#$F0#$E0#$ED#$E8#$F6#$F3,TCmd) > 0) then
                begin
                  // Handle URL Msg
                  Inc(Pkt^.Len, 19);
                  Msg := GetDWStr(Pkt);
                  if Pos(#$FE, Msg) <> -1 then begin // Break apart strings
                    Desc := Copy(Msg, 1, Pos(#$FE, Msg) - 1);
                    URL := Copy(Msg, Length(Desc) + 2, 255);
                    if Assigned(OnURLRecv) then
                      FOnURL(Self, Desc, URL, UIN);
                  end;
                end;
              end
              else
                Msg := GetLNTS(Pkt); //The actual message text. There will be ending NULL.

              {Sending ACK of the message}
              PktInit(@ack_pkt, 2, FSeq); //Channel 2
              PktSnac(@ack_pkt, $04, $0B, 0, 0); //SNAC(x04/x0B)
              Move(Ptr(LongWord(Pkt) + TSNACSZ)^, Ptr(LongWord(@ack_pkt) + ack_pkt.Len)^, 10); //First 10 bytes of TLV(2711)
              Inc(ack_pkt.Len, 10); //Skip first 10 bytes copied from TLV(2711) which were added before
              PktLStr(@ack_pkt, UIN); //User's UIN
              PktInt(@ack_pkt, $0003, 2); //00 03
              PktAddArrBuf(@ack_pkt, @chunks, 47); //First 47 bytes of source packet (with message)
              PktInt(@ack_pkt, $00000000, 4); //00 00 00 00
              //If it's an auto-away message request
              if (MsgType and $E0 = $E0) and Request then
                PktLNTS(@ack_pkt, FAutoAwayMsg) //Auto-away message
              else begin
                PktInt(@ack_pkt, 1, 1); //01
                PktInt(@ack_pkt, 0, 4); //00 00 00 00
                PktInt(@ack_pkt, 0, 2); //00 00
                PktInt(@ack_pkt, $FFFFFF00, 4); //FF FF FF 00
              end;
              PktFinal(@ack_pkt);
              FSock.SendData(ack_pkt, ack_pkt.Len);

              if (Length(Msg) > 0) then
              begin
                if MsgType = M_PLAIN then
                begin
                  if FDoPlain then Msg := Rtf2Plain(Msg); //Convert message from RTF to plaintext when needed
                  if Assigned(OnMessageRecv) then
                    FOnMsg(Self, Msg, UIN);
                end else
                if MsgType = M_URL then
                begin
                  Desc := Copy(Msg, 0, Pos(#$fe, Msg) - 1);
                  URL := Copy(Msg, Pos(#$fe, Msg) + 1, Length(Msg) - Pos(#$fe, Msg));
                  if Assigned(OnURLRecv) then
                    FOnURL(Self, Desc, URL, UIN);
                end;
              end;
              Exit;
            end else
            if TlvType = 5 then // TVL(5) Get a Port
            begin
              Inc(pkt^.Len, 2); // Skip Length
              aPort := GetInt(Pkt, 2); // Get Port Number
            end else
            // *eraser 21.04.2004
            {
            if TlvType = 6 then        // TLV(6) Status
            begin
              Inc(pkt^.Len, 4);
              Status := GetInt(Pkt, 4);
            end else
            }

            if TlvType = $0004 then // TLV(4) Get an ExtIP
            begin
              Inc(pkt^.Len, 4); // skip length
              extIP := GetInt(Pkt, 4); // Get IP Number
            end else
            if TlvType = $000F then // TLV(F)
            begin
              Inc(pkt^.Len, 2); // skip length
              Request := True; // possibly it is a request
            end else
            if TlvType = $000A then // TLV(A)
            begin
              Inc(pkt^.Len, 2); // 0x0002 skip length
              wAck := GetInt(Pkt, 2); // seen 0001 - req (unk 0x000F 0x0000)
                                        // seen 0002 - reply (IP, Port)
            end else
            //
            if TlvType = 3 then // TLV(3) Get an IntIP
            begin
              Inc(pkt^.Len,2); // Skip Length
              aIP := GetInt(Pkt,4); // Get IP Number
            end else
              Inc(Pkt^.Len, GetInt(Pkt, 2));
          end;
        end else
          Inc(Pkt^.Len, GetInt(Pkt, 2));
      end;
      // todo special user online event
    end;
    4: //Another message type
    begin
      UIN := GetLStr(Pkt);
      for i := 0 to 4 do
      begin
        v := GetInt(Pkt, 1);
        if (v = 5) or ((GetInt(Pkt, 1) = 5) and (v = 0)) then //TLV(5) was found
        begin
          if v = 5 then //Some modifications for MAC clients
            Inc(Pkt^.Len, 40)
          else
            Inc(Pkt^.Len, 2);
          GetLInt(Pkt, 4); //UIN
          MsgType := GetLInt(Pkt, 2); //Message-type
          Msg := GetLNTS(Pkt); //Message
          if MsgType = $1a then //Probably advanced msg format
          begin
            Inc(Pkt^.Len, 20); //20 unknown bytes
            atype := GetDWStr(Pkt); //Advanced msg sub-type
            if Pos ('ICQSMS', aType)<>0 then //Corresponds to received SMS message in XML formatted message
            begin
              Inc(Pkt^.Len, 3); //00 00 00
              Inc(Pkt^.Len, 4); //4-byte little endian length of the following data
              XML := GetStr(Pkt, GetLInt(Pkt, 4)); //XML entry of SMS response
              XMLSource := GetXMLEntry('source', XML); //Source, usually: 'ICQ'
              XMLSender := GetXMLEntry('sender', XML); //Source cellular number
              XMLText := GetXMLEntry('text', XML); //Text of reply
              XMLTime := GetXMLEntry('time', XML); //Time of sending reply
              if Assigned(OnSMSReply) then
                FOnSMSReply(Self, XMLSource, XMLSender, XMLTime, UTF8ToStrSmart(XMLText));
            end;
            Exit;
          end;

          if (Length(Msg) > 0) then
          begin
            if MsgType = M_PLAIN then
            begin
              if FDoPlain then Msg := Rtf2Plain(Msg); //Convert message from RTF to plaintext when needed
              if Assigned(OnMessageRecv) then
                FOnMsg(Self, Msg, UIN);
            end
            else if MsgType = M_URL then
            begin
              Desc := Copy(Msg, 0, Pos(#$fe, Msg) - 1);
              URL := Copy(Msg, Pos(#$fe, Msg) + 1, Length(Msg) - Pos(#$fe, Msg));
              if Assigned(OnURLRecv) then
                FOnURL(Self, Desc, URL, UIN);
            end else
            if MsgType = M_WEB_PAGE then // Updated by Saif.N * To Support Web Page Message
            begin
              PSender := Copy(Msg, 1, Pos(#$fe, Msg) - 1);
              Msg := Copy(Msg,Length(PSender)+4, Length(Msg));
              PEmail := Copy(Msg, 1 , Pos(#$fe, Msg)-1);
              Msg := Copy(Msg,Length(PEmail)+1, Length(Msg));
              PSenderIP:= Copy(Msg, Pos('IP:', Msg)+4, Pos(#$D, Msg)-Pos('IP:', Msg)-4);
              Msg := Copy(Msg, Pos(#$A,Msg) + 1, Length(Msg));
              if Assigned(OnWPagerRecv) then
                 FonWPager(Self, PSender, PEmail, PSenderIP, Msg);
            end;
          end;
          Exit;
        end else
          Inc(Pkt^.Len, GetInt(Pkt, 2));
      end;
    end;
  end;
end;
MfG MisterNiceGuy
Jonas
Wenn mich jemand sucht, ich bin im Kühlschrank!

Informationen über das Duale Studium
www.jofre.de
  Mit Zitat antworten Zitat
snapman
(Gast)

n/a Beiträge
 
#2

Re: TICQClient Neues Protokoll - BugFix

  Alt 30. Jan 2007, 20:22
GENIAL!
danke
  Mit Zitat antworten Zitat
Benutzerbild von DataCool
DataCool

Registriert seit: 10. Feb 2003
Ort: Lingen
909 Beiträge
 
Delphi 10.3 Rio
 
#3

Re: TICQClient Neues Protokoll - BugFix

  Alt 30. Jan 2007, 20:25
Hi,

was genau hast Du/Ihr gefixt ?
Ich habe die Komponente selber schon gefixt und die Lösung bei Sourceforge.net eingestellt.

Greetz DataCool
Der Horizont vieler Menschen ist ein Kreis mit Radius Null, und das nennen sie ihren Standpunkt.
  Mit Zitat antworten Zitat
Benutzerbild von 0NyX
0NyX

Registriert seit: 13. Aug 2007
67 Beiträge
 
#4

Re: TICQClient Neues Protokoll - BugFix

  Alt 23. Nov 2007, 16:46
Hey,

erstmal vielen Dank das ihr euch die Mühe gemacht habt
Aber leider kann ich trotzdem noch immer nicht connecten
Wäre cool wenn ihr das auch hin bekommen könntet!
"Der Computer rechnet mit allem, nur nicht mit seinem Nutzer!"
  Mit Zitat antworten Zitat
shmia

Registriert seit: 2. Mär 2004
5.508 Beiträge
 
Delphi 5 Professional
 
#5

Re: TICQClient Neues Protokoll - BugFix

  Alt 23. Nov 2007, 17:01
Ein gutes Beispiel, wie man auch mit Delphi extrem unverständlichen Sourcecode bauen kann.
Ich habe noch nie Pascal Quelltext mit so vielen hartcodierten Zahlen und richtig fieser Zeigerarithmetik gesehen.
Ausserdem gibt es zu viele lokale Variablen.
Da wollte wohl jemand alles in einer Funktion erledigen...
Andreas
  Mit Zitat antworten Zitat
Neotracer64

Registriert seit: 27. Okt 2004
292 Beiträge
 
Delphi 7 Professional
 
#6

Re: TICQClient Neues Protokoll - BugFix

  Alt 23. Nov 2007, 17:11
Sieht mir eher wie eine zu ernst genommene C Übersetzung aus. *g*
  Mit Zitat antworten Zitat
eLse-maestro

Registriert seit: 14. Okt 2006
24 Beiträge
 
#7

Re: TICQClient Neues Protokoll - BugFix

  Alt 22. Jan 2008, 15:04
ich denke sie haben das protokoll mal wieder geändert zumindest funktioniert dieser & der alte code bei mir nicht..
  Mit Zitat antworten Zitat
delphinia

Registriert seit: 16. Feb 2006
444 Beiträge
 
Delphi 11 Alexandria
 
#8

Re: TICQClient Neues Protokoll - BugFix

  Alt 9. Mär 2008, 18:25
gibt es hier schon wieder ein FIX?
Doreen
Gruss Doreen
  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 13:32 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