开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
ICQClient.pas
资源名称：DarkMoon.rar　[点击查看]
上传用户：hndmjx
上传日期：2014-09-16
资源大小：3369k
文件大小：92k
源码类别：

Delphi控件源码

开发平台：

Delphi

ICQClient.pas：源码内容
  1. unit ICQClient {v. 1.18f};
  2. {************************************************
  3.     For updates checkout: http://www.cobans.net
  4.       (C) Alex Demchenko(alex@ritlabs.com)
  5. *************************************************}
  6. {$R-}                   //Remove range checking
  7. {$DEFINE USE_FORMS}     //If you don't use forms unit remove this line
  11. //Some needed defines, do not remove them!
  12. {$IFDEF VER90}
  13.   {$DEFINE OLD_DELPHI}
  14. {$ENDIF}
  15. {$IFDEF VER100}
  16.   {$DEFINE OLD_DELPHI}
  17. {$ENDIF}
  18. {$IFDEF VER120}
  19.   {$DEFINE OLD_DELPHI}
  20. {$ENDIF}
  21. {$IFDEF VER130}
  22.   {$DEFINE OLD_DELPHI}
  23. {$ENDIF}
  27. interface
  28. uses
  29.   Windows, Messages, Classes {StringLists}, {$IFDEF USE_FORMS}Forms {AllocateHwnd/DeallocateHwnd}, {$ENDIF}
  30.   WinSock, ICQWorks, MySocket, ICQDirect;
  32. {$IFNDEF USE_FORMS}
  33.   {$DEFINE OLD_DELPHI}
  34. {$ENDIF}
  36. type
  37.   //UIN Entry used in direct connections
  38.   PUINEntry = ^TUINEntry;
  39.   TUINEntry = record
  40.     UIN: LongWord;
  41.     Nick: ShortString;
  42.     CType: Word;
  43.     CTag: Word;
  44.     CGroupID: Word;
  45.     CGroup: ShortString;
  46.   end;
  48.   TMyTimer = class;
  50.   //Callback function types
  51.   THandlePkt = procedure(Flap: TFlapHdr; Buffer: Pointer) of object;
  52.   TOnMsgProc = procedure(Sender: TObject; Msg, UIN: String) of object;
  53.   TOnURLProc = procedure(Sender: TObject; Description, URL, UIN: String) of object;
  54.   TOnStatusChange = procedure(Sender: TObject; UIN: String; Status: LongWord) of object;
  55.   TOnOnlineInfo = procedure(Sender: TObject; UIN: String; Port: Word; InternalIP, ExternalIP: String; ProtoVer: Byte) of object;
  56.   TOnUserEvent = procedure(Sender: TObject; UIN: String) of object;
  57.   TOnUserGeneralInfo = procedure(Sender: TObject; UIN, NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean) of object;
  58.   TOnUserWorkInfo = procedure (Sender: TObject; UIN, WCity, WState, WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment, WPosition, WOccupation, WHomePage: String) of object;
  59.   TOnUserInfoMore = procedure (Sender: TObject; UIN: String; Age: Word; Gender: Byte; HomePage: String; BirthYear: Word; BirthMonth: Word; BirthDay: Word; Lang1, Lang2, Lang3: String) of object;
  60.   TOnUserInfoAbout = procedure(Sender: TObject; UIN, About: String) of object;
  61.   TOnUserInfoInterests = procedure(Sender: TObject; UIN: String; Interests: TStringList) of object;
  62.   TOnUserInfoMoreEmails = procedure(Sender: TObject; UIN: String; Emails: TStringList) of object;
  63.   TOnUserInfoBackground = procedure(Sender: TObject; UIN: String; Pasts, Affiliations: TStringList) of object;
  64.   TOnUserFound = procedure(Sender: TObject; UIN, Nick, FirstName, LastName, Email: String; Status: Word; Gender, Age: Byte; SearchComplete: Boolean; Authorize: Boolean) of object;
  65.   TOnServerListRecv = procedure(Sender: TObject; SrvContactList: TList) of object;
  66.   TOnAdvMsgAck = procedure(Sender: TObject; UIN: String; ID: Word; AcceptType: Byte; AcceptMsg: String) of object;
  67.   TOnAutoMsgResponse = procedure(Sender: TObject; UIN: String; ID: Word; RespStatus: Byte; Msg: String) of object;
  68.   TOnContactListRecv = procedure(Sender: TObject; UIN: String; ContactList: TStringList) of object;
  69.   TOnContactListReq = procedure(Sender: TObject; UIN, Reason: String) of object;
  70.   TOnDirectPktAck = procedure(Sender: TObject; ID: Word) of object;
  71.   TOnSMSAck = procedure(Sender: TObject; Source, Network, MsgId: String; Deliverable: Boolean) of object;
  72.   TOnSMSReply = procedure(Sender: TObject; Source, SmsSender, Time, Text: String) of object;
  73.   TOnInfoChanged = procedure(Sender: TObject; InfoType: TInfoType; ChangedOk: Boolean) of object;
  74.   TOnAuthResponse = procedure(Sender: TObject; UIN: String; Granted: Boolean; Reason: String) of object;
  75.   TOnChangeResponse = procedure(Sender: TObject; ErrorCode: Word) of object;
  76.   TOnFTRequest = procedure(Sender: TObject; RequestRec: TFTRequestRec) of object;
  77.   TOnUserInfoShort = procedure(Sender: TObject; UIN, NickName, FirstName, LastName, Email: String; UserFound, AuthRequired: Boolean) of object;
  79.   {TICQNet -- Object implementing sending/receiving packets between Client and ICQ Server.}
  80.   TICQNet = class(TMySock)
  81.   private
  82.     FSrcBuf: array[0..MAX_DATA_LEN - 1] of Byte;        //.              .
  83.     FSrcLen: Word;                                      //.PACKET READING.
  84.     FNewFlap: TFlapHdr;                                 //.     DATA     .
  85.     FFlapSet: Boolean;                                  //.              .
  86.     FHandlePkt: THandlePkt;
  87.   protected
  88.     procedure OnReceive(Buffer: Pointer; BufLen: LongWord); override;
  89.   public
  90.     constructor Create;
  91.     destructor Destroy; override;
  92.     procedure Connect; override;
  93.   published
  94.     property OnConnectError;
  95.     property OnDisconnect;
  96.     property OnPktParseA;
  97.     property OnError;
  98.     property OnHandlePkt: THandlePkt read FHandlePkt write FHandlePkt;
  99.   end;
  101.   {TICQClient -- ICQ Component}
  102.   TICQClient = class(TComponent)
  103.   private
  104.     FSock: TICQNet;                                     //Client's socket
  105.     FLUIN: LongWord;                                    //Client's UIN
  106.     FLPass: String;                                     //Client's password
  107.     FFirstConnect: Boolean;                             //Flag, used in login sequence
  108.     FSeq: Word;                                         //Main Flap Seq
  109.     FSeq2: Word;                                        //TO_ICQSRV Seq
  110.     FDSeq: Word;                                        //Direct connection Seq
  111.     FCookie: String;                                    //Temporary cookie, used in login sequence, we can use String type, becouse ICQ server doesn't send 0x00 chars in it's Cookie part
  112.     FIp: String;                                        //Ip to connect to
  113.     FPort: Word;                                        //Port to connect to
  114.     FDConnCookie: LongWord;                             //Direct connection cookie
  115.     FDirect: TDirectControl;                            //Direct control
  116.     //-- Proxy settings
  117.     FProxyType: TProxyType;                             //.
  118.     FProxyHost: String;                                 //.
  119.     FProxyPort: Word;                                   //. Proxy Configaration
  120.     FProxyAuth: Boolean;                                //.        Data
  121.     FProxyPass: String;                                 //.
  122.     FUserID: String;                                    //.
  123.     FResolve: Boolean;
  124.     //-- Events & other stuff --
  125.     FContactLst: TStrings;
  126.     FVisibleLst: TStrings;
  127.     FInvisibleLst: TStrings;
  128.     FOnMsg: TOnMsgProc;
  129.     FOnURL: TOnURLProc;
  130.     FOnOffMsg: TOnMsgProc;
  131.     FOnOffURL: TOnURLProc;
  132.     FOnLogin: TNotifyEvent;
  133.     FOnPktParse: TOnAdvPktParse;
  134.     FOnDPktParse: TOnAdvPktParse;
  135.     FOnConnectionFailed: TNotifyEvent;
  136.     FOnStatusChange: TOnStatusChange;
  137.     FOnUserOffline: TOnUserEvent;
  138.     FOnAddedYou: TOnUserEvent;
  139.     FOnUserGeneralInfo: TOnUserGeneralInfo;
  140.     FOnUserWorkInfo: TOnUserWorkInfo;
  141.     FOnUserInfoMore: TOnUserInfoMore;
  142.     FOnUserInfoAbout: TOnUserInfoAbout;
  143.     FOnUserInfoInterests: TOnUserInfoInterests;
  144.     FOnUserInfoMoreEmails: TOnUserInfoMoreEmails;
  145.     FOnUserInfoBackground: TOnUserInfoBackground;
  146.     FStatus: LongWord;
  147.     FDoPlain: Boolean;
  148.     FInfoChain: TStringList;
  149.     FSInfoChain: TStringList;
  150.     FLastInfoUin: String;
  151.     FLastSInfoUin: String;
  152.     FLoggedIn: Boolean;
  153.     FRegisteringUIN: Boolean;
  154.     FRegPassword: String;
  155.     FOnUserFound: TOnUserFound;
  156.     FOnUserNotFound: TNotifyEvent;
  157.     FOnServerListRecv: TOnServerListRecv;
  158.     FOnAdvMsgAck: TOnAdvMsgAck;
  159.     FOnNewUINRegistered: TOnUserEvent;
  160.     FOnNewUINRefused: TNotifyEvent;
  161.     FOnAutoMsgResponse: TOnAutoMsgResponse;
  162.     FAutoAwayMsg: String;
  163.     FOnUnregisterOk: TNotifyEvent;
  164.     FOnUnregBadPass: TNotifyEvent;
  165.     FOnContactListRecv: TOnContactListRecv;
  166.     FOnContactListReq: TOnContactListReq;
  167.     FOnDirectPktAck: TOnDirectPktAck;
  168.     FOnSmsRefused: TNotifyEvent;
  169.     FOnSMSAck: TOnSMSAck;
  170.     FOnOnlineInfo: TOnOnlineInfo;
  171.     FUseDirect: Boolean;
  172.     FOnError: TOnError;
  173.     FTimer: TMyTimer;
  174.     FTimeout: Byte;
  175.     FOnSMSReply: TOnSMSReply;
  176.     FOnInfoChanged: TOnInfoChanged;
  177.     FOnAuthSet: TNotifyEvent;
  178.     FOnAuthResponse: TOnAuthResponse;
  179.     FOnChangeResponse: TOnChangeResponse;
  180.     FOnFTRequest: TOnFTRequest;
  181.     FOnFTInit: TOnFTInit;
  182.     FOnFTStart: TOnFTStart;
  183.     FOnFTFileData: TOnFTFileData;
  184.     FLastError: String;
  185.     FOnUserInfoShort: TOnUserInfoShort;
  186.     procedure InitNetICQ;
  187.     procedure OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
  188.     procedure HandlePacket(Flap: TFlapHdr; Data: Pointer);
  189.     procedure SetStatus(NewStatus: LongWord);
  190.     //-- Handling Snac packet procedures
  191.     procedure HSnac0407(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  192.     //procedure HSnac1503(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  193.     procedure HSnac030B(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  194.     procedure HSnac131C(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  195.     procedure HSnac1319(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  196.     procedure HSnac1306(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  197.     procedure HSnac040b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  198.     procedure HSnac1705(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  199.     procedure HSnac131b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  200.     procedure HSnac130e(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  201.     procedure HDirectMsg(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord);
  202.     procedure FTOnConnectError(Sender: TObject);
  203.     procedure FTOnDisconnect(Sender: TObject);
  204.     procedure FTOnDirectParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
  205.     procedure FTOnPktParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
  206.     procedure OnFTInitProc(Sender: TObject; UIN: LongWord; FileCount, TotalBytes, Speed: LongWord; NickName: String);
  207.     procedure OnFTStartProc(Sender: TObject; StartRec: TFTStartRec; FileName: String; FileSize, Speed: LongWord);
  208.     procedure OnFTFileDataProc(Sender: TObject; UIN: LongWord; Data: Pointer; DataLen: LongWord; LastPacket: Boolean);
  209.     procedure SetContactList(Value: TStrings);
  210.     procedure SetVisibleList(Value: TStrings);
  211.     procedure SetInvisibleList(Value: TStrings);
  212.     procedure OnTimeout(Sender: TObject);
  213.   public
  214.     procedure HSnac1503(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  215.     constructor Create(AOwner: TComponent); override;
  216.     destructor Destroy; override;
  217.     procedure Login(Status: LongWord = S_ONLINE);
  218.     procedure RegisterNewUIN(const Password: String);
  219.     procedure Disconnect;
  220.     procedure SendMessage(UIN: LongWord; const Msg: String);
  221.     procedure SendURL(UIN: LongWord; const URL, Description: String);
  222.     function AddContact(UIN: LongWord): Boolean;
  223.     procedure RemoveContact(UIN: LongWord);
  224.     procedure RemoveContactVisible(UIN: LongWord);
  225.     procedure RemoveContactInvisible(UIN: LongWord);
  226.     procedure RequestInfo(UIN: LongWord);
  227.     procedure RequestInfoShort(UIN: LongWord);    
  228.     procedure SearchByMail(const Email: String);
  229.     procedure SearchByUIN(UIN: LongWord);
  230.     procedure SearchByName(const FirstName, LastName, NickName, Email: String);
  231.     procedure SearchRandom(Group: Word);
  232.     procedure SearchWhitePages(const FirstName, LastName, NickName, Email: String; MinAge, MaxAge: Word; Gender: Byte; const Language, City, Country, Company, Department, Position, Occupation, Organization, OrganKeyWords, PastAffiliation, AffiKeyWords, KeyWord: String; Online: Boolean);
  233.     procedure SetSelfInfoGeneral(NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
  234.     procedure SetSelfInfoMore(Age: Word; Gender: Byte; const HomePage: String; BirthYear: Word; BirthMonth, BirthDay: Byte; Language1, Language2, Language3: String);
  235.     procedure SetSelfInfoAbout(const About: String);
  236.     procedure RequestContactList;
  237.     procedure DestroyUINList(var List: TList);
  238.     procedure SendSMS(const Destination, Text: String);
  239.     procedure SendMessageAdvanced(UIN: LongWord; const Msg: String; ID: Word; RTFFormat: Boolean);
  240.     function SendMessageDirect(UIN: LongWord; const Msg: String; RTFFormat: Boolean): Word;
  241.     procedure RequestAwayMsg(UIN: LongWord; ID: Word; ReqStatus: Byte);
  242.     procedure UnregisterUIN(const Password: String);
  243.     procedure ChangePassword(const NewPassword: String);
  244.     procedure ChangePasswordPtr(Buffer: Pointer; BufLen: Word);
  245.     function DirectConnectionEstabilished(UIN: LongWord): Boolean;
  246.     function SendContacts(UIN: LongWord; Contacts: TStringList; ID: Word): Boolean;
  247.     function RequestContacts(UIN: LongWord; const Reason: String; ID: Word): Boolean;
  248.     function SendContactsDC(UIN: LongWord; Contacts: TStringList): Word;
  249.     function RequestContactsDC(UIN: LongWord; const Reason: String): Word;
  250.     procedure SendKeepAlive;
  251.     procedure SetAuthorization(AuthorizationRequired, WebAware: Boolean);
  252.     procedure SendAuthRequest(UIN: LongWord; Msg: String);
  253.     procedure SSLChangeStart(FirstUpload: Boolean);
  254.     procedure SSLChangeEnd;
  255.     procedure SSLAddGroup(GroupName: String; GroupID: Word);
  256.     procedure SSLAddUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize, UpdateUser: Boolean);
  257.     procedure SSLDelUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize: Boolean);
  258.     procedure SSLDelGroup(GroupName: String; GroupID: Word);
  259.     procedure SSLUpdateGroup(GroupName: String; GroupID: Word; UserIDs: TStringList);
  260.     procedure SSLAddUserIntoList(UserID: Word; UIN: String; BuddyType: Word);
  261.     procedure SSLDelUserFromList(UserID: Word; UIN: String; BuddyType: Word);
  262.     function FTResponse(ResponseRec: TFTRequestRec; Accept: Boolean; Reason: String): Boolean;
  263.     procedure FTCancel(UIN: LongWord);
  264.     function FTStartResponse(StartRec: TFTStartRec): Boolean;
  265.     property LastError: String read FLastError;
  266.     property Status: LongWord read FStatus write SetStatus;
  267.     property LoggedIn: Boolean read FLoggedIn;
  268.   published
  269.     property DisableDirectConnections: Boolean read FUseDirect write FUseDirect default False;
  270.     property ProxyType: TProxyType read FProxyType write FProxyType default P_NONE;
  271.     property ProxyHost: String read FProxyHost write FProxyHost;
  272.     property ProxyPort: Word read FProxyPort write FProxyPort;
  273.     property ProxyUserID: String read FUserID write FUserID;
  274.     property ProxyResolve: Boolean read FResolve write FResolve default False;
  275.     property ProxyAuth: Boolean read FProxyAuth write FProxyAuth default False;
  276.     property ProxyPass: String read FProxyPass write FProxyPass;
  277.     property UIN: LongWord read FLUIN write FLUIN;
  278.     property Password: String read FLPass write FLPass;
  279.     property ICQServer: String read FIp write FIp;
  280.     property ICQPort: Word read FPort write FPort;
  281.     property ConvertToPlaintext: Boolean read FDoPlain write FDoPlain;
  282.     property ContactList: TStrings read FContactLst write SetContactList;
  283.     property VisibleList: TStrings read FVisibleLst write SetVisibleList;
  284.     property InvisibleList: TStrings read FInvisibleLst write SetInvisibleList;
  285.     property AutoAwayMessage: String read FAutoAwayMsg write FAutoAwayMsg;
  286.     property OnLogin: TNotifyEvent read FOnLogin write FOnLogin;
  287.     property OnMessageRecv: TOnMsgProc read FOnMsg write FOnMsg;
  288.     property OnURLRecv: TOnURLProc read FOnURL write FOnURL;
  289.     property OnOfflineMsgRecv: TOnMsgProc read FOnOffMsg write FOnOffMsg;
  290.     property OnOfflineURLRecv: TOnURLProc read FOnOffURL write FOnOffURL;
  291.     property OnPktParse: TOnAdvPktParse read FOnPktParse write FOnPktParse;
  292.     property OnPktDirectParse: TOnAdvPktParse read FOnDPktParse write FOnDPktParse;
  293.     property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write FOnConnectionFailed;
  294.     property OnStatusChange: TOnStatusChange read FOnStatusChange write FOnStatusChange;
  295.     property OnUserOffline: TOnUserEvent read FOnUserOffline write FOnUserOffline;
  296.     property OnAddedYou: TOnUserEvent read FOnAddedYou write FOnAddedYou;
  297.     property OnUserGeneralInfo: TOnUserGeneralInfo read FOnUserGeneralInfo write FOnUserGeneralInfo;
  298.     property OnUserWorkInfo: TOnUserWorkInfo read FOnUserWorkInfo write FOnUserWorkInfo;
  299.     property OnUserInfoMore: TOnUserInfoMore read FOnUserInfoMore write FOnUserInfoMore;
  300.     property OnUserInfoAbout: TOnUserInfoAbout read FOnUserInfoAbout write FOnUserInfoAbout;
  301.     property OnUserInfoInterests: TOnUserInfoInterests read FOnUserInfoInterests write FOnUserInfoInterests;
  302.     property OnUserInfoMoreEmails: TOnUserInfoMoreEmails read FOnUserInfoMoreEmails write FOnUserInfoMoreEmails;
  303.     property OnUserInfoBackground: TOnUserInfoBackground read FOnUserInfoBackground write FOnUserInfoBackground;
  304.     property OnUserFound: TOnUserFound read FOnUserFound write FOnUserFound;
  305.     property OnUserNotFound: TNotifyEvent read FOnUserNotFound write FOnUserNotFound;
  306.     property OnServerListRecv: TOnServerListRecv read FOnServerListRecv write FOnServerListRecv;
  307.     property OnAdvancedMsgAck: TOnAdvMsgAck read FOnAdvMsgAck write FOnAdvMsgAck;
  308.     property OnNewUINRegistered: TOnUserEvent read FOnNewUINRegistered write FOnNewUINRegistered;
  309.     property OnNewUINRefused: TNotifyEvent read FOnNewUINRefused write FOnNewUINRefused;
  310.     property OnAutoMsgResponse: TOnAutoMsgResponse read FOnAutoMsgResponse write FOnAutoMsgResponse;
  311.     property OnUnregisterOk: TNotifyEvent read FOnUnregisterOk write FOnUnregisterOk;
  312.     property OnUnregisterBadPassword: TNotifyEvent read FOnUnregBadPass write FOnUnregBadPass;
  313.     property OnContactListRecv: TOnContactListRecv read FOnContactListRecv write FOnContactListRecv;
  314.     property OnContactListRequest: TOnContactListReq read FOnContactListReq write FOnContactListReq;
  315.     property OnDirectPacketAck: TOnDirectPktAck read FOnDirectPktAck write FOnDirectPktAck;
  316.     property OnSMSRefused: TNotifyEvent read FOnSmsRefused write FOnSmsRefused;
  317.     property OnSMSAck: TOnSMSAck read FOnSMSAck write FOnSMSAck;
  318.     property OnOnlineInfo: TOnOnlineInfo read FOnOnlineInfo write FOnOnlineInfo;
  319.     property OnError: TOnError read FOnError write FOnError;
  320.     property ConnectionTimeout: Byte read FTimeout write FTimeout;
  321.     property OnSMSReply: TOnSMSReply read FOnSMSReply write FOnSMSReply;
  322.     property OnInfoChanged: TOnInfoChanged read FOnInfoChanged write FOnInfoChanged;
  323.     property OnAuthorizationChangedOk: TNotifyEvent read FOnAuthSet write FOnAuthSet;
  324.     property OnAuthResponse: TOnAuthResponse read FOnAuthResponse write FOnAuthResponse;
  325.     property OnSSLChangeResponse: TOnChangeResponse read FOnChangeResponse write FOnChangeResponse;
  326.     property OnFTRequest: TOnFTRequest read FOnFTRequest write FOnFTRequest;
  327.     property OnFTInit: TOnFTInit read FOnFTInit write FOnFTInit;
  328.     property OnFTStart: TOnFTStart read FOnFTStart write FOnFTStart;
  329.     property OnFTFileData: TOnFTFileData read FOnFTFileData write FOnFTFileData;
  330.     property OnUserInfoShort: TOnUserInfoShort read FOnUserInfoShort write FOnUserInfoShort;
  331.   end;
  333.   TMyTimer = class(TObject)
  334.   private
  335.     FInterval: LongWord;
  336.     FWindowHandle: THandle;
  337.     FOnTimer: TNotifyEvent;
  338.     FEnabled: Boolean;
  339.     FTag: Integer;
  340.     procedure UpdateTimer;
  341.     procedure SetEnabled(Value: Boolean);
  342.     procedure SetInterval(Value: LongWord);
  343.     procedure SetOnTimer(Value: TNotifyEvent);
  344.     procedure WndProc(var Msg: TMessage);
  345.   protected
  346.     procedure Timer; dynamic;
  347.   public
  348.     constructor Create;
  349.     destructor Destroy; override;
  350.     property Tag: Integer read FTag write FTag;
  351.   published
  352.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  353.     property Interval: LongWord read FInterval write SetInterval default 1000;
  354.     property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  355.   end;
  357. procedure Register;
  359. implementation
  360. {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
  362. {*** CONSTRUCTOR ***}
  363. constructor TICQNet.Create;
  364. begin
  365.   inherited Create;
  366. end;
  368. {*** DESTRUCTOR ***}
  369. destructor TICQNet.Destroy;
  370. begin
  371.   inherited;
  372. end;
  374. procedure TICQNet.Connect;
  375. begin
  376.   FSrcLen := 0;
  377.   FFlapSet := False;
  378.   inherited;
  379. end;
  381. {No proxy data is received here.}
  382. procedure TICQNet.OnReceive(Buffer: Pointer; BufLen: LongWord);
  383. var
  384.   i, len: LongWord;
  385.   flap: TFlapHdr;
  386. begin
  387.   inherited;
  388.   for i := 0 to BufLen - 1 do
  389.   begin
  390.     FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
  391.     Inc(FSrcLen);
  392.     //Searching for the Flap header
  393.     if (FSrcLen >= TFLAPSZ) and (not FFlapSet) then
  394.     begin
  395.       FFlapSet := True;
  396.       FNewFlap := PFlapHdr(@FSrcBuf)^;
  397.       FNewFlap.DataLen := Swap16(FNewFlap.DataLen);
  398.       FNewFlap.Seq := Swap16(FNewFlap.Seq);
  399.       if FNewFlap.DataLen > 8192 then
  400.       begin
  401.         if Assigned(OnError) then
  402.           OnError(Self, ERR_PROTOCOL, 'Length of received packet exceeds maximum supported by protocol. Len = ' + IntToStr(FNewFlap.DataLen));
  403.         Disconnect;
  404.         Exit;
  405.       end;
  406.     end;
  407.     //Whole packet was received
  408.     if FSrcLen = FNewFlap.DataLen + TFLAPSZ then
  409.     begin
  410.       if FNewFlap.Ident <> $2a then
  411.       begin
  412.         if Assigned(OnError) then
  413.           OnError(Self, ERR_PROTOCOL, 'Received malformed packet');
  414.         Disconnect;
  415.         Exit;
  416.       end;
  417.       Move(FNewFlap, flap, SizeOf(FNewFlap));      
  418.       //Preparing structures for receiving the next packet
  419.       FNewFlap.DataLen := 0;
  420.       len := FSrcLen; FSrcLen := 0;
  421.       FFlapSet := False;
  422.       //Dump packet (if needed)
  423.       if Assigned(OnPktParseA) then
  424.         OnPktParseA(Self, @FSrcBuf, len, True);
  425.       //Handling packet
  426.       if Assigned(OnHandlePkt) then
  427.         FHandlePkt(flap, Ptr(LongWord(@FSrcBuf) + TFLAPSZ));
  428.     end;
  429.   end;
  430. end;
  433. {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
  435. {*** CONSTRUCTOR ***}
  436. constructor TICQClient.Create(AOwner: TComponent);
  437. begin
  438.   inherited;
  439.   FLastError := '';                     //Last error
  441.   FContactLst := TStringList.Create;    //Contact list
  442.   FVisibleLst := TStringList.Create;    //Visible list
  443.   FInvisibleLst := TStringList.Create;  //Invisible list
  445.   FInfoChain := TStringList.Create;     //Info request chain
  446.   FSInfoChain := TStringList.Create;    //Short info request chain
  448.   //Socket for working with TCP
  449.   FSock := TICQNet.Create;
  450.   FSock.OnError := OnIntError;
  452.   FTimer := TMyTimer.Create;              //Timeout timer
  453.   FTimer.OnTimer := OnTimeout;          //Set timeout event
  454.   FTimer.Enabled := False;              //Disable timer by default
  456.   Randomize;                            //Initialize random generator
  457.   FSeq := Random($AAAA);                //Choose random seq, which is used in Flap header
  459.   FDirect := nil;                       //Do not initialize direct control until we connect
  460. end;
  462. {*** DESTRUCTOR ***}
  463. destructor TICQClient.Destroy;
  464. begin
  465.   if FDirect <> nil then
  466.     FDirect.Free;
  468.   FSock.OnConnectError := nil;
  469.   FSock.OnConnectProc := nil;
  470.   FSock.OnDisconnect := nil;
  471.   FSock.OnError := nil;
  472.   FSock.OnReceiveProc := nil;
  473.   FSock.Free;
  475.   FTimer.OnTimer := nil;
  476.   FTimer.Free;
  478.   //Free TStringList objects
  479.   FContactLst.Free;
  480.   FVisibleLst.Free;
  481.   FInvisibleLst.Free;
  482.   FInfoChain.Free;
  483.   FSInfoChain.Free;
  485.   inherited;
  486. end;
  488. {Set NetICQ's properties}
  489. procedure TICQClient.InitNetICQ;
  490. begin
  491.   //Assign properties
  492.   FSock.Host := FIp;
  493.   FSock.Port := FPort;
  494.   FSock.ProxyType := FProxyType;
  495.   FSock.ProxyHost := FProxyHost;
  496.   FSock.ProxyPort := FProxyPort;
  497.   FSock.ProxyUserID := FUserID;
  498.   FSock.ProxyAuth := FProxyAuth;
  499.   FSock.ProxyPass := FProxyPass;
  500.   FSock.UseProxyResolve := ProxyResolve;
  502.   //Assign events
  503.   FSock.OnHandlePkt := HandlePacket;
  504.   FSock.OnDisconnect := FTOnDisconnect;
  505.   FSock.OnConnectError := FTOnConnectError;
  506.   FSock.OnPktParseA := FTOnPktParse;
  507. end;
  509. {Called when error happened.}
  510. procedure TICQClient.OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
  511. begin
  512.   FLastError := ErrorMsg;
  513.   if Assigned(OnError) then
  514.     FOnError(Self, ErrorType, ErrorMsg);
  515. end;
  517. {Logins to server.}
  518. procedure TICQClient.Login(Status: LongWord = S_ONLINE);
  519. begin
  520.   if FDirect <> nil then
  521.   begin
  522.     FDirect.OnError := nil;
  523.     FDirect.OnHandle := nil;
  524.     FDirect.OnPktDump := nil;
  525.     FDirect.Free;
  526.   end;
  528.   if not DisableDirectConnections then
  529.   begin
  530.     FDirect := TDirectControl.Create(FLUIN);
  531.     FDirect.OnPktDump := FTOnDirectParse;
  532.     FDirect.OnHandle := HDirectMsg;
  533.     FDirect.OnError := OnIntError;
  534.     FDirect.OnFTInit := OnFTInitProc;
  535.     FDirect.OnFTStart := OnFTStartProc;
  536.     FDirect.OnFTFileData := OnFTFileDataProc;
  538.     //Assign proxy settings
  539.     FDirect.ProxyType := ProxyType;
  540.     FDirect.ProxyHost := ProxyHost;
  541.     FDirect.ProxyPort := ProxyPort;
  542.     FDirect.ProxyUserID := ProxyUserID;
  543.     FDirect.ProxyAuth := ProxyAuth;
  544.     FDirect.ProxyPass := ProxyPass;
  545.     FDirect.UseProxyResolve := ProxyResolve;
  546.   end;
  549.   FDSeq := Random(High(Word));
  550.   FSeq2 := 2;
  551.   FCookie := '';
  552.   FFirstConnect := True;
  553.   FStatus := Status;
  554.   FLoggedIn := False;
  555.   FRegisteringUIN := False;
  557.   InitNetICQ;
  558.   FTimer.Interval := FTimeout * 1000;
  559.   FTimer.Enabled := False;
  560.   if FTimeout <> 0 then
  561.     FTimer.Enabled := True;
  562.     
  563.   FSock.Connect;
  564. end;
  566. {Registers a new UIN.}
  567. procedure TICQClient.RegisterNewUIN(const Password: String);
  568. begin
  569.   FRegisteringUIN := True;
  570.   FRegPassword := Password;
  571.   FLoggedIn := False;
  572.   InitNetICQ;
  573.   FTimer.Interval := FTimeout * 1000;
  574.   FTimer.Enabled := True;
  575.   FSock.Connect;
  576. end;
  578. {Disconnect user from server.}
  579. procedure TICQClient.Disconnect;
  580. begin
  581.   FTimer.Enabled := False;
  582.   FSock.Disconnect;
  583.   if Assigned(OnConnectionFailed) then
  584.     FOnConnectionFailed(Self);
  585. end;
  587. {Send a message to UIN.}
  588. procedure TICQClient.SendMessage(UIN: LongWord; const Msg: String);
  589. var
  590.   pkt: TRawPkt;
  591. begin
  592.   if not LoggedIn then Exit;
  593.   CreateCLI_SENDMSG(@pkt, 0, Random($FFFFAA), UIN, Msg, FSeq);
  594.   FSock.SendData(pkt, pkt.Len);
  595. end;
  597. {Send an URL message to UIN.}
  598. procedure TICQClient.SendURL(UIN: LongWord; const URL, Description: String);
  599. var
  600.   pkt: TRawPkt;
  601. begin
  602.   if not LoggedIn then Exit;
  603.   CreateCLI_SENDURL(@pkt, 0, Random($FFFFAA), FLUIN, UIN, URL, Description, FSeq);
  604.   FSock.SendData(pkt, pkt.Len);
  605. end;
  607. {Adds UIN to contact list after logon(when you are online), UIN automaticly
  608. added to ContactList TStrings. After adding the UIN you will receive status
  609. notifications. Returns True when UIN is added to the list(it wasn't there before).}
  610. function TICQClient.AddContact(UIN: LongWord): Boolean;
  611. var
  612.   pkt: TRawPkt;
  613. begin
  614.   Result := False;
  615.   if FContactLst.IndexOf(IntToStr(UIN)) < 0 then
  616.   begin
  617.     FContactLst.Add(IntToStr(UIN));
  618.     Result := True;
  619.   end else
  620.     Exit;
  621.   if not LoggedIn then Exit;
  622.   CreateCLI_ADDCONTACT(@pkt, IntToStr(UIN), FSeq);           {SNAC(x03/x04)}
  623.   FSock.SendData(pkt, pkt.Len);
  624. end;
  626. {Removes UIN from contact list. Use while you are online.}
  627. procedure TICQClient.RemoveContact(UIN: LongWord);
  628. var
  629.   idx: Integer;
  630.   pkt: TRawPkt;
  631. begin
  632.   idx := FContactLst.IndexOf(IntToStr(UIN));
  633.   if idx > -1 then
  634.     FContactLst.Delete(idx);
  635.   if not LoggedIn then Exit;
  636.   CreateCLI_REMOVECONTACT(@pkt, UIN, FSeq);
  637.   FSock.SendData(pkt, pkt.Len);
  638. end;
  640. {Removes UIN from the visible list. Use while you are online.}
  641. procedure TICQClient.RemoveContactVisible(UIN: LongWord);
  642. var
  643.   idx: Integer;
  644.   pkt: TRawPkt;
  645. begin
  646.   idx := FVisibleLst.IndexOf(IntToStr(UIN));
  647.   if idx > -1 then
  648.     FVisibleLst.Delete(idx);
  649.   if not LoggedIn then Exit;
  650.   CreateCLI_REMVISIBLE(@pkt, UIN, FSeq);
  651.   FSock.SendData(pkt, pkt.Len);
  652. end;
  654. {Removes UIN from the invisible list. Use while you are online.}
  655. procedure TICQClient.RemoveContactInvisible(UIN: LongWord);
  656. var
  657.   idx: Integer;
  658.   pkt: TRawPkt;
  659. begin
  660.   idx := FInvisibleLst.IndexOf(IntToStr(UIN));
  661.   if idx > -1 then
  662.     FInvisibleLst.Delete(idx);
  663.   if not LoggedIn then Exit;
  664.   CreateCLI_REMINVISIBLE(@pkt, UIN, FSeq);
  665.   FSock.SendData(pkt, pkt.Len);
  666. end;
  668. {Query info about UIN. As answer you will recieve theese events: OnUserWorkInfo,
  669. OnUserInfoMore, OnUserInfoAbout, OnUserInfoInterests, OnUserInfoMoreEmails,
  670. OnUserFound.}
  671. procedure TICQClient.RequestInfo(UIN: LongWord);
  672. var
  673.   pkt: TRawPkt;
  674. begin
  675.   if not LoggedIn then Exit;
  676.   FInfoChain.Values[IntToStr(FSeq2)] := IntToStr(UIN);  
  677.   CreateCLI_METAREQINFO(@pkt, FLUIN, UIN, FSeq, FSeq2);
  678.   FSock.SendData(pkt, pkt.Len);
  679. end;
  681. {Request short info(nick, first, last, email) of UIN.}
  682. procedure TICQClient.RequestInfoShort(UIN: LongWord);
  683. var
  684.   pkt: TRawPkt;
  685. begin
  686.   if not LoggedIn then Exit;
  687.   FSInfoChain.Values[IntToStr(FSeq2)] := IntToStr(UIN);
  688.   CreateCLI_METAREQINFO_SHORT(@pkt, FLUIN, UIN, FSeq, FSeq2);
  689.   FSock.SendData(pkt, pkt.Len);
  690. end;
  692. {Searches user by Mail}
  693. procedure TICQClient.SearchByMail(const Email: String);
  694. var
  695.   pkt: TRawPkt;
  696. begin
  697.   if not LoggedIn then Exit;
  698.   CreateCLI_SEARCHBYMAIL(@pkt, FLUIN, Email, FSeq, FSeq2);
  699.   FSock.SendData(pkt, pkt.Len);
  700. end;
  702. {Searches user by UIN}
  703. procedure TICQClient.SearchByUIN(UIN: LongWord);
  704. var
  705.   pkt: TRawPkt;
  706. begin
  707.   if not LoggedIn then Exit;
  708.   CreateCLI_SEARCHBYUIN(@pkt, FLUIN, UIN, FSeq, FSeq2);
  709.   FSock.SendData(pkt, pkt.Len);
  710. end;
  712. {Searches user by Name and other data}
  713. procedure TICQClient.SearchByName(const FirstName, LastName, NickName, Email: String);
  714. var
  715.   pkt: TRawPkt;
  716. begin
  717.   if not LoggedIn then Exit;
  718.   CreateCLI_SEARCHBYNAME(@pkt, FLUIN, FirstName, LastName, NickName, Email, FSeq, FSeq2);
  719.   FSock.SendData(pkt, pkt.Len);
  720. end;
  722. {Searches random user from Group, where Group id could be found in RandGroups:
  723. array[1..11]...(ICQWorks.pas) constant. As answer you will receive OnUserFound
  724. notification, only one user will be found.}
  725. procedure TICQClient.SearchRandom(Group: Word);
  726. var
  727.   pkt: TRawPkt;
  728. begin
  729.   if not LoggedIn then Exit;
  730.   CreateCLI_SEARCHRANDOM(@pkt, FLUIN, Group, FSeq, FSeq2);
  731.   FSock.SendData(pkt, pkt.Len);
  732. end;
  734. {Searches user in 'White Pages'. As answer you will receive OnUserFound notification
  735. when at least one user found or OnUserNotFound if such user does not exist.}
  736. procedure TICQClient.SearchWhitePages(const FirstName, LastName, NickName, Email: String; MinAge, MaxAge: Word;
  737.   Gender: Byte; const Language, City, Country, Company, Department, Position, Occupation,
  738.   Organization, OrganKeyWords, PastAffiliation, AffiKeyWords, KeyWord: String; Online: Boolean);
  739. var
  740.   pkt: TRawPkt;
  741. begin
  742.   if not LoggedIn then Exit;
  743.   CreateCLI_SEARCHWP(@pkt, FLUIN, FirstName, LastName, NickName, Email,
  744.     MinAge, MaxAge,
  745.     Gender,
  746.     StrToLanguageI(Language),
  747.     City, StrToCountryI(Country),
  748.     Company,
  749.     Department,
  750.     Position,
  751.     StrToOccupationI(Occupation),
  752.     StrToOrganizationI(Organization),
  753.     OrganKeyWords,
  754.     StrToPastI(PastAffiliation),
  755.     AffiKeyWords,
  756.     KeyWord,
  757.     Ord(Online),
  758.     FSeq,
  759.     FSeq2);
  760.   FSock.SendData(pkt, pkt.Len);
  761. end;
  763. {Set general info about yourself. You can skip some parameters (eg. use '' -
  764. empty strings) to unspecify some info. }
  765. procedure TICQClient.SetSelfInfoGeneral(NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
  766. var
  767.   pkt: TRawPkt;
  768. begin
  769.   if not LoggedIn then Exit;
  770.   //Truncate state if more then 3 chars
  771.   if Length(State) > 3 then
  772.     State := Copy(State, 0, 3);
  773.   CreateCLI_METASETGENERAL(@pkt, FLUIN, NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip, StrToCountryI(Country), TimeZone, PublishEmail, FSeq, FSeq2);
  774.   FSock.SendData(pkt, pkt.Len);
  775. end;
  777. {Set more info about yourself.}
  778. procedure TICQClient.SetSelfInfoMore(Age: Word; Gender: Byte; const HomePage: String; BirthYear: Word; BirthMonth, BirthDay: Byte; Language1, Language2, Language3: String);
  779. var
  780.   pkt: TRawPkt;
  781. begin
  782.   if not LoggedIn then Exit;
  783.   CreateCLI_METASETMORE(@pkt, FLUIN, Age, Gender, HomePage, BirthYear, BirthMonth, BirthDay, StrToLanguageI(Language1), StrToLanguageI(Language2), StrToLanguageI(Language3), FSeq, FSeq2);
  784.   FSock.SendData(pkt, pkt.Len);
  785. end;
  787. {Set info about yourself.}
  788. procedure TICQClient.SetSelfInfoAbout(const About: String);
  789. var
  790.   pkt: TRawPkt;
  791. begin
  792.   if not LoggedIn then Exit;
  793.   CreateCLI_METASETABOUT(@pkt, FLUIN, About, FSeq, FSeq2);
  794.   FSock.SendData(pkt, pkt.Len);
  795. end;
  797. {Requests server side contact list. For more info look at OnServerListRecv event.}
  798. procedure TICQClient.RequestContactList;
  799. var
  800.   pkt: TRawPkt;
  801. begin
  802.   if not LoggedIn then Exit;
  803.   CreateCLI_REQROSTER(@pkt, FSeq);
  804.   FSock.SendData(pkt, pkt.Len);
  805. end;
  807. {Releases memory used while parsing the server side contact list.}
  808. procedure TICQClient.DestroyUINList(var List: TList);
  809. var
  810.   i: Word;
  811. begin
  812.   if List = nil then Exit;
  813.   if List.Count > 0 then
  814.     for i := 0 to List.Count - 1 do
  815.       FreeMem(List.Items[i], SizeOf(TUINEntry)); //Free allocated memory for TUINEntry
  816.   List.Free;
  817.   List := nil;
  818. end;
  820. {Sends sms message to Destination with Text.}
  821. procedure TICQClient.SendSMS(const Destination, Text: String);
  822. var
  823.   pkt: TRawPkt;
  824. begin
  825.   if (Length(Text) = 0) or (not LoggedIn) then Exit;
  826.   CreateCLI_SENDSMS(@pkt, FLUIN, Destination, Text, GetACP, GetSMSTime, FSeq, FSeq2);
  827.   FSock.SendData(pkt, pkt.Len);
  828. end;
  830. {Sends Msg to UIN with advanced options, after UIN has got your message you will
  831. receive confirmation. ID - randomly generated value, may be used for packet acknowledgements
  832. (see OnAdvancedMsgAck event). If your Msg is in the RTF(RichText Format), then RTFFormat
  833. parameter should be True, otherwise - False. Beware of using the RTF Format, some clients
  834. (old versions of ICQ, linux & windows clones) don't support it.}
  835. procedure TICQClient.SendMessageAdvanced(UIN: LongWord; const Msg: String; ID: Word; RTFFormat: Boolean);
  836. var
  837.   pkt: TRawPkt;
  838. begin
  839.   if (Length(Msg) = 0) or (not LoggedIn) then Exit;
  840.   CreateCLI_SENDMSG_ADVANCED(@pkt, 0, ID, UIN, Msg, RTFFormat, FSeq);
  841.   FSock.SendData(pkt, pkt.Len);
  842. end;
  844. {Send message to client dirrectly when it's possible}
  845. function TICQClient.SendMessageDirect(UIN: LongWord; const Msg: String; RTFFormat: Boolean): Word;
  846. var
  847.   lpkt: TRawPkt;
  848. begin
  849.   Result := 0;
  850.   if FDirect = nil then Exit;
  851.   if (FDSeq = 0) then Inc(FSeq);
  852.   Result := CreatePEER_MSG(@lpkt, Msg, RTFFormat, FDSeq);
  853.   if not FDirect.SendData(UIN, @lpkt) then
  854.     Result := 0;
  855. end;
  857. {Request an away messages, set when user changes status.}
  858. procedure TICQClient.RequestAwayMsg(UIN: LongWord; ID: Word; ReqStatus: Byte);
  859. var
  860.   pkt: TRawPkt;
  861. begin
  862.   if (not LoggedIn) then Exit;
  863.   CreateCLI_REQAWAYMSG(@pkt, 0, ID, UIN, ReqStatus, FSeq);
  864.   FSock.SendData(pkt, pkt.Len);
  865. end;
  867. {Unregister an UIN number.}
  868. procedure TICQClient.UnregisterUIN(const Password: String);
  869. var
  870.   pkt: TRawPkt;
  871. begin
  872.   if (not LoggedIn) then Exit;
  873.   CreateCLI_UNREGUIN(@pkt, FLUIN, Password, FSeq, FSeq2);
  874.   FSock.SendData(pkt, pkt.Len);
  875. end;
  877. {Change current password to NewPassword.}
  878. procedure TICQClient.ChangePassword(const NewPassword: String);
  879. var
  880.   pkt: TRawPkt;
  881. begin
  882.   if (not LoggedIn) then Exit;
  883.   CreateCLI_METASETPASS(@pkt, FLUIN, NewPassword, nil, 0, FSeq, FSeq2);
  884.   FSock.SendData(pkt, pkt.Len);
  885. end;
  887. {Change current password to Buffer's value.}
  888. procedure TICQClient.ChangePasswordPtr(Buffer: Pointer; BufLen: Word);
  889. var
  890.   pkt: TRawPkt;
  891. begin
  892.   if (not LoggedIn) then Exit;
  893.   CreateCLI_METASETPASS(@pkt, FLUIN, '', Buffer, BufLen, FSeq, FSeq2);
  894.   FSock.SendData(pkt, pkt.Len);
  895. end;
  897. {Returns True if direct connection with UIN has been estabilished.}
  898. function TICQClient.DirectConnectionEstabilished(UIN: LongWord): Boolean;
  899. begin
  900.   Result := False;
  901.   if FDirect = nil then Exit;
  902.   Result := FDirect.ConnectionEstabilished(UIN);
  903. end;
  905. {Send contacts to UIN through server.}
  906. function TICQClient.SendContacts(UIN: LongWord; Contacts: TStringList; ID: Word): Boolean;
  907. var
  908.   pkt: TRawPkt;
  909. begin
  910.   Result := False;
  911.   if not LoggedIn then Exit;
  912.   CreateCLI_SENDCONTACTS(@pkt, 0, ID, UIN, Contacts, FSeq);
  913.   FSock.SendData(pkt, pkt.Len);
  914.   Result := True;
  915. end;
  917. {Request contacts from UIN through server.}
  918. function TICQClient.RequestContacts(UIN: LongWord; const Reason: String; ID: Word): Boolean;
  919. var
  920.   pkt: TRawPkt;
  921. begin
  922.   Result := False;
  923.   if not LoggedIn then Exit;
  924.   CreateCLI_SENDCONTACTS_REQ(@pkt, 0, ID, UIN, Reason, FSeq);
  925.   FSock.SendData(pkt, pkt.Len);
  926.   Result := True;  
  927. end;
  929. {Sends contacts to UIN directly. Returns ID of the packet or 0 if failed.}
  930. function TICQClient.SendContactsDC(UIN: LongWord; Contacts: TStringList): Word;
  931. var
  932.   pkt: TRawPkt;
  933. begin
  934.   Result := 0;
  935.   if FDirect = nil then Exit;
  936.   if (FDSeq = 0) then Inc(FSeq);
  937.   Result := CreatePEER_CONTACTS(@pkt, Contacts, FDSeq);
  938.   if not FDirect.SendData(UIN, @pkt) then
  939.     Result := 0;
  940. end;
  942. {Request contacts from UIN directly. Returns ID of the packet or 0 if failed.}
  943. function TICQClient.RequestContactsDC(UIN: LongWord; const Reason: String): Word;
  944. var
  945.   lpkt: TRawPkt;
  946. begin
  947.   Result := 0;
  948.   if FDirect = nil then Exit;
  949.   if (FDSeq = 0) then Inc(FSeq);
  950.   Result := CreatePEER_CONTACTREQ(@lpkt, Reason, FDSeq);
  951.   if not FDirect.SendData(UIN, @lpkt) then
  952.     Result := 0;
  953. end;
  955. {Send keep alive packet.}
  956. procedure TICQClient.SendKeepAlive;
  957. var
  958.   lpkt: TRawPkt;
  959. begin
  960.   if (not LoggedIn) then Exit;
  961.   CreateCLI_KEEPALIVE(@lpkt, FSeq);
  962.   FSock.SendData(lpkt, lpkt.Len);
  963. end;
  965. {Set AuthorizationRequired and WebAware options.}
  966. procedure TICQClient.SetAuthorization(AuthorizationRequired, WebAware: Boolean);
  967. var
  968.   lpkt: TRawPkt;
  969. begin
  970.   if (not LoggedIn) then Exit;
  971.   CreateCLI_METASETPERMISSIONS(@lpkt, FLUIN, AuthorizationRequired, WebAware, FSeq, FSeq2);
  972.   FSock.SendData(lpkt, lpkt.Len);
  973. end;
  975. {Request authorization.}
  976. procedure TICQClient.SendAuthRequest(UIN: LongWord; Msg: String);
  977. var
  978.   lpkt: TRawPkt;
  979. begin
  980.   if (not LoggedIn) then Exit;
  981.   CreateCLI_REQAUTH(@lpkt, UIN, Msg, FSeq);
  982.   FSock.SendData(lpkt, lpkt.Len);
  983. end;
  985. {Start changes of SSL.}
  986. procedure TICQClient.SSLChangeStart(FirstUpload: Boolean);
  987. var
  988.   lpkt: TRawPkt;
  989. begin
  990.   if (not LoggedIn) then Exit;
  991.   CreateCLI_ADDSTART(@lpkt, FirstUpload, FSeq);
  992.   FSock.SendData(lpkt, lpkt.Len);
  993. end;
  995. {End changes of SSL.}
  996. procedure TICQClient.SSLChangeEnd;
  997. var
  998.   lpkt: TRawPkt;
  999. begin
  1000.   if (not LoggedIn) then Exit;
  1001.   CreateCLI_ADDEND(@lpkt, FSeq);
  1002.   FSock.SendData(lpkt, lpkt.Len);
  1003. end;
  1005. {Add group to SSL.}
  1006. procedure TICQClient.SSLAddGroup(GroupName: String; GroupID: Word);
  1007. var
  1008.   lpkt: TRawPkt;
  1009. begin
  1010.   if (not LoggedIn) then Exit;
  1011.   CreateCLI_ADDBUDDY(@lpkt, GroupName, '', '', GroupID, 0, BUDDY_GROUP, False, FSeq);
  1012.   FSock.SendData(lpkt, lpkt.Len);
  1013. end;
  1015. {Add user to SSL.}
  1016. procedure TICQClient.SSLAddUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize, UpdateUser: Boolean);
  1017. var
  1018.   lpkt: TRawPkt;
  1019. begin
  1020.   if (not LoggedIn) then Exit;
  1021.   if not UpdateUser then
  1022.     CreateCLI_ADDBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, FSeq)
  1023.   else
  1024.     CreateCLI_UPDATEBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, FSeq);
  1025.   FSock.SendData(lpkt, lpkt.Len);
  1026. end;
  1028. {Remove user from SSL.}
  1029. procedure TICQClient.SSLDelUser(GroupID, UserID: Word; UIN, Name, SMSNumber: String; Authorize: Boolean);
  1030. var
  1031.   lpkt: TRawPkt;
  1032. begin
  1033.   if (not LoggedIn) then Exit;
  1034.   CreateCLI_DELETEBUDDY(@lpkt, UIN, Name, SMSNumber, GroupID, UserID, BUDDY_NORMAL, Authorize, True, FSeq);
  1035.   FSock.SendData(lpkt, lpkt.Len);
  1036. end;
  1038. {Remove group from SSL.}
  1039. procedure TICQClient.SSLDelGroup(GroupName: String; GroupID: Word);
  1040. var
  1041.   lpkt: TRawPkt;
  1042. begin
  1043.   if (not LoggedIn) then Exit;
  1044.   CreateCLI_DELETEBUDDY(@lpkt, GroupName, '', '', GroupID, 0, BUDDY_GROUP, False, True, FSeq);
  1045.   FSock.SendData(lpkt, lpkt.Len);
  1046. end;
  1048. {Update group's ids.}
  1049. procedure TICQClient.SSLUpdateGroup(GroupName: String; GroupID: Word; UserIDs: TStringList);
  1050. var
  1051.   lpkt: TRawPkt;
  1052. begin
  1053.   if (not LoggedIn) then Exit;
  1054.   CreateCLI_UPDATEGROUP(@lpkt, GroupName, GroupID, UserIDs, FSeq);
  1055.   FSock.SendData(lpkt, lpkt.Len);
  1056. end;
  1058. {Add user to the specified SSL's list.}
  1059. procedure TICQClient.SSLAddUserIntoList(UserID: Word; UIN: String; BuddyType: Word);
  1060. var
  1061.   lpkt: TRawPkt;
  1062. begin
  1063.   if (not LoggedIn) then Exit;
  1064.   CreateCLI_ADDBUDDY(@lpkt, UIN, '', '', $0000, UserID, BuddyType, False, FSeq);
  1065.   FSock.SendData(lpkt, lpkt.Len);
  1066. end;
  1068. {Remove user from the specified SSL's list.}
  1069. procedure TICQClient.SSLDelUserFromList(UserID: Word; UIN: String; BuddyType: Word);
  1070. var
  1071.   lpkt: TRawPkt;
  1072. begin
  1073.   if (not LoggedIn) then Exit;
  1074.   CreateCLI_DELETEBUDDY(@lpkt, UIN, '', '', $0000, UserID, BuddyType, False, True, FSeq);
  1075.   FSock.SendData(lpkt, lpkt.Len);
  1076. end;
  1078. {Send response on a file request.}
  1079. function TICQClient.FTResponse(ResponseRec: TFTRequestRec; Accept: Boolean; Reason: String): Boolean;
  1080. var
  1081.   lpkt: TRawPkt;
  1082. begin
  1083.   if DisableDirectConnections then
  1084.   begin
  1085.     Result := False;
  1086.     Exit;
  1087.   end;
  1088.   if not Accept then
  1089.   begin
  1090.     if ResponseRec.ReqType <> 0 then
  1091.     begin
  1092.       {Never tested because didn't see when ICQ request ft through server, miranda-icq doest this but doesn't handle file declines even from real ICQ}
  1093.       CreateCLI_SENDMSG_FILEDECLINE(@lpkt, ResponseRec.Seq, ResponseRec.ITime, ResponseRec.IRandomID,
  1094.         ResponseRec.UIN, ResponseRec.FileSize,
  1095.         ResponseRec.Description, ResponseRec.FileName, Reason, 0, FSeq);
  1096.       FSock.SendData(lpkt, lpkt.Len);
  1097.       Result := True;
  1098.       Exit;
  1099.     end;
  1100.   end;
  1101.   if FDirect <> nil then
  1102.   if FDirect.AddFileUser(ResponseRec.UIN, ResponseRec.Port) then
  1103.     begin
  1104.       {Send response through estabilished direct connection}
  1105.       if ResponseRec.ReqType = 0 then
  1106.       begin
  1107.         CreatePEER_FILEINIT(@lpkt, True, ResponseRec.Description, ResponseRec.FileName, ResponseRec.Port,
  1108.           ResponseRec.FileSize, ResponseRec.Seq, Reason, Accept);
  1109.         Result := FDirect.SendData(ResponseRec.UIN, @lpkt);
  1110.       end else
  1111.       {Send response through server}
  1112.       begin
  1113.         CreateCLI_SENDMSG_FILEACK(@lpkt, ResponseRec.Seq, ResponseRec.ITime, ResponseRec.IRandomID,
  1114.           ResponseRec.UIN, ResponseRec.FileSize, ResponseRec.Description, ResponseRec.FileName,
  1115.           ResponseRec.Port, FSeq);
  1116.         FSock.SendData(lpkt, lpkt.Len);
  1117.         Result := True;
  1118.       end;
  1119.       Exit;
  1120.     end else
  1121.       OnIntError(Self, ERR_WARNING, 'Could not add user for sending/receiving files');
  1122.   Result := False;
  1123. end;
  1125. procedure TICQClient.FTCancel(UIN: LongWord);
  1126. begin
  1127.   if FDirect <> nil then
  1128.     FDirect.StopFileReceiving(UIN);
  1129. end;
  1131. function TICQClient.FTStartResponse(StartRec: TFTStartRec): Boolean;
  1132. var
  1133.   lpkt: TRawPkt;
  1134. begin
  1135.   Result := False;
  1136.   if FDirect = nil then Exit;
  1137.   CreatePEER_FILE_INIT2(@lpkt, StartRec.FilesCount, $00000000, StartRec.Speed);
  1138.   Result := FDirect.SendDataFile(StartRec.UIN, @lpkt);
  1139. end;
  1141. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  1142. {Handling of all incoming packets}
  1143. procedure TICQClient.HandlePacket(Flap: TFlapHdr; Data: Pointer);
  1144. var
  1145.   FUIN: String;
  1146.   FData: String;
  1147.   pkt: TRawPkt;
  1148.   T: Word;
  1149.   Snac: TSnacHdr;
  1150.   i: Word;
  1151. begin
  1152.   case Flap.ChID of
  1153.     1: //Channel 1
  1154.     begin
  1155.       {SRV_HELLO}
  1156.       if Flap.DataLen = 4 then
  1157.       begin
  1158.         if FRegisteringUIN then
  1159.         begin
  1160.           //Send CLI_HELLO
  1161.           CreateCLI_HELLO(@pkt, FSeq);
  1162.           FSock.SendData(pkt, pkt.Len);
  1163.           //Register a new UIN.
  1164.           CreateCLI_REGISTERUSER(@pkt, FRegPassword, FSeq);
  1165.           FSock.SendData(pkt, pkt.Len);
  1166.           Exit;
  1167.         end;
  1168.         if FFirstConnect then
  1169.         begin
  1170.           //Send login packet
  1171.           CreateCLI_IDENT(@pkt, FLUIN, FLPass, FSeq);
  1172.           FSock.SendData(pkt, pkt.len);
  1173.         end
  1174.         else
  1175.         begin
  1176.           //Sending the cookie(second stage of login sequence)
  1177.           CreateCLI_COOKIE(@pkt, FCookie, FSeq);
  1178.           FSock.SendData(pkt, pkt.Len);
  1179.         end;
  1180.       end;
  1181.       FFirstConnect := False;
  1182.     end;
  1183.     2: //Channel 2
  1184.     begin
  1185.       Move(Data^, pkt.Data, Flap.DataLen); pkt.Len := 0;
  1186.       GetSnac(@pkt, Snac);
  1187.       case Snac.Family of
  1188.         $01: //Family x01
  1189.           case Snac.SubType of
  1190.             $03: {SRV_FAMILIES}
  1191.             begin
  1192.               CreateCLI_FAMILIES(@pkt, FSeq);           {SNAC(x01/x17)}
  1193.               FSock.SendData(pkt, pkt.Len);
  1194.             end;
  1195.             $07: {SRV_RATES}
  1196.             begin
  1197.               CreateCLI_ACKRATES(@pkt, FSeq);           {SNAC(x01/x08)}
  1198.               FSock.SendData(pkt, pkt.Len);
  1199.               CreateCLI_SETICBM(@pkt, FSeq);            {SNAC(x04/x02)}
  1200.               FSock.SendData(pkt, pkt.Len);
  1201.               CreateCLI_REQINFO(@pkt, FSeq);            {SNAC(x01/x0E)}
  1202.               FSock.SendData(pkt, pkt.Len);
  1203.               CreateCLI_REQLOCATION(@pkt, FSeq);        {SNAC(x02/x02)}
  1204.               FSock.SendData(pkt, pkt.Len);
  1205.               CreateCLI_REQBUDDY(@pkt, FSeq);           {SNAC(x03/x02)}
  1206.               FSock.SendData(pkt, pkt.Len);
  1207.               CreateCLI_REQICBM(@pkt, FSeq);            {SNAC(x04/x04)}
  1208.               FSock.SendData(pkt, pkt.Len);
  1209.               CreateCLI_REQBOS(@pkt, FSeq);             {SNAC(x09/x02)}
  1210.               FSock.SendData(pkt, pkt.Len);
  1211.               //FConnecting := False;
  1212.             end;
  1213.             $13: {SRV_MOTD}
  1214.             begin
  1215.               CreateCLI_RATESREQUEST(@pkt, FSeq);       {SNAC(x01/x06)}
  1216.               FSock.SendData(pkt, pkt.Len);
  1217.             end;
  1218.           end;
  1219.         $03: //Family x03
  1220.         begin
  1221.           case Snac.SubType of
  1222.             $0B: {SRV_USERONLINE}
  1223.               HSnac030B(Flap, Snac, @pkt);
  1224.             $0C: {SRV_USEROFFLINE}
  1225.             begin
  1226.               FData := GetStr(@pkt, GetInt(@pkt, 1));
  1227.               if Assigned(OnUserOffline) then
  1228.                 FOnUserOffline(Self, FData);
  1229.             end;
  1230.           end;
  1231.         end;
  1232.         $04: //Family x04
  1233.           if Snac.SubType = $07 then {SRV_MSG}
  1234.             HSnac0407(Flap, Snac, @pkt)
  1235.           else if Snac.SubType = $0b then {SRV_MSGACK}
  1236.             HSnac040b(Flap, Snac, @pkt);
  1237.         $09: //Family x09
  1238.         begin
  1239.           if Snac.SubType = $03 then
  1240.           begin
  1241.             CreateCLI_SETUSERINFO(@pkt, FSeq);                                  {SNAC(x02/x04)}
  1242.             FSock.SendData(pkt, pkt.Len);
  1243.             if FContactLst.Count > 0 then
  1244.               for i := 0 to FContactLst.Count - 1 do
  1245.               begin
  1246.                 CreateCLI_ADDCONTACT(@pkt, FContactLst.Strings[i], FSeq);       {SNAC(x03/x04)}
  1247.                 FSock.SendData(pkt, pkt.Len);
  1248.               end;
  1249.             if StatusToStr(FStatus) <> 'Invisible' then
  1250.             begin
  1251.               CreateCLI_ADDINVISIBLE(@pkt, FInvisibleLst, FSeq);                {SNAC(x09/x07)}
  1252.               FSock.SendData(pkt, pkt.Len);
  1253.             end else
  1254.             begin
  1255.               CreateCLI_ADDVISIBLE(@pkt, FVisibleLst, FSeq);                    {SNAC(x09/x05)}
  1256.               FSock.SendData(pkt, pkt.Len);
  1257.             end;
  1258.             FDConnCookie := Random(High(Integer));
  1259.             if FDirect <> nil then
  1260.             begin
  1261.               if ProxyType = P_NONE then
  1262.                 i := FDirect.BindPort
  1263.               else
  1264.                 i := 0;
  1265.               CreateCLI_SETSTATUS(@pkt, FStatus, GetLocalIP, i, FDConnCookie, FProxyType, FSeq)  {SNAC(x01/x1E)}
  1266.             end else
  1267.               CreateCLI_SETSTATUS(@pkt, FStatus, 0, 0, 0, FProxyType, FSeq);    {SNAC(x01/x1E)}
  1268.             FSock.SendData(pkt, pkt.Len);
  1269.             CreateCLI_READY(@pkt, FSeq);                                        {SNAC(x01/x02)}
  1270.             FSock.SendData(pkt, pkt.Len);
  1271.             CreateCLI_TOICQSRV(@pkt, FLUIN, CMD_REQOFFMSG, nil, 0, FSeq, FSeq2);{SNAC(x15/x02)}
  1272.             FSock.SendData(pkt, pkt.Len);
  1273.             {OnLogin Event}
  1274.             FLoggedIn := True;
  1275.             FTimer.Enabled := False;
  1276.             FInfoChain.Clear;
  1277.             FSInfoChain.Clear;
  1278.             if Assigned(OnLogin) then
  1279.               FOnLogin(Self);
  1280.           end;
  1281.         end;
  1282.         $13: //Family x13
  1283.         begin
  1284.           if Snac.SubType = $0e then
  1285.             HSnac130e(Flap, Snac, @pkt) {SRV_UPDATE_ACK}
  1286.           else if Snac.SubType = $1B then
  1287.             HSnac131b(Flap, Snac, @pkt) {SRV_AUTH}
  1288.           else if Snac.SubType = $1C then {SRV_ADDEDYOU}
  1289.             HSnac131C(Flap, Snac, @pkt)
  1290.           else if Snac.SubType = $19 then {SRV_AUTH_REQ}
  1291.             HSnac1319(Flap, Snac, @pkt)
  1292.           else if Snac.SubType = $06 then {SRV_REPLYROSTER}
  1293.             HSnac1306(Flap, Snac, @pkt);
  1294.         end;
  1295.         $15: //Family x15
  1296.         begin
  1297.           if Snac.SubType = $03 then {SRV_FROMICQSRV}
  1298.             HSnac1503(Flap, Snac, @pkt);
  1299.         end;
  1300.         $17:
  1301.         begin
  1302.           if Snac.SubType = $01 then {SRV_REGREFUSED}
  1303.           begin
  1304.             if Assigned(OnNewUINRefused) then
  1305.               FOnNewUINRefused(Self);
  1306.           end else
  1307.           if Snac.SubType = $05 then
  1308.             HSnac1705(Flap, Snac, @pkt);
  1309.         end;
  1310.       end;
  1311.     end;
  1312.     4: //Channel 4
  1313.     begin
  1314.       if FLoggedIn or FRegisteringUIN then
  1315.       begin
  1316.         FTOnConnectError(Self);
  1317.         FSock.Disconnect;
  1318.         Exit;
  1319.       end;
  1320.       Move(Data^, pkt.Data, Flap.DataLen); pkt.Len := 0;
  1321.       //SRV_COOKIE
  1322.       FUIN  := GetTLVStr(@pkt, T);                //Client's UIN in ASCII format
  1323.       if T <> 1 then
  1324.       begin
  1325.         OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
  1326.         FTOnConnectError(Self);
  1327.         FSock.Disconnect;
  1328.         Exit;
  1329.       end;
  1330.       FData := GetTLVStr(@pkt, T);                //IP, Port to connect to
  1331.       if T = 4 then
  1332.       begin
  1333.         OnIntError(nil, ERR_LOGIN, 'Bad password');
  1334.         FTOnConnectError(Self);
  1335.         Exit;
  1336.       end else
  1337.       if T = 8 then
  1338.       begin
  1339.         OnIntError(nil, ERR_LOGIN, 'Too often logins');
  1340.         FTOnConnectError(Self);
  1341.         Exit;
  1342.       end else
  1343.       if T <> 5 then
  1344.       begin
  1345.         OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
  1346.         FTOnConnectError(Self);
  1347.         FSock.Disconnect;
  1348.         Exit;
  1349.       end;
  1350.       FCookie := GetTLVStr(@pkt, T);              //Cookie used in second stage of login
  1351.       if T <> 6 then
  1352.       begin
  1353.         OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
  1354.         FTOnConnectError(Self);
  1355.         FSock.Disconnect;
  1356.         Exit;
  1357.       end;
  1358.       //Sending CLI_GOODBYE
  1359.       PktInit(@pkt, 4, FSeq);
  1360.       PktFinal(@pkt);
  1361.       FSock.SendData(pkt, pkt.Len);
  1362.       FSock.Disconnect;
  1363.       //Assigning new IP and Port to connect to in second attemp
  1364.       InitNetICQ;
  1365.       FSock.Host := Copy(FData, 0, Pos(':', FData) - 1);
  1366.       FSock.Port := StrToInt(Copy(FData, Pos(':', FData) + 1, Length(FData) - Pos(':', FData)));
  1367.       if (FSock.Port = 0) then
  1368.       begin
  1369.         OnIntError(nil, ERR_PROTOCOL, 'Received malformed login packet');
  1370.         FTOnConnectError(Self);
  1371.         Exit;
  1372.       end;
  1373.       FSock.Connect;
  1374.     end;
  1375.   end;
  1376. end;
  1378. {////////////////////////////////////////////////////////////////////////////////////////////////////}
  1379. procedure TICQClient.SetStatus(NewStatus: LongWord);
  1380. var
  1381.   pkt: TRawPkt;
  1382. begin
  1383.   if not LoggedIn then Exit;
  1384.   if (StatusToStr(FStatus) = 'Invisible') and (StatusToStr(NewStatus) <> 'Invisible') then
  1385.   begin
  1386.     CreateCLI_ADDINVISIBLE(@pkt, FInvisibleLst, FSeq);
  1387.     FSock.SendData(pkt, pkt.Len);
  1388.   end else
  1389.   if (StatusToStr(NewStatus) = 'Invisible') and (StatusToStr(FStatus) <> 'Invisible') then
  1390.   begin
  1391.     CreateCLI_ADDVISIBLE(@pkt, FVisibleLst, FSeq);
  1392.     FSock.SendData(pkt, pkt.Len);
  1393.   end;
  1394.   CreateCLI_SETSTATUS_SHORT(@pkt, NewStatus, FSeq);
  1395.   FSock.SendData(pkt, pkt.Len);
  1396.   FStatus := NewStatus;
  1397. end;
  1399. {Handling packet with messages}
  1400. procedure TICQClient.HSnac0407(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  1401. var
  1402.   ITime, IRandomID: LongWord;
  1403.   ULen: Word;
  1404.   c, i: Word;
  1405.   ack_pkt: TRawPkt;
  1406.   chunks: array[0..49] of Byte;
  1407.   Msg, UIN: String;
  1408.   MsgType: Word;
  1409.   Desc, URL: String;
  1410.   v: Byte;
  1411.   atype: String;
  1412.   XML: String;
  1413.   XMLTime, XMLSource, XMLSender, XMLText: String;
  1414.   FName, FDesc: String;
  1415.   FSize: LongWord;
  1416.   FFSeq: Word;
  1417.   Rec: TFTRequestRec;
  1418.   TCMD: String;
  1419.   List: TStringList;
  1420. begin
  1421.   ITime := GetInt(Pkt, 4);                      //Time
  1422.   IRandomID := GetInt(Pkt, 2);                  //RandomID
  1423.   Inc(Pkt^.Len, 2);                             //Unknown: empty
  1424.   Msg := '';
  1425.   {Subtypes}
  1426.   case GetInt(Pkt, 2) of
  1427.     1:                                          //Simply(old-type) message
  1428.     begin
  1429.       UIN := GetStr(Pkt, GetInt(Pkt, 1));
  1430.       Inc(Pkt^.Len, 2);
  1431.       c := GetInt(Pkt, 2);                      //A count of the number of following TLVs.
  1432.       for i := 0 to c - 1 do                    //Skip all TLVs
  1433.       begin
  1434.         Inc(Pkt^.Len, 2);
  1435.         Inc(Pkt^.Len, GetInt(Pkt, 2));
  1436.       end;
  1437.       if GetInt(Pkt, 2) = 2 then                //TLV with message remain
  1438.       begin
  1439.         Inc(Pkt^.Len, 4);                       //TLV length + Unknown const
  1440.         Inc(Pkt^.Len, GetInt(Pkt, 2));          //Counts of following bytes + following bytes
  1441.         Inc(Pkt^.Len, 2);                       //x0101, Unknown, constant
  1442.         ULen := GetInt(Pkt, 2) - 4;             //Length of the message + 4
  1443.         Inc(Pkt^.Len, 4);                       //Unknown seems to be constant
  1444.         Msg := GetStr(Pkt, ULen);               //The actual message text. There will be no ending NULL.
  1445.         if (Length(Msg) > 0) and Assigned(OnMessageRecv) then
  1446.           FOnMsg(Self, Msg, UIN);
  1447.       end;
  1448.     end;
  1449.     2:                                          //Adnavced(new-type)
  1450.     begin
  1451.       UIN := GetStr(Pkt, GetInt(Pkt, 1));
  1452.       for c := 0 to 5 do
  1453.       begin
  1454.         if GetInt(Pkt, 2) = 5 then
  1455.         begin
  1456.           Inc(Pkt^.Len, 2);
  1457.           if GetInt(Pkt, 2) <> 0 then           //ACKTYPE: 0x0000 - This is a normal message
  1458.             Exit;
  1459.           Inc(Pkt^.Len, 16);                    //File signature
  1460.           Inc(Pkt^.Len, 8);                     //TIME + RANDOM
  1461.           for i := 0 to 5 do
  1462.           begin
  1463.             if GetInt(Pkt, 2) = $2711 then      //Searching for TLV(2711) (with sources)
  1464.             begin
  1465.               Inc(Pkt^.Len, 2);                 //TLV Length
  1466.               Move(Ptr(LongWord(Pkt) + Pkt^.Len)^, chunks, 47);
  1467.               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.
  1468.                 Exit;
  1469.               Inc(Pkt^.Len, 26);
  1470.               FFSeq := GetInt(Pkt, 2);
  1471.               Inc(Pkt^.Len, 16);
  1472.               MsgType := GetInt(Pkt, 1);
  1473.               Inc(Pkt^.Len, 5);
  1474.               if MsgType = M_FILE then          //File request
  1475.               begin
  1476.                 FDesc := GetLNTS(Pkt);          //File description
  1477.                 Inc(Pkt^.Len, 4);               //Unknown: 00 00 00 00
  1478.                 FName := GetLNTS(Pkt);          //File name
  1479.                 FSize := GetLInt(Pkt, 4);       //File size
  1481.                 {Set the records' items}
  1482.                 Rec.ITime := ITime;
  1483.                 Rec.IRandomID := IRandomID;
  1484.                 Rec.UIN := StrToInt(UIN);
  1485.                 Rec.FileSize := FSize;
  1486.                 Rec.Description := FDesc;
  1487.                 Rec.FileName := FName;
  1488.                 Rec.Seq := FFSeq;
  1489.                 Rec.ReqType := $01;
  1490.                 if Assigned(OnFTRequest) then
  1491.                   FOnFTRequest(Self, Rec);
  1492.                 Exit;
  1493.               end else
  1494.               if MsgType = M_ADVANCED then      //Advanced message container
  1495.               begin
  1496.                 GetLNTS(Pkt);                   //Empty message (contains only a null terminator)
  1497.                 Inc(Pkt^.Len, 2);               //Following length
  1498.                 Inc(Pkt^.Len, 16);              //Signature
  1499.                 Inc(Pkt^.Len, 2);               //Unknown: empty
  1500.                 TCMD := GetDWStr(Pkt);          //Text command
  1501.                 if TCMD = 'Contacts' then
  1502.                 begin
  1503.                   Inc(Pkt^.Len, 4);             //Following length
  1504.                   Msg := GetDWStr(Pkt);         //Message containing a list with contacts
  1505.                   List := TStringList.Create;   //Create temporary list
  1506.                   ParseContacts(Msg, List);     //Parse message with contacts
  1507.                   if Assigned(OnContactListRecv) then
  1508.                     FOnContactListRecv(Self, UIN, List);
  1509.                 end else
  1510.                 if TCMD = 'Request For Contacts' then
  1511.                 begin
  1512.                   Inc(Pkt^.Len, 15);            //15 unknown bytes
  1513.                   Inc(Pkt^.Len, 4);             //Following length
  1514.                   Msg := GetDWStr(Pkt);         //Message containing a reason
  1515.                   if Assigned(OnContactListRequest) then
  1516.                     FOnContactListReq(Self, UIN, Msg);
  1517.                 end;
  1518.               end
  1519.               else
  1520.                 Msg := GetLNTS(Pkt);            //The actual message text. There will be ending NULL.
  1522.               {Sending ACK of the message}
  1523.               PktInit(@ack_pkt, 2, FSeq);               //Channel 2
  1524.               PktSnac(@ack_pkt, $04, $0B, 0, 0);        //SNAC(x04/x0B)
  1525.               Move(Ptr(LongWord(Pkt) + TSNACSZ)^, Ptr(LongWord(@ack_pkt) + ack_pkt.Len)^, 10); //First 10 bytes of TLV(2711)
  1526.               Inc(ack_pkt.Len, 10);                     //Skip first 10 bytes copied from TLV(2711) which were added before
  1527.               PktLStr(@ack_pkt, UIN);                   //User's UIN
  1528.               PktInt(@ack_pkt, $0003, 2);               //00 03
  1529.               PktAddArrBuf(@ack_pkt, @chunks, 47);      //First 47 bytes of source packet (with message)
  1530.               PktInt(@ack_pkt, $00000000, 4);           //00 00 00 00
  1531.               //If it's an auto-away message request
  1532.               if MsgType and $E0 = $E0 then
  1533.                 PktLNTS(@ack_pkt, FAutoAwayMsg)         //Auto-away message
  1534.               else begin
  1535.                 PktInt(@ack_pkt, 1, 1);                 //01
  1536.                 PktInt(@ack_pkt, 0, 4);                 //00 00 00 00
  1537.                 PktInt(@ack_pkt, 0, 2);                 //00 00
  1538.                 PktInt(@ack_pkt, $FFFFFF00, 4);         //FF FF FF 00
  1539.               end;
  1540.               PktFinal(@ack_pkt);
  1541.               FSock.SendData(ack_pkt, ack_pkt.Len);
  1543.               if (Length(Msg) > 0) then
  1544.               begin
  1545.                 if MsgType = M_PLAIN then
  1546.                 begin
  1547.                   if FDoPlain then Msg := Rtf2Txt(Msg);   //Convert message from RTF to plaintext when needed
  1548.                   if Assigned(OnMessageRecv) then
  1549.                     FOnMsg(Self, Msg, UIN)
  1550.                 end else
  1551.                 if MsgType = M_URL then
  1552.                 begin
  1553.                   Desc := Copy(Msg, 0, Pos(#$fe, Msg) - 1);
  1554.                   URL := Copy(Msg, Pos(#$fe, Msg) + 1, Length(Msg) - Pos(#$fe, Msg));
  1555.                   if Assigned(OnURLRecv) then
  1556.                     FOnURL(Self, Desc, URL, UIN);
  1557.                 end;
  1558.               end;
  1559.               Exit;
  1560.             end else
  1561.               Inc(Pkt^.Len, GetInt(Pkt, 2));
  1562.           end;
  1563.         end else
  1564.           Inc(Pkt^.Len, GetInt(Pkt, 2));
  1565.       end;
  1566.     end;
  1567.     4:                                                  //Another message type
  1568.     begin
  1569.       UIN := GetLStr(Pkt);
  1570.       for i := 0 to 4 do
  1571.       begin
  1572.         v := GetInt(Pkt, 1);
  1573.         if (v = 5) or ((GetInt(Pkt, 1) = 5) and (v = 0)) then    //TLV(5) was found
  1574.         begin
  1575.           if v = 5 then                                 //Some modifications for MAC clients
  1576.             Inc(Pkt^.Len, 40)
  1577.           else
  1578.             Inc(Pkt^.Len, 2);
  1579.           GetLInt(Pkt, 4);                              //UIN
  1580.           MsgType := GetLInt(Pkt, 2);                   //Message-type
  1581.           Msg := GetLNTS(Pkt);                          //Message
  1582.           if MsgType = $1a then                         //Probably advanced msg format
  1583.           begin
  1584.             Inc(Pkt^.Len, 20);                          //20 unknown bytes
  1585.             atype := GetDWStr(Pkt);                     //Advanced msg sub-type
  1586.             if atype = 'ICQSMS' then                    //Corresponds to received SMS message in XML formatted message
  1587.             begin
  1588.               Inc(Pkt^.Len, 3);                         //00 00 00
  1589.               Inc(Pkt^.Len, 4);                         //4-byte little endian length of the following data
  1590.               XML := GetStr(Pkt, GetLInt(Pkt, 4));      //XML entry of SMS response
  1591.               XMLSource := GetXMLEntry('source', XML);  //Source, usually: 'ICQ'
  1592.               XMLSender := GetXMLEntry('sender', XML);  //Source cellular number
  1593.               XMLText := GetXMLEntry('text', XML);      //Text of reply
  1594.               XMLTime := GetXMLEntry('time', XML);      //Time of sending reply
  1595.               if Assigned(OnSMSReply) then
  1596.                 FOnSMSReply(Self, XMLSource, XMLSender, XMLTime, UTF8ToStrSmart(XMLText));
  1597.             end;
  1598.             Exit;
  1599.           end;
  1601.           if (Length(Msg) > 0) then
  1602.           begin
  1603.             if MsgType = M_PLAIN then
  1604.             begin
  1605.               if FDoPlain then Msg := Rtf2Txt(Msg);     //Convert message from RTF to plaintext when needed
  1606.               if Assigned(OnMessageRecv) then
  1607.                 FOnMsg(Self, Msg, UIN)
  1608.             end
  1609.             else if MsgType = M_URL then
  1610.             begin
  1611.               Desc := Copy(Msg, 0, Pos(#$fe, Msg) - 1);
  1612.               URL := Copy(Msg, Pos(#$fe, Msg) + 1, Length(Msg) - Pos(#$fe, Msg));
  1613.               if Assigned(OnURLRecv) then
  1614.                 FOnURL(Self, Desc, URL, UIN);
  1615.             end;
  1616.           end;
  1617.           Exit;
  1618.         end else
  1619.           Inc(Pkt^.Len, GetInt(Pkt, 2));
  1620.       end;
  1621.     end;
  1622.   end;
  1623. end;
  1625. {Handling old type packets ICQ_FROMSRV}
  1626. procedure TICQClient.HSnac1503(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  1627. var
  1628.   FMsgType: Word;
  1629.   lpkt: TRawPkt;
  1630.   FNick, FFirst, FLast, FEmail, FCity,
  1631.   FState, FPhone, FFax, FStreet, FCellular,
  1632.   FZip, FCountry, FCompany, FDepartment,
  1633.   FPosition, FOccupation, FHomePage,
  1634.   FLang1, FLang2, FLang3, FAbout: String;
  1635.   FTimeZone: Byte;
  1636.   FPublishEmail: Boolean;
  1637.   FAge, FYear: Word;
  1638.   FGender, FMonth, FDay: Byte;
  1639.   Msg, UIN, URL, Desc: String;
  1640.   List, List2: TStringList;
  1641.   C, i: Byte;
  1642.   WW: Word;
  1643.   FStatus: Word;
  1644.   cmd: Word;
  1645.   seq: Word;
  1646.   FSmsSource, FSmsDeliverable, FSmsNetwork, FMsgId: String;
  1647.   FAuthorize: Byte;
  1648. begin
  1649.   if GetInt(Pkt, 2) = 1 then                      //TLV(1)
  1650.   begin
  1651.     Inc(Pkt^.Len, 8);
  1652.     case GetInt(Pkt, 2) of
  1653.       $4100:                                      //SRV_OFFLINEMSG
  1654.       begin
  1655.         Inc(Pkt^.Len, 2);                         //The sequence number this packet is a response to.
  1656.         UIN := IntToStr(GetLInt(Pkt, 4));         //Source UIN
  1657.         Inc(Pkt^.Len, 6);                         //Date/time etc...
  1658.         FMsgType := GetLInt(Pkt, 2);              //The type of message sent, like URL message or the like.
  1659.         Msg := GetLNTS(Pkt);
  1660.         if FDoPlain then Msg := Rtf2Txt(Msg);     //Convert message from RTF to plaintext when needed
  1661.         if FMsgType = M_PLAIN then
  1662.         begin
  1663.           if Assigned(OnOfflineMsgRecv) then
  1664.             FOnOffMsg(Self, Msg, UIN);
  1665.         end else
  1666.         if FMsgType = M_URL then
  1667.         begin
  1668.           Desc := Copy(Msg, 0, Pos(#$fe, Msg) - 1);
  1669.           URL := Copy(Msg, Pos(#$fe, Msg) + 1, Length(Msg) - Pos(#$fe, Msg));
  1670.           if Assigned(OnOfflineURLRecv) then
  1671.             FOnOffURL(Self, Desc, URL, UIN);
  1672.         end;
  1673.       end;
  1674.       $4200: //All offline messages were sent, so we ACKING them
  1675.       begin
  1676.         FSeq2 := 2;
  1677.         CreateCLI_ACKOFFLINEMSGS(@lpkt, FLUIN, FSeq, FSeq2);
  1678.         FSock.SendData(lpkt, lpkt.Len);
  1679.       end;
  1680.       $da07: //SRV_META
  1681.       begin
  1682.         seq := GetLInt(Pkt, 2);
  1683.         cmd := GetInt(Pkt, 2);
  1684.         case cmd of
  1685.           $0100: //SRV_SMSREFUSED
  1686.           begin
  1687.             if Assigned(OnSMSRefused) then
  1688.               FOnSMSRefused(Self);
  1689.           end;
  1690.           $9600: //SRV_SMSACK
  1691.           begin
  1692.             if GetInt(Pkt, 1) <> $0a then Exit;
  1693.             Inc(Pkt^.Len, 12);
  1694.             Msg := GetStr(Pkt, GetLInt(Pkt, 2));
  1695.             FSmsSource := GetXMLEntry('source', Msg);
  1696.             FSmsDeliverable := GetXMLEntry('deliverable', Msg);
  1697.             FSmsNetwork := GetXMLEntry('network', Msg);
  1698.             FMsgId := GetXMLEntry('message_id', Msg);
  1699.             if Assigned(OnSMSAck) then
  1700.               FOnSMSAck(Self, FSmsSource, FSmsNetwork, FMsgId, FSmsDeliverable = 'Yes');
  1701.           end;
  1702.           $b400: //SRV_METAUNREG_BADPASS Channel: 2, Snac(0x15, 0x03) 2010/180
  1703.           begin
  1704.             case GetInt(Pkt, 1) of
  1705.               $0a:
  1706.               begin
  1707.                 if Assigned(OnUnregisterOk) then
  1708.                   FOnUnregisterOk(Self);
  1709.                 CreateCLI_GOODBYE(@lpkt, FSeq);     //Send CLI_GOODBYE, it forces server to disconnect us
  1710.                 FSock.SendData(lpkt, lpkt.Len);
  1711.               end;
  1712.               $14: if Assigned(OnUnregisterBadPassword) then
  1713.                 FOnUnregBadPass(Self);
  1714.             end;
  1715.           end;
  1716.           $c800: //SRV_METAGENERAL Channel: 2, SNAC(0x15,0x03) 2010/200
  1717.           begin
  1718.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];          
  1719.             if GetInt(Pkt, 1) <> $0a then Exit;
  1720.             FNick := GetLNTS(Pkt);
  1721.             FFirst := GetLNTS(Pkt);
  1722.             FLast := GetLNTS(Pkt);
  1723.             FEmail := GetLNTS(Pkt);
  1724.             FCity := GetLNTS(Pkt);
  1725.             FState := GetLNTS(Pkt);
  1726.             FPhone := GetLNTS(Pkt);
  1727.             FFax := GetLNTS(Pkt);
  1728.             FStreet := GetLNTS(Pkt);
  1729.             FCellular := GetLNTS(Pkt);
  1730.             FZip := GetLNTS(Pkt);
  1731.             FCountry := CountryToStr(GetLInt(Pkt, 2));
  1732.             FTimeZone := GetInt(Pkt, 1);
  1733.             if GetInt(Pkt, 1) = 1 then
  1734.               FPublishEmail := True
  1735.             else
  1736.               FPublishEmail := False;
  1737.             if Assigned(OnUserGeneralInfo) then
  1738.               FOnUserGeneralInfo(Self, FLastInfoUin, FNick, FFirst,
  1739.                 FLast, FEmail, FCity, FState, FPhone,
  1740.                 FFax, FStreet, FCellular, FZip, FCountry,
  1741.                 FTimeZone, FPublishEmail
  1742.               );
  1743.           end;
  1744.           $d200: //SRV_METAWORK Channel: 2, SNAC(0x15,0x3) 2010/210
  1745.           begin
  1746.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];
  1747.             if GetInt(Pkt, 1) <> $0a then Exit;
  1748.             FCity := GetLNTS(Pkt);
  1749.             FState := GetLNTS(Pkt);
  1750.             FPhone := GetLNTS(Pkt);
  1751.             FFax := GetLNTS(Pkt);
  1752.             FStreet := GetLNTS(Pkt);
  1753.             FZip := GetLNTS(Pkt);
  1754.             FCountry := CountryToStr(GetLInt(Pkt, 2));
  1755.             FCompany := GetLNTS(Pkt);
  1756.             FDepartment := GetLNTS(Pkt);
  1757.             FPosition := GetLNTS(Pkt);
  1758.             FOccupation := OccupationToStr(GetLInt(Pkt, 2));
  1759.             FHomePage := GetLNTS(Pkt);
  1760.             if Assigned(OnUserWorkInfo) then
  1761.               FOnUserWorkInfo(Self, FLastInfoUin, FCity, FState, FPhone,
  1762.                 FFax, FStreet, FZip, FCountry, FCompany, FDepartment, FPosition,
  1763.                 FOccupation, FHomePage
  1764.               );
  1765.           end;
  1766.           $dc00: //SRV_METAMORE Channel: 2, SNAC(0x15,0x3) 2010/220
  1767.           begin
  1768.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];
  1769.             if GetInt(Pkt, 1) <> $0a then Exit;
  1770.             FAge := GetLInt(Pkt, 2);
  1771.             if Integer(FAge) < 0 then
  1772.               FAge := 0;
  1773.             FGender := GetInt(Pkt, 1);
  1774.             FHomePage := GetLNTS(Pkt);
  1775.             FYear := GetLInt(Pkt, 2);
  1776.             FMonth := GetInt(Pkt, 1);
  1777.             FDay := GetInt(Pkt, 1);
  1778.             FLang1 := LanguageToStr(GetInt(Pkt, 1));
  1779.             FLang2 := LanguageToStr(GetInt(Pkt, 1));
  1780.             FLang3 := LanguageToStr(GetInt(Pkt, 1));
  1781.             if Assigned(OnUserInfoMore) then
  1782.               FOnUserInfoMore(Self, FLastInfoUin, FAge, FGender, FHomePage,
  1783.                 FYear, FMonth, FDay, FLang1, FLang2, FLang3
  1784.               );
  1785.           end;
  1786.           $e600: //Channel: 2, SNAC(0x15,0x3) 2010/230
  1787.           begin
  1788.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];
  1789.             if GetInt(Pkt, 1) <> $0a then Exit;
  1790.             FAbout := GetLNTS(Pkt);
  1791.             if Assigned(OnUserInfoAbout) then
  1792.               FOnUserInfoAbout(Self, FLastInfoUin, FAbout);
  1793.           end;
  1794.           $eb00: //Channel: 2, SNAC(21,3) 2010/235
  1795.           begin
  1796.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];
  1797.             if GetInt(Pkt, 1) <> $0a then Exit;
  1798.             c := GetInt(Pkt, 1);        //The number of email addresses to follow. May be zero. Each consist of the following parameters:
  1799.             List := TStringList.Create;
  1800.             if c > 0 then
  1801.               for i := 0 to c - 1 do
  1802.               begin
  1803.                 GetInt(Pkt, 1); //Publish email address? 1 = yes, 0 = no.
  1804.                 List.Add(GetLNTS(Pkt)); //The email address.
  1805.               end;
  1806.             if Assigned(OnUserInfoMoreEmails) then
  1807.               FOnUserInfoMoreEmails(Self, FLastInfoUin, List)
  1808.             else
  1809.               List.Free;
  1810.           end;
  1811.           $f000: //Channel: 2, SNAC(21,3) 2010/240
  1812.           begin
  1813.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];
  1814.             if GetInt(Pkt, 1) <> $0a then Exit;
  1815.             c := GetInt(Pkt, 1);
  1816.             List := TStringList.Create;
  1817.             if c > 0 then
  1818.               for i := 0 to c - 1 do
  1819.               begin
  1820.                 WW := GetLInt(Pkt, 2);
  1821.                 List.Add(InterestToStr(WW) + '=' + GetLNTS(Pkt))
  1822.               end;
  1823.             if Assigned(OnUserInfoInterests) then
  1824.               FOnUserInfoInterests(Self, FLastInfoUin, List)
  1825.             else
  1826.               List.Free;
  1827.           end;
  1828.           $a401, $ae01: //SRV_METAFOUND Channel: 2, SNAC(21,3) 2010/420 or Channel: 2, SNAC(21,3) 2010/430
  1829.           begin
  1830.             if GetInt(Pkt, 1) <> $0a then
  1831.             begin
  1832.               if Assigned(OnUserNotFound) then
  1833.                 FOnUserNotFound(Self);
  1834.               Exit;
  1835.             end;
  1836.             Inc(Pkt^.Len, 2);                   //Length of the following data.
  1837.             UIN := IntToStr(GetLInt(Pkt, 4));   //The user's UIN.
  1838.             FNick := GetLNTS(Pkt);              //The user's nick name.
  1839.             FFirst := GetLNTS(Pkt);             //The user's first name.
  1840.             FLast := GetLNTS(Pkt);              //The user's last name.
  1841.             FEmail := GetLNTS(Pkt);             //The user's email address.
  1842.             FAuthorize := GetInt(Pkt, 1);       //Authorize: 1 = no, 0 = yes.
  1843.             FStatus := GetLInt(Pkt, 2);         //0 = Offline, 1 = Online, 2 = not Webaware.
  1844.             FGender := GetInt(Pkt, 1);          //The user's gender. 1 = female, 2 = male, 0 = not specified.
  1845.             FAge := GetInt(Pkt, 1);             //The user's age.
  1846.             if Assigned(OnUserFound) then
  1847.               FOnUserFound(Self, UIN, FNick, FFirst, FLast, FEmail, FStatus, FGender, FAge, cmd = $ae01, FAuthorize = $00);
  1848.           end;
  1849.           $6603:
  1850.           begin
  1851.             if GetInt(Pkt, 1) <> $0a then
  1852.             begin
  1853.               if Assigned(OnUserNotFound) then
  1854.                 FOnUserNotFound(Self);
  1855.               Exit;
  1856.             end;
  1857.             UIN := IntToStr(GetLInt(Pkt, 4));   //The user's UIN.
  1858.             if Assigned(OnUserFound) then
  1859.               FOnUserFound(Self, UIN, '', '', '', '', 0, 0, 0, True, False);
  1860.           end;
  1861.           $fa00:
  1862.           begin
  1863.             FLastInfoUin := FInfoChain.Values[IntToStr(seq)];          
  1864.             if GetInt(Pkt, 1) <> $0a then Exit;
  1865.             List := TStringList.Create;
  1866.             List2 := TStringList.Create;
  1867.             c := GetInt(Pkt, 1);                             //The number of background items to follow. May be zero. Each background item consists of the following two parameters
  1868.             if c > 0 then
  1869.               for i := 0 to c - 1 do
  1870.               begin
  1871.                 WW := GetLInt(Pkt, 2);                       //The group this background is in, according to a table.
  1872.                 if WW >= 8191 then Exit;
  1873.                 List.Add(PastToStr(WW) + '=' + GetLNTS(Pkt)) //A longer description of this background item.
  1874.               end;
  1875.             c := GetInt(Pkt, 1);                             //The number of affiliations to follow. May be zero. Each affiliation consists of the following parameters:
  1876.             if c > 0 then
  1877.               for i := 0 to c - 1 do
  1878.               begin
  1879.                 WW := GetLInt(Pkt, 2);                       //The group this affiliation is in, according to a table.
  1880.                 if WW >= 8191 then Exit;
  1881.                 List2.Add(AffiliationToStr(WW) + '=' + GetLNTS(Pkt)) //A longer description of the affiliation.
  1882.               end;
  1883.             if Assigned(OnUserInfoBackground) then
  1884.               FOnUserInfoBackground(Self, FLastInfoUin, List, List2)
  1885.             else begin
  1886.               List.Free;
  1887.               List2.Free;
  1888.             end;
  1889.           end;
  1890.           $0401: //SRV_METAINFO Channel: 2, SNAC(21,3) 2010/260
  1891.           begin
  1892.             FLastSInfoUin := FSInfoChain.Values[IntToStr(seq)];
  1893.             if FSInfoChain.IndexOfName(IntToStr(seq)) >= 0 then
  1894.               FSInfoChain.Delete(FSInfoChain.IndexOfName(IntToStr(seq)));
  1895.             if GetInt(Pkt, 1) <> $0a then
  1896.             begin
  1897.               if Assigned(OnUserInfoShort) then
  1898.                 FOnUserInfoShort(Self, FLastSInfoUIN, '', '', '', '', False, False);
  1899.               Exit;
  1900.             end else
  1901.             begin
  1902.               FNick := GetLNTS(Pkt);            //Nickname
  1903.               FFirst := GetLNTS(Pkt);           //Firstname
  1904.               FLast := GetLNTS(Pkt);            //Lastname
  1905.               FEmail := GetLNTS(Pkt);           //Email
  1906.               if Assigned(OnUserInfoShort) then
  1907.                 FOnUserInfoShort(Self, FLastSInfoUIN, FNick, FFirst, FLast, FEmail, True, GetInt(Pkt, 1) <> $01);
  1908.             end;
  1909.           end;
  1910.           $aa00:
  1911.             if Assigned(OnInfoChanged) then
  1912.               FOnInfoChanged(Self, INFO_PASSWORD, GetInt(Pkt, 1) = $0a);
  1913.           $6400: //SRV_METAGENERALDONE Channel: 2, SNAC(21,3) 2010/100
  1914.             if Assigned(OnInfoChanged) then
  1915.               FOnInfoChanged(Self, INFO_GENERAL, GetInt(Pkt, 1) = $0a);
  1916.           $7800: //SRV_METAMOREDONE Channel: 2, SNAC(21,3) 2010/120
  1917.             if Assigned(OnInfoChanged) then
  1918.               FOnInfoChanged(Self, INFO_MORE, GetInt(Pkt, 1) = $0a);
  1919.           $8200: //SRV_METAABOUTDONE Channel: 2, SNAC(21,3) 2010/130
  1920.             if Assigned(OnInfoChanged) then
  1921.               FOnInfoChanged(Self, INFO_ABOUT, GetInt(Pkt, 1) = $0a);
  1922.           $a000: //SRV_AUTHSET Channel: 2, SNAC(21, 3) 2010/160
  1923.             if Assigned(OnAuthorizationChangedOk) then
  1924.               FOnAuthSet(Self);
  1925.         end;
  1926.       end;
  1927.     end;
  1928.   end;
  1929. end;
  1931. {Handling packet with status changes}
  1932. {$WARNINGS OFF}
  1933. procedure TICQClient.HSnac030B(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  1934.   function NumToIp(Addr: LongWord): String;
  1935.   var
  1936.     inaddr: in_addr;
  1937.   begin
  1938.     inaddr.S_addr := Addr;
  1939.     Result := inet_ntoa(inaddr);
  1940.   end;
  1941. var
  1942.   c, i: Word;
  1943.   UIN: String;
  1944.   Status: LongWord;
  1945.   FIntIP, FExtIP: LongWord;
  1946.   FIntPort: Word;
  1947.   FConnFlag: Byte;
  1948.   FDconCookie: LongWord;
  1949.   FProtoVer: Word;
  1950. begin
  1951.   UIN := GetStr(Pkt, GetInt(Pkt, 1));
  1952.   Inc(Pkt^.Len, 2);
  1953.   c := GetInt(Pkt, 2);
  1954.   if c < 1 then Exit;
  1955.   for i := 0 to c - 1 do
  1956.   begin
  1957.     case GetInt(Pkt, 2) of
  1958.     $0c:
  1959.     begin
  1960.       Inc(Pkt^.Len, 2);                 //TLV's Length
  1961.       FIntIP := GetLInt(Pkt, 4);        //Internal IP
  1962.       FIntPort := GetInt(Pkt, 4);       //Internal port
  1963.       FConnFlag := GetInt(Pkt, 1);      //Connection flag
  1964.       FProtoVer := GetInt(Pkt, 2);      //Protocol version
  1965.       FDconCookie := GetLInt(Pkt, 4);   //Direct connection cookie
  1966.       Inc(Pkt^.Len, 22);                //Skip remaining data
  1967.     end;
  1968.     $0a:
  1969.     begin
  1970.       Inc(Pkt^.Len, 2);                 //TLV's Length
  1971.       FExtIP := GetLInt(Pkt, 4);        //External IP
  1972.       if (FConnFlag = $04) or (FConnFlag = $02) then
  1973.       begin
  1974.         if FDirect <> nil then
  1975.           FDirect.AddUser(StrToInt(UIN), FDConCookie, FExtIP, FIntIP, FIntPort);
  1976.       end else
  1977.         OnIntError(nil, ERR_WARNING, 'Cannot estabilish direct connection because remote client uses unknown proxy type');
  1978.     end;
  1979.     $06:
  1980.     begin
  1981.       Inc(Pkt^.Len, 2);                 //TLV's Length
  1982.       Status := GetInt(Pkt, 4);         //Online status
  1983.       if (not DisableDirectConnections) and (FDirect <> nil) then
  1984.         FDirect.EstabilishConnection(StrToInt(UIN));
  1985.       if Assigned(OnStatusChange) then
  1986.         FOnStatusChange(Self, UIN, Status);
  1987.       if Assigned(OnOnlineInfo) then
  1988.         FOnOnlineInfo(Self, UIN, FIntPort, NumToIp(FIntIP), NumToIp(FExtIP), FProtoVer);
  1989.       Exit;
  1990.     end else
  1991.       Inc(Pkt^.Len, GetInt(Pkt, 2));
  1992.     end;
  1993.   end;
  1994. end;
  1995. {$WARNINGS ON}
  1997. {Handling AddedYou packet}
  1998. procedure TICQClient.HSnac131C(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  1999. var
  2000.   T: Word;
  2001.   UIN: String;
  2002. begin
  2003.   Inc(Pkt^.Len, 2);
  2004.   GetTLVInt(Pkt, T);
  2005.   if T <> 1 then Exit;
  2006.   UIN := GetLStr(Pkt);
  2007.   if Assigned(OnAddedYou) then
  2008.     FOnAddedYou(Self, UIN);
  2009. end;
  2011. {Authorization request, we are automaticly authorizing the user}
  2012. procedure TICQClient.HSnac1319(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2013. var
  2014.   FUin: String;
  2015.   FReason: String;
  2016.   opkt: TRawPkt;
  2017. begin
  2018.   Inc(Pkt^.Len, 8);
  2019.   FUin := GetLStr(Pkt);
  2020.   FReason := GetStr(Pkt, Swap16(GetInt(Pkt, 2)));
  2021.   CreateCLI_AUTHORIZE(@opkt, StrToInt(FUin), 1, '', FSeq);
  2022.   FSock.SendData(opkt, opkt.Len);
  2023. end;
  2025. {This packet contains your complete server side contact list.}
  2026. procedure TICQClient.HSnac1306(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2027. var
  2028.   GroupIdents: TStringList;
  2029.   UINList: TList;
  2030.   procedure ReadChunk;
  2031.   var
  2032.     Len: Word;
  2033.     FGroup: ShortString;
  2034.     CTag, CId, CType: Word;
  2035.     TLen: Word;
  2036.     TType: Word;
  2037.     FNick: ShortString;
  2038.     lpEntry: PUINEntry;
  2039.   begin
  2040.     FGroup := GetWStr(Pkt);             //The name of the group.
  2041.     CTag := GetInt(Pkt, 2);             //This field seems to be a tag or marker associating different groups together into a larger group such as the Ignore List or 'General' contact list group, etc.
  2042.     CId := GetInt(Pkt, 2);              //This is a random number generated when the user is added to the contact list, or when the user is ignored.
  2043.     CType := GetInt(Pkt, 2);            //This field seems to indicate what type of group this is.
  2044.     Len := GetInt(Pkt, 2);              //The length in bytes of the following TLVs.
  2045.     FNick := '';
  2046.     while Integer(Len) > 0 do
  2047.     begin
  2048.       TType := GetInt(Pkt, 2);          //TLV Type
  2049.       TLen := GetInt(Pkt, 2);           //TLV Len
  2050.       if TType = $0131 then
  2051.         FNick := UTF8ToStrSmart(GetStr(Pkt, TLen))
  2052.       else
  2053.         Inc(Pkt^.Len, TLen);            //Skip this TLV
  2054.       Dec(len, TLen + 4);               //TLV length + 2 bytes type + 2 bytes length
  2055.     end;
  2057.     //Group header
  2058.     if (FGroup <> '') and (CType = 1) and (CTag <> 0) and (CId = 0) then
  2059.       GroupIdents.Values[IntToStr(CTag)] := UTF8ToStrSmart(FGroup);
  2061.     //UIN entry
  2062.     if (CType = 0) or (CType = 2) or (CType = 3) or (CType = $e) then
  2063.     begin
  2064.       GetMem(lpEntry, SizeOf(lpEntry^));
  2065.       lpEntry^.UIN := StrToInt(FGroup);
  2066.       lpEntry^.Nick := FNick;
  2067.       lpEntry^.CType := CType;
  2068.       lpEntry^.CTag := CId;
  2069.       lpEntry^.CGroupID := CTag;
  2070.       UINList.Add(lpEntry);
  2071.     end;
  2072.   end;
  2073. var
  2074.   count, T: Word;
  2075.   i: Word;
  2076. begin
  2077.   GetTLVInt(Pkt, T); if T <> 6 then Exit;
  2078.   Inc(Pkt^.Len, 4);                     //02 00 02 00 - UNKNOWNs
  2079.   count := GetInt(Pkt, 2);              //Total count of following groups. This is the size of the server side contact list and should be saved and sent with CLI_CHECKROSTER.
  2080.   if count < 1 then Exit;
  2081.   GroupIdents := TStringList.Create;
  2082.   UINList := TList.Create;
  2083.   for i := 0 to count - 1 do
  2084.     ReadChunk;
  2086.   if UINList.Count > 0 then
  2087.     for i := 0 to UINList.Count - 1 do
  2088.       PUINEntry(UINList.Items[i])^.CGroup := GroupIdents.Values[IntToStr(PUINEntry(UINList.Items[i])^.CGroupID)];
  2089.   GroupIdents.Free;
  2091.   if Assigned(OnServerListRecv) then
  2092.     FOnServerListRecv(Self, UINList)
  2093.   else
  2094.     DestroyUINList(UINList);
  2095. end;
  2097. {This packet contains ack to message you've sent.}
  2098. procedure TICQClient.HSnac040b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2099. var
  2100.   RetCode: Word;
  2101.   RetAcc: Byte;
  2102.   RetMsg: String;
  2103.   MsgType: Byte;
  2104.   FUIN: String;
  2105. begin
  2106.   Inc(Pkt^.Len, 4);                     //Time
  2107.   RetCode := GetInt(Pkt, 2);            //Random ID
  2108.   Inc(Pkt^.Len, 4);                     //Other data :)
  2109.   FUIN := GetLStr(Pkt);                 //User's UIN
  2110.   Inc(Pkt^.Len, 2);                     //00 03
  2111.   Inc(Pkt^.Len, 45);                    //Skip 50 bytes of packet
  2112.   MsgType := GetInt(Pkt, 1);            //Msg-type
  2113.   Inc(Pkt^.Len, 1);                     //Msg-flags
  2114.   RetAcc := GetInt(Pkt, 1);             //Accept type
  2115.   Inc(Pkt^.Len, 3);                     //Unknown
  2116.   if (RetAcc <> ACC_NORMAL) and (RetAcc <> ACC_NO_OCCUPIED) and
  2117.      (RetAcc <> ACC_NO_DND) and (RetAcc <> ACC_AWAY) and
  2118.      (RetAcc <> ACC_NA) and (RetAcc <> ACC_CONTACTLST) then Exit;
  2119.   if MsgType and $E0 = $E0 then
  2120.   begin
  2121.     RetMsg := GetLNTS(Pkt);
  2122.     if Assigned(OnAutoMsgResponse) then
  2123.       FOnAutoMsgResponse(Self, FUIN, RetCode, MsgType, RetMsg);
  2124.     Exit;
  2125.   end;
  2126.   if RetAcc <> ACC_NORMAL then
  2127.   begin
  2128.     RetMsg := GetLNTS(Pkt);
  2129.   end else
  2130.     RetMsg := '';
  2131.   if Assigned(OnAdvancedMsgAck) then
  2132.     FOnAdvMsgAck(Self, FUIN, RetCode, RetAcc, RetMsg);
  2133. end;
  2135. {This packet contains response with new UIN created.}
  2136. procedure TICQClient.HSnac1705(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2137. var
  2138.   UIN: String;
  2139. begin
  2140.   if GetInt(Pkt, 2) <> $01 then Exit;   //TLV(01)
  2141.   Inc(Pkt^.Len, 2);                     //TLV's length
  2142.   Inc(Pkt^.Len, 2);                     //The length of the following data in bytes.
  2143.   Inc(Pkt^.Len, 4);                     //Unknown: empty.
  2144.   Inc(Pkt^.Len, 4);                     //Unknown: 0x2d000300 = 754975488.
  2145.   Inc(Pkt^.Len, 4);                     //Your port number as the server sees it.
  2146.   Inc(Pkt^.Len, 4);                     //Your IP address as the server sees it.
  2147.   Inc(Pkt^.Len, 4);                     //Unknown: 0x4 = 4.
  2148.   Inc(Pkt^.Len, 4);                     //The same UNKNOWN2 as sent in CLI_REGISTERUSER.
  2149.   Inc(Pkt^.Len, 16);                    //16 empty bytes
  2150.   UIN := IntToStr(GetLInt(Pkt, 4));     //New UIN
  2151.   if Assigned(OnNewUINRegistered) then  //Call associated event
  2152.     FOnNewUINRegistered(Self, UIN);
  2153. end;
  2155. {This packet contains reponse to CLI_REQAUTH.}
  2156. procedure TICQClient.HSnac131b(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2157. var
  2158.   T: Word;
  2159.   UIN, Reason: String;
  2160.   Granted: Boolean;
  2161. begin
  2162.   Inc(Pkt^.Len, 2);                     //Unknown: 6.
  2163.   GetTLVInt(Pkt, T);                    //Unknown.
  2164.   UIN := GetLStr(Pkt);                  //The UIN that granted authorization.
  2165.   Granted := GetInt(Pkt, 1) = $01;      //00 - Rejected, 01 - Granted.
  2166.   Reason := GetWStr(Pkt);               //Reason, can be null.
  2167.   if Assigned(OnAuthResponse) then
  2168.     FOnAuthResponse(Self, UIN, Granted, Reason);
  2169. end;
  2171. {This command is sent as what is perhaps an acknowledgement reply to at least CLI_ADDBUDDY and CLI_UPDATEGROUP.}
  2172. procedure TICQClient.HSnac130e(Flap: TFlapHdr; Snac: TSnacHdr; Pkt: PRawPkt);
  2173. var
  2174.   T: Word;
  2175.   ErrCode: Word;
  2176. begin
  2177.   Inc(Pkt^.Len, 2);                     //Unknown: 6. Guess: The length in bytes of the following data.
  2178.   GetTLVInt(Pkt, T);                    //Unknown.
  2179.   ErrCode := GetInt(Pkt, 2);            //ErrorCode
  2180.   if (ErrCode <> ERRSSL_AUTH) and (ErrCode <> ERRSSL_NOERROR) and (ErrCode <> ERRSSL_NOTFOUND) and
  2181.      (ErrCode <> ERRSSL_EXISTS) then
  2182.     ErrCode := ERRSSL_OTHER;
  2183.   if Assigned(OnSSLChangeResponse) then
  2184.     FOnChangeResponse(Self, ErrCode);
  2185. end;
  2187. {Handle packet with message sent directly}
  2188. procedure TICQClient.HDirectMsg(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord);
  2189. var
  2190.   Msg: String;
  2191.   lpkt: TRawPkt;
  2192.   LSeq: Word;
  2193.   cmd, scmd: Word;
  2194.   S, Desc, URL: String;
  2195.   List: TStringList;
  2196.   FText: String;
  2197.   FileLen: LongWord;
  2198.   Port: Word;
  2199.   rec: TFTRequestRec;
  2200. begin
  2201.   if not DecryptPak(Ptr(LongWord(Pak) + 2), Pak^.Len - 2, 8) then Exit;
  2203.   Pak.Len := 2;
  2204.   if GetInt(Pak, 1) <> $02 then Exit;   //02 - PEER_MSG
  2205.   Inc(Pak^.Len, 4);                     //Packet checksum
  2206.   cmd := GetLInt(Pak, 2);               //Command
  2207.   Inc(Pak^.Len, 2);                     //Unknown: 0xe = 14.
  2208.   LSeq := GetLInt(Pak, 2);              //Sequence number.
  2209.   Inc(Pak^.Len, 12);                    //Unknown: 12 empty bytes
  2210.   scmd := GetLInt(Pak, 2);              //Sub command
  2211.   case cmd of
  2212.     $07ee:                              //2030 - normal message.
  2213.     begin
  2214.       if scmd = $0001 then              //Simple message
  2215.       begin
  2216.         Inc(Pak^.Len, 2);               //Unknown: empty.
  2217.         Inc(Pak^.Len, 2);               //Our status.
  2218.         Msg := GetLNTS(Pak);            //Finally the message.
  2219.         if Assigned(OnMessageRecv) then
  2220.           FOnMsg(Self, Msg, IntToStr(UIN));
  2221.       end else
  2222.       if scmd and $03e0 = $03e0 then    //Read auto-away message
  2223.       begin
  2224.         CreatePEER_AUTOMSG_ACK(@lpkt, FAutoAwayMsg, scmd, LSeq);        //Send ACK with auto msg reponse
  2225.         FDirect.SendData(UIN, @lpkt);
  2226.         Exit;                           //Do not send another ACK
  2227.       end else
  2228.       if scmd = $001a then              //Advanced message format
  2229.       begin
  2230.         Inc(Pak^.Len, 27);              //Skip 27 bytes of mostly unknown data
  2231.         S := GetStr(Pak, GetLInt(Pak, 4));
  2232.         if S = 'Contacts' then          //Receive contacts
  2233.         begin
  2234.           Inc(Pak^.Len, 19);            //Skip another 19 bytes of empty data + some lengths
  2235.           S := GetStr(Pak, GetLInt(Pak, 4));
  2236.           List := TStringList.Create;
  2237.           ParseContacts(S, List);
  2238.           if Assigned(OnContactListRecv) then
  2239.             FOnContactListRecv(Self, IntToStr(UIN), List)
  2240.           else
  2241.             List.Free;
  2242.         end else
  2243.         if S = 'Send Web Page Address (URL)' then
  2244.         begin
  2245.           Inc(Pak^.Len, 19);            //Skip another 19 bytes of empty data + some lengths
  2246.           S := GetStr(Pak, GetLInt(Pak, 4));
  2247.           if Assigned(OnURLRecv) then
  2248.           begin
  2249.             Desc := Copy(S, 0, Pos(#$fe, S) - 1);
  2250.             URL := Copy(S, Pos(#$fe, S) + 1, Length(S) - Pos(#$fe, S));
  2251.             if Assigned(OnURLRecv) then
  2252.               FOnURL(Self, Desc, URL, IntToStr(Uin));
  2253.           end;
  2254.         end else
  2255.         if S = 'Request For Contacts' then
  2256.         begin
  2257.           Inc(Pak^.Len, 19);            //Skip another 19 bytes of empty data + some lengths
  2258.           S := GetStr(Pak, GetLInt(Pak, 4));
  2259.           if Assigned(OnContactListRequest) then
  2260.             FOnContactListReq(Self, IntToStr(UIN), S)
  2261.         end else
  2262.         if S = 'File' then
  2263.         begin
  2264.           Inc(Pak^.Len, 19);                    //Skip another 19 bytes of empty data + some lengths
  2265.           Desc := GetStr(Pak, GetLInt(Pak, 4)); //Description
  2266.           Port := GetInt(Pak, 2);               //Port
  2267.           Inc(Pak^.Len, 2);                     //Seq
  2268.           FileLen := GetLInt(Pak, 2);
  2269.           if FileLen > 0 then
  2270.           begin
  2271.             FText := GetStr(Pak, FileLen - 1);  //Filename
  2272.             Inc(Pak^.Len, 1);                   //Null terminator
  2273.           end else FText := '';
  2274.           FileLen := GetLInt(Pak, 4);           //Filelength
  2275.           rec.ReqType := 0;
  2276.           rec.UIN := UIN;
  2277.           rec.Description := Desc;
  2278.           rec.FileName := FText;
  2279.           rec.FileSize := FileLen;
  2280.           rec.Seq := LSeq;
  2281.           rec.Port := Port;
  2282.           if Assigned(OnFTRequest) then
  2283.             FOnFTRequest(Self, rec);
  2284.           Exit;
  2285.         end;
  2286.       end;
  2287.     end;
  2288.     $07da:                              //Packet acks
  2289.     begin
  2290.       if Assigned(OnDirectPacketAck) then
  2291.         FOnDirectPktAck(Self, LSeq);
  2292.     end;
  2293.   end;
  2294.   //ACK received packet, if this packet isn't a "cancel given message" or "acknowledge message"
  2295.   if (cmd <> $07da) and (cmd <> $07d0) then
  2296.   begin
  2297.     if FDirect <> nil then
  2298.       begin
  2299.         CreatePEER_MSGACK(@lpkt, LSeq);
  2300.         FDirect.SendData(UIN, @lpkt);
  2301.       end;
  2302.   end;
  2303. end;
  2305. procedure TICQClient.FTOnConnectError(Sender: TObject);
  2306. begin
  2307.   FLoggedIn := False;
  2308.   FTimer.Enabled := False;
  2309.   if Assigned(OnConnectionFailed) then
  2310.     FOnConnectionFailed(Self);
  2311. end;
  2313. procedure TICQClient.FTOnDisconnect(Sender: TObject);
  2314. begin
  2315.   FTimer.Enabled := False;
  2316.   if FLoggedIn then
  2317.   begin
  2318.     FLoggedIn := False;
  2319.     if Assigned(OnConnectionFailed) then
  2320.       FOnConnectionFailed(Self);
  2321.   end;
  2322. end;
  2324. procedure TICQClient.FTOnDirectParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
  2325. begin
  2326.   if Assigned(OnPktDirectParse) then
  2327.     FOnDPktParse(Self, Buffer, BufLen, Incoming);
  2328. end;
  2330. procedure TICQClient.FTOnPktParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean);
  2331. begin
  2332.   if Assigned(OnPktParse) then
  2333.     FOnPktParse(Self, Buffer, BufLen, Incoming);
  2334. end;
  2336. procedure TICQClient.OnFTInitProc(Sender: TObject; UIN: LongWord; FileCount, TotalBytes, Speed: LongWord; NickName: String);
  2337. begin
  2338.   if Assigned(OnFTInit) then
  2339.     FOnFTInit(Self, UIN, FileCount, TotalBytes, Speed, NickName);
  2340. end;
  2342. procedure TICQClient.OnFTStartProc(Sender: TObject; StartRec: TFTStartRec; FileName: String; FileSize, Speed: LongWord);
  2343. begin
  2344.   if Assigned(OnFTStart) then
  2345.     FOnFTStart(Self, StartRec, FileName, FileSize, Speed);
  2346. end;
  2348. procedure TICQClient.OnFTFileDataProc(Sender: TObject; UIN: LongWord; Data: Pointer; DataLen: LongWord; LastPacket: Boolean);
  2349. begin
  2350.   if Assigned(OnFTFileData) then
  2351.     FOnFTFileData(Self, UIN, Data, DataLen, LastPacket);
  2352. end;
  2354. procedure TICQClient.SetContactList(Value: TStrings);
  2355. begin
  2356.   FContactLst.Assign(Value);
  2357. end;
  2359. procedure TICQClient.SetVisibleList(Value: TStrings);
  2360. begin
  2361.   FVisibleLst.Assign(Value);
  2362. end;
  2364. procedure TICQClient.SetInvisibleList(Value: TStrings);
  2365. begin
  2366.   FInvisibleLst.Assign(Value);
  2367. end;
  2369. procedure TICQClient.OnTimeout;
  2370. begin
  2371.   FTimer.Enabled := False;
  2372.   FSock.Disconnect;
  2373.   OnIntError(Self, ERR_CONNTIMEOUT, 'Connection timed out');
  2374.   if Assigned(OnConnectionFailed) then
  2375.     FOnConnectionFailed(Self);
  2376. end;
  2378. {**************************************************************************}
  2379. constructor TMyTimer.Create;
  2380. begin
  2381.   inherited Create;
  2382.   FEnabled := True;
  2383.   FInterval := 1000;
  2384.   {$IFDEF OLD_DELPHI}
  2385.   FWindowHandle := AllocateHWnd(WndProc);
  2386.   {$ELSE}
  2387.   FWindowHandle := Classes.AllocateHWnd(WndProc); {Remove 'depricated' warning}
  2388.   {$ENDIF}
  2389. end;
  2391. destructor TMyTimer.Destroy;
  2392. begin
  2393.   SetEnabled(False);
  2394.   {$IFDEF OLD_DELPHI}
  2395.   DeallocateHWnd(FWindowHandle);
  2396.   {$ELSE}
  2397.   Classes.DeallocateHWnd(FWindowHandle); {Remove 'depricated' warning}
  2398.   {$ENDIF}
  2399.   inherited;
  2400. end;
  2402. procedure TMyTimer.WndProc(var Msg: TMessage);
  2403. begin
  2404.   with Msg do
  2405.     if Msg = WM_TIMER then
  2406.       try
  2407.         Timer;
  2408.       except
  2409.       end
  2410.     else
  2411.       Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  2412. end;
  2414. procedure TMyTimer.UpdateTimer;
  2415. begin
  2416.   KillTimer(FWindowHandle, 1);
  2417.   if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
  2418.     SetTimer(FWindowHandle, 1, FInterval, nil);
  2419. end;
  2421. procedure TMyTimer.SetEnabled(Value: Boolean);
  2422. begin
  2423.   if Value <> FEnabled then
  2424.   begin
  2425.     FEnabled := Value;
  2426.     UpdateTimer;
  2427.   end;
  2428. end;
  2430. procedure TMyTimer.SetInterval(Value: Cardinal);
  2431. begin
  2432.   if Value <> FInterval then
  2433.   begin
  2434.     FInterval := Value;
  2435.     UpdateTimer;
  2436.   end;
  2437. end;
  2439. procedure TMyTimer.SetOnTimer(Value: TNotifyEvent);
  2440. begin
  2441.   FOnTimer := Value;
  2442.   UpdateTimer;
  2443. end;
  2445. procedure TMyTimer.Timer;
  2446. begin
  2447.   if Assigned(FOnTimer) then FOnTimer(Self);
  2448. end;
  2450. {*********************************************************************}
  2452. procedure Register;
  2453. begin
  2454.   RegisterComponents('Standard', [TICQClient]);
  2455. end;
  2459. end.