|
TICQClient Neues Protokoll - BugFix
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:
MfG MisterNiceGuy
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; |
Re: TICQClient Neues Protokoll - BugFix
GENIAL!
danke |
Re: TICQClient Neues Protokoll - BugFix
Hi,
was genau hast Du/Ihr gefixt ? Ich habe die Komponente selber schon gefixt und die Lösung bei Sourceforge.net eingestellt. Greetz DataCool |
Re: TICQClient Neues Protokoll - BugFix
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! |
Re: TICQClient Neues Protokoll - BugFix
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. :shock: Ausserdem gibt es zu viele lokale Variablen. Da wollte wohl jemand alles in einer Funktion erledigen... |
Re: TICQClient Neues Protokoll - BugFix
Sieht mir eher wie eine zu ernst genommene C Übersetzung aus. *g*
|
Re: TICQClient Neues Protokoll - BugFix
ich denke sie haben das protokoll mal wieder geändert zumindest funktioniert dieser & der alte code bei mir nicht..
|
Re: TICQClient Neues Protokoll - BugFix
gibt es hier schon wieder ein FIX?
|
| Alle Zeitangaben in WEZ +1. Es ist jetzt 22:01 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz