{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author:       Alexander Vaga
EMail:        primary:   icq2000cc@hobi.ru
              secondary: alexander_vaga@hotmail.com
Web:          http://icq2000cc.hobi.ru
Creation:     May, 2002
Legal issues: Copyright (C) 2002 by Alexander Vaga
              Kyiv, Ukraine

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely.
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{$A-,B+,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M+,N+,O-,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
unit Main;
interface
uses
  Windows, Messages, SysUtils, Graphics,
  Forms, Dialogs, ComCtrls, Buttons, ToolWin,
  ExtCtrls, Menus, ImgList, ScktComp, Controls,
  StdCtrls, Classes, IniFiles,
  Typess, Packet, Util;

type
  TForm1 = class(TForm)
    CLMenu: TPopupMenu;
    PopSendMessage: TMenuItem;
    PopUserInfo: TMenuItem;
    Blink: TTimer;
    MainT: TTimer;
    CLImageList: TImageList;
    StatusMenu: TPopupMenu;
    OnlineConnected1: TMenuItem;
    FreeForChat1: TMenuItem;
    sep1: TMenuItem;
    Away1: TMenuItem;
    NAExtendedAway1: TMenuItem;
    sep2: TMenuItem;
    OccupiedUrgentMsgs1: TMenuItem;
    DNDDoNotDisturb1: TMenuItem;
    sep3: TMenuItem;
    PrivacyInvisible1: TMenuItem;
    OfflineDiscconnect1: TMenuItem;
    Panel1: TPanel;
    CL: TTreeView;
    PopDeleteUser: TMenuItem;
    Panel3: TPanel;
    SearchUsers: TSpeedButton;
    ToolBar1: TToolBar;
    StatusBtn: TToolButton;
    Splitter1: TSplitter;
    CLI: TClientSocket;
    BG: TPanel;
    Memo: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure InitUser;
    procedure InitLogs;
    procedure LoadCList;
    procedure SaveCList;
    procedure LoadMsgQueue;
    procedure SaveMsgQueue;
    procedure CloseLogs;
    procedure SetCListToOFFline;
    procedure WriteToContactList(Member:TListRecord);
    procedure ConnectMode(Mode : boolean);
    procedure MainTTimer(Sender: TObject);
    procedure BlinkTimer(Sender: TObject);
    procedure CLDblClick(Sender: TObject);
    procedure SendMessageToUser(ppp:PListRecord);
    procedure ReadMessageFromUser(ppp:PListRecord);
    procedure PopSendMessageClick(Sender: TObject);
    procedure PopUserInfoClick(Sender: TObject);
    procedure PopDeleteUserClick(Sender: TObject);
    procedure CLEdited(Sender: TObject; Node: TTreeNode; var S: String);
    procedure CLCompare(Sender: TObject; Node1, Node2: TTreeNode;
      Data: Integer; var Compare: Integer);
    procedure SearchUsersClick(Sender: TObject);
    procedure OnlineConnected1Click(Sender: TObject);
    procedure Away1Click(Sender: TObject);
    procedure DNDDoNotDisturb1Click(Sender: TObject);
    procedure PrivacyInvisible1Click(Sender: TObject);
    procedure OfflineDiscconnect1Click(Sender: TObject);
    procedure OccupiedUrgentMsgs1Click(Sender: TObject);
    procedure FreeForChat1Click(Sender: TObject);
    procedure NAExtendedAway1Click(Sender: TObject);
    procedure CLIConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure CLI_ReadData(Sender: TObject; Socket: TCustomWinSocket);
    procedure CLIDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure PacketSend(p:PPack);
    procedure ShowUserONStatus(p:PPack);
    procedure ShowUserOFFStatus(p:PPack);
    procedure RejectNotificationFrom(p:PPack);
    procedure SNAC_15_3(p:PPack);
    procedure SNAC_4_7(p:PPack);
    procedure icq_Login(Status : longint);
    procedure SetStatus(Status:longint);
    procedure StatusChange(Status:longint);
    procedure AuthorizePart(p:PPack);
    procedure WorkPart(p:PPack);
    function DoMsg(on_off:boolean;typemes,lenmes:integer; data:PCharArray; r_uin:longint; DateTime:TDateTime):PMsgItem;
    procedure DoSimpleMsg(r_uin:longint; Text:string);
    procedure PutUserInfo(seq2:word;Field:TInfoFieldsDef;What:string);
    procedure PutSearchInfo(cookie:word;What:TSearchRec);
    procedure ClearFIFO;
    procedure debugFILE(tmp:PPack; Direction:char);
    procedure LogMessage(s:string);
  private{ Private declarations }
  public { Public declarations }
  protected { Protected declarations }
  published { Published declarations }
 end;

var Form1 : TForm1;

    UIN           : longint;
    NICK          : string;
    PASSWORD      : string;
    DIM_IP        : IPArray;
    Local_IP      : string;
    Local_Name    : string;
    SEQ           : word;
    FLAP          : FLAP_HDR;
    FLAP_DATA     : TByteArray;
    Index         : integer;
    NeedBytes     : integer;
    sCOOKIE       : string;
    Cookie        : word;
    WorkAddress   : string;
    WorkPort      : integer;
    log,mess      : text;

    ContactList : TContactList;
const
    ICQStatus  : longint = STATE_ONLINE; 
    isLogged   : boolean = false;
    isAuth     : boolean = true;
    isHDR      : boolean = true;
    HeadFIFO   : PFLAP_Item = nil;

    EndOfSearch  : boolean = false;
    CLNum        : integer = 0;
    BlinkFlag    : boolean = true;

implementation

uses SendMess, MessFrom, UInfo, SUser;
{$R *.DFM}

(****************************************************************)
procedure TForm1.PacketSend(p:PPack);
begin
       SetLengthPacket(p);
       CLI.socket.sendbuf(p^.data,p^.length);
       debugFILE(p,'>');
       PacketDelete(p);
end;

(****************************************************************)
procedure TForm1.ConnectMode(Mode : boolean);
begin
     case Mode of
      true: begin
        isLogged := true;
        case ICQStatus of
          STATE_ONLINE:      StatusBtn.ImageIndex := online;
          STATE_AWAY:        StatusBtn.ImageIndex := away;
          STATE_DND:         StatusBtn.ImageIndex := dnd;
          STATE_OCCUPIED:    StatusBtn.ImageIndex := occupied;
          STATE_FREEFORCHAT: StatusBtn.ImageIndex := freeforchat;
          STATE_N_A:         StatusBtn.ImageIndex := na;
          STATE_INVISIBLE:   StatusBtn.ImageIndex := invisible;
          else               StatusBtn.ImageIndex := offline;
        end;
      end;
      false: begin
        If CLI.Active then CLI.Close;
        ClearFIFO;
        isLogged := false;
        StatusBtn.ImageIndex := offline;
      end;
     end; // case
end;

(****************************************************************)
procedure TForm1.FormCreate(Sender: TObject);
begin
    InitUser;
    LoadCList;
    LoadMsgQueue;
    InitLogs;
end;

(****************************************************************)
procedure TForm1.CLDblClick(Sender: TObject);
var node : TTreeNode;
begin
//     if not isLogged then exit;
     if CL.Selected = nil then exit;
     node := CL.Selected;
     if (PListRecord(node.Data)^.EXTRA.MES_IS)and
        (PListRecord(node.Data)^.PMSG<>nil) then begin
        ReadMessageFromUser(PListRecord(node.Data));
     end else SendMessageToUser(PListRecord(node.Data));
end;

(****************************************************************)
procedure TForm1.PopUserInfoClick(Sender: TObject);
var ppp:PListRecord;
    TUI : TUserInfo;
begin
     if CL.Selected = nil then exit;
     ppp := PListRecord(CL.Selected.Data);
     Application.CreateForm(TUserInfo,TUI);
     TUI.AutoRetrieve := false;
     TUI.Caption := 'Info:  '+s(ppp^.UIN)+'   ( '+ppp^.NICK+' )';
     TUI.UIRecord := ppp^;
     TUI.Show;
end;

(****************************************************************)
procedure TForm1.PopSendMessageClick(Sender: TObject);
begin
     if (not OL)or(not isLogged) or
        (CL.Selected = nil) then exit;
     SendMessageToUser(PListRecord(CL.Selected.Data));
end;

(****************************************************************)
procedure TForm1.SendMessageToUser(ppp:PListRecord);
var sUIN : string;
    TSM : TMessageTo;
begin
     sUIN := s(ppp^.UIN);  if sUIN = '' then exit;
     Application.CreateForm(TMessageTo,TSM);
     TSM.ICQEd.Text :=sUIN;
     TSM.NNEd.Text := ppp^.NICK;
     TSM.User := ppp;
     TSM.FromWhom := UIN; // it`s MY UIN
     TSM.Caption := 'Send Message To '+ppp^.NICK;
     TSM.Show;
end;

(****************************************************************)
procedure TForm1.ReadMessageFromUser(ppp:PListRecord);
var TRM : TMessageFrom;
begin
     Application.CreateForm(TMessageFrom,TRM);
     TRM.ICQEd.Text :=s(ppp^.UIN);
     TRM.NNEd.Text := ppp^.NICK;
     TRM.User := ppp;
     TRM.FromWhom := UIN; // it`s MY UIN
     TRM.Caption := 'Message From '+ppp^.NICK;
     TRM.Show;
end;

(****************************************************************)
procedure TForm1.BlinkTimer(Sender: TObject);
var   node : TTReeNode;
      i : integer;
begin
       BlinkFlag := not BlinkFlag;
       for i:= 0 to CL.Items.Count-1 do begin

         node := CL.Items.Item[i];
         if PListRecord(node.Data)^.EXTRA.MES_IS  then begin
           case BlinkFlag of
           true: begin
                 node.ImageIndex := PListRecord(node.Data)^.EXTRA.ICON_INDEX;
                 node.SelectedIndex := node.ImageIndex; // empty
                 end;
           false: begin
                 node.ImageIndex := mes;
                 node.SelectedIndex := mes;
                 end;
           end; // CASE
         end;
         if PListRecord(node.Data)^.EXTRA.STATE_BLINK > 0  then begin
           dec(PListRecord(node.Data)^.EXTRA.STATE_BLINK);
           if not odd(PListRecord(node.Data)^.EXTRA.STATE_BLINK) then
                 node.Text := PListRecord(node.Data)^.NICK
           else  node.Text := UPPERCASE(PListRecord(node.Data)^.NICK);
         end;

       end;
end;

(****************************************************************)
procedure TForm1.debugFILE(tmp:PPack; Direction:char);
begin
     writeln(log,DateTimeToStr(Now)+' =================================');
     writeln(log,Direction+'FLAP: '+inttohex(tmp^.Sign,2)+' '+
          inttohex(tmp^.ChID,2)+' '+inttohex(swap(tmp^.SEQ),4)+' '+
          inttohex(swap(tmp^.Len),4)+' '+'['+inttostr(swap(tmp^.Len))+']');
     writeln(log,Direction+'SNACK:  $'+inttohex(swap(tmp^.SNAC.FamilyID),4)+
                     ':'+inttohex(swap(tmp^.SNAC.SubTypeID),4)+
              ' flags:$'+inttohex(swap(word(tmp^.SNAC.Flags)),4)+
                ' ref:$'+inttohex(DSwap(tmp^.SNAC.RequestID),8));
     writeln(log,Dim2Str(@(tmp^.FLAP_BODY),swap(tmp^.FLAP.Len)));
     writeln(log,Dim2Hex(@(tmp^.FLAP_BODY),swap(tmp^.FLAP.Len)));
     writeln(log,'');
end;

(****************************************************************)
procedure TForm1.CLI_ReadData(Sender: TObject; Socket: TCustomWinSocket);
var num,Bytes,fact : integer;
    pFIFO,CurrFIFO : PFLAP_Item;
    buf : array[0..100] of byte;
begin
     num := Socket.ReceiveLength;
     if isHDR then begin  // is it a flap header ?
       if num>=6 then begin
         Socket.ReceiveBuf(FLAP,6);
         NeedBytes := swap(FLAP.Len);
         Index := 0;   // FLAP_DATA[0]
         isHDR := false; // goto FLAP_DATA
       end else begin
             M(memo,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
             Socket.ReceiveBuf(buf,num);
             M(Memo,Dim2Hex(@(buf),num));
             M(memo,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!');
           end;

     end else begin  // DATA-BLOCK
         Bytes := NeedBytes;
         fact := Socket.ReceiveBuf(FLAP_DATA[Index],Bytes);
         inc(Index,fact);
         dec(NeedBytes,fact);
         if NeedBytes = 0 then begin
           New(pFIFO);
           pFIFO^.FLAP := FLAP;
           pFIFO^.Next := nil;
           GetMem(pFIFO^.DATA,Index);
           move(FLAP_DATA,PFIFO^.Data^,swap(FLAP.Len));
           // AddLast
           CurrFIFO:=HeadFIFO;
           if HeadFIFO<>nil then begin
             while CurrFIFO<>nil do
               if CurrFIFO^.Next=nil then begin
                 CurrFIFO^.Next:=pFIFO;
                 break;
               end else CurrFIFO:=CurrFIFO^.Next;
           end else HeadFIFO:=pFIFO; // list is empty
           isHDR := true; // goto FLAP_HDR
         end;
     end;
end;

(****************************************************************)
procedure TForm1.MainTTimer(Sender: TObject);
var FindFIFO : PFLAP_Item;
    tmp : PPack;
begin
     MainT.Enabled := false;
     while HeadFIFO<>nil do begin
       // Get HeadFIFO
       FindFIFO := HeadFIFO;
       if HeadFIFO^.Next=nil then HeadFIFO := nil
       else HeadFIFO := HeadFIFO^.Next;

       // creating new packet
       tmp := PacketNew;
       // Fill the packet
       PacketAppend(tmp,@FindFIFO^.FLAP,sizeof(FLAP_HDR));
       PacketAppend(tmp,FindFIFO^.DATA,swap(FindFIFO^.FLAP.Len));
       // Release packet`s memory
       FreeMem(FindFIFO^.DATA,swap(FindFIFO^.FLAP.Len));
       Dispose(FindFIFO);
       // 
       debugFILE(tmp,'<');
       if isAuth then AuthorizePart(tmp)
       else WorkPart(tmp);
       // Deleting packet
       PacketDelete(tmp);
     end;
     MainT.Enabled := true;
end;

(****************************************************************)
procedure TForm1.AuthorizePart(p:PPack);
var ss : string;
    T : integer;
    tmp : PPack;
begin
     PacketGoto(p,sizeof(FLAP_HDR)); // goto FLAP_DATA

     // Authorize Server ACK
     if (swap(p^.Len)=4)and
        (swap(p^.SNAC.FamilyID)=0)and
        (swap(p^.SNAC.SubTypeID)=1) then begin
       M(Memo,'< Authorize Server CONNECT');

       // Auth Request (Login)
       SEQ := random($7FFF);
       tmp := CreatePacket(1,SEQ);
       PacketAppend32(tmp,DSwap(1));
       TLVAppendStr(tmp,$1,s(UIN));
       TLVAppendStr(tmp,$2,Calc_Pass(PASSWORD));
       TLVAppendStr(tmp,$3,'ICQ Inc. - Product of ICQ (TM).2000a.4.31.1.3143.85');
       TLVAppendWord(tmp,$16,$010A);
       TLVAppendWord(tmp,$17,$0004); // for 2000a
       TLVAppendWord(tmp,$18,$001F);
       TLVAppendWord(tmp,$19,$0001);
       TLVAppendWord(tmp,$1A,$0C47);
       TLVAppendDWord(tmp,$14,$00000055);
       TLVAppendStr(tmp,$0F,'en');
       TLVAppendStr(tmp,$0E,'us');
       PacketSend(tmp);
       M(Memo,'>Auth Request (Login)');

     end else  // Auth Response (COOKIE or ERROR)
     if (TLVReadStr(p,ss)=1){and(ss=s(UIN))}then begin
        T := TLVReadStr(p,ss);
        case T of
          5: begin // BOS-IP:PORT
            WorkAddress := copy(ss,1,pos(':',ss)-1);
            WorkPort := strtoint(copy(ss,pos(':',ss)+1,length(ss)-pos(':',ss)));
            if (TLVReadStr(p,sCOOKIE)=6)then begin;
              // Empty packet for disconnect
              tmp:=CreatePacket(4,SEQ); // ChID=4
              PacketSend(tmp);
              // Disconnect from Autorize Server
              OfflineDiscconnect1Click(self);
              isAuth := false;
              // Connecting to BOS
              CLI.Address := WorkAddress;
              CLI.Host := '';
              CLI.Port := WorkPort;
              M(Memo,'>>> Connecting to BOS: '+ss);
              CLI.Open;
            end;
          end;
          4,8: begin
               M(Memo,'TLV($'+inttohex(T,2)+') ERROR');
               M(Memo,'STRING: '+ss);
               if pos('http://',ss)>0 then begin
               end;
               TLVReadStr(p,ss); M(Memo,ss);
               OfflineDiscconnect1Click(self);
             end;
        end;
     end;
end;

(****************************************************************)
procedure TForm1.WorkPart(p:PPack);
var ss,ss2,sErr : string;
//    T : integer;
    tmp : PPack;
    i : integer;
    SEQ1,SEQ2:word;
begin
     if p^.FLAP.ChID = 4 then begin // SERVER GONNA DISCONNECT
       PacketGoto(p,sizeof(FLAP_HDR));
       TLVReadStr(p,ss); M(Memo,ss);
       TLVReadStr(p,ss2); M(Memo,ss2);
       OfflineDiscconnect1Click(self);
       sErr:='Str1: ';
       for i:=1 to length(ss) do sErr:=sErr+inttohex(byte(ss[i]),2)+' ';
       sErr:=sErr+#13#10+'Str2: '+ss2+#13#10+#13#10;
       ShowMessage('Another Computer Use YOUR UIN!'#13#10+#13#10+
                   sErr+'...i gonna to disconnect');
       exit;
     end;

     PacketGoto(p,sizeof(FLAP_HDR)+sizeof(SNAC_HDR));
        // BOS Connection ACK
     if (swap(p^.Len)=4)and
        (swap(p^.SNAC.FamilyID)=0)and
        (swap(p^.SNAC.SubTypeID)=1) then begin
        M(Memo,'< BOS connection ACK');

       // BOS Sign-ON  (COOKIE)
       SEQ := random($7FFF);
       tmp := CreatePacket(1,SEQ);
       PacketAppend32(tmp,DSwap(1));
       TLVAppendStr(tmp,$6,sCOOKIE);
       PacketSend(tmp);
       M(Memo,'>BOS Sign-ON (COOKIE)');

     end else  // BOS-Host ready
     if (swap(p^.SNAC.FamilyID)=1)and
        (swap(p^.SNAC.SubTypeID)=3) then begin
        M(Memo,'< BOS-Host ready');

       // I`m ICQ client, not AIM
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$17);
       PacketAppend32(tmp,dswap($00010003));
       PacketAppend32(tmp,dswap($00020001));
       PacketAppend32(tmp,dswap($00030001));
       PacketAppend32(tmp,dswap($00150001));
       PacketAppend32(tmp,dswap($00040001));
       PacketAppend32(tmp,dswap($00060001));
       PacketAppend32(tmp,dswap($00090001));
       PacketAppend32(tmp,dswap($000A0001));
       PacketSend(tmp);
       M(Memo,'>"I`m ICQ client, not AIM"');

     end else // ACK to "I`m ICQ Client"
     if (swap(p^.SNAC.FamilyID)=$1)and // ACK
        (swap(p^.SNAC.SubTypeID)=$18) then begin
        M(Memo,'< ACK to "I`m ICQ client"');

       // Rate Information Request
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$6);
       PacketSend(tmp);
       M(Memo,'>Rate Information Request');

     end else // Rate Information Response
     if (swap(p^.SNAC.FamilyID)=$1)and
        (swap(p^.SNAC.SubTypeID)=$7) then begin
        M(Memo,'< Rate Information Response');

       // ACK to Rate Information Response
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$8);
       PacketAppend32(tmp,DSwap($00010002));
       PacketAppend32(tmp,DSwap($00030004));
       PacketAppend16(tmp,Swap($0005));
       PacketSend(tmp);
       M(Memo,'>ACK to Rate Response');

       // Request Personal Info
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$0E);
       PacketSend(tmp);
       M(Memo,'>Request Personal Info');

       // Request Rights for Location service
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$2,$02);
       PacketSend(tmp);
       M(Memo,'>Request Rights for Location service');

       // Request Rights for Buddy List
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$3,$02);
       PacketSend(tmp);
       M(Memo,'>Request Rights for Buddy List');

       // Request Rights for ICMB
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$4,$04);
       PacketSend(tmp);
       M(Memo,'>Request Rights for ICMB');

       // Request BOS Rights
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$9,$02);
       PacketSend(tmp);
       M(Memo,'>Request BOS Rights');

     end else  // Personal Information
     if (swap(p^.SNAC.FamilyID)=$1)and
        (swap(p^.SNAC.SubTypeID)=$F) then begin
        M(Memo,'< Personal Information');

     end else  // Rights for location service
     if (swap(p^.SNAC.FamilyID)=$2)and
        (swap(p^.SNAC.SubTypeID)=$3) then begin
        M(Memo,'< Rights for location service');

     end else  // Rights for byddy list
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$3) then begin
        M(Memo,'< Rights for byddy list');

     end else  // Rights for ICMB
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$5) then begin
        M(Memo,'< Rights for ICMB');

     end else // BOS Rights
     if (swap(p^.SNAC.FamilyID)=$9)and
        (swap(p^.SNAC.SubTypeID)=$3) then begin
        M(Memo,'< BOS Rights');

       // Set ICMB parameters
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$4,$2);
       PacketAppend16(tmp,swap($0));
       PacketAppend32(tmp,dswap($3));
       PacketAppend16(tmp,swap($1F40));
       PacketAppend16(tmp,swap($03E7));
       PacketAppend16(tmp,swap($03E7));
       PacketAppend16(tmp,swap($0));
       PacketAppend16(tmp,swap($0));
       PacketSend(tmp);
       M(Memo,'>Set ICMB parameters');

       // Set User Info (capability)
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$2,$4);      // tlv(5)=capability
       TLVAppendStr(tmp,5,#$09#$46#$13#$49#$4C#$7F#$11#$D1+
                          #$82#$22#$44#$45#$53#$54#$00#$00+
                          #$09#$46#$13#$44#$4C#$7F#$11#$D1+
                          #$82#$22#$44#$45#$53#$54#$00#$00);
       PacketSend(tmp);
       M(Memo,'>Set User Info (capability)');

       // Send Contact List
       if CL.Items.Count <> 0 then begin
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$3,$4);
       for i:=0 to CL.Items.Count-1 do
         PacketAppendB_String(tmp,s(PListRecord(CL.Items[i].data)^.UIN));
       PacketSend(tmp);
       M(Memo,'>Send Contact List ('+s(CL.Items.Count)+')');
       end;

       case ICQStatus of
       STATE_INVISIBLE: begin
           // Send Visible List
           tmp := CreatePacket(2,SEQ);
           SNACAppend(tmp,$9,$5);
           PacketSend(tmp);
           M(Memo,'>Send Visible List (0)');
         end;
       else begin
           // Send Invisible List
           tmp := CreatePacket(2,SEQ);
           SNACAppend(tmp,$9,$7);
           PacketSend(tmp);
           M(Memo,'>Send Invisible List (0)');
         end;
       end;//case

       ConnectMode(true);
       SetStatus(ICQStatus);
       M(Memo,'>Set Status Code');

       // Client Ready
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$2);
       PacketAppend32(tmp,dswap($00010003));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($00020001));
       PacketAppend32(tmp,dswap($0101028A));
       PacketAppend32(tmp,dswap($00030001));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($00150001));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($00040001));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($00060001));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($00090001));
       PacketAppend32(tmp,dswap($0110028A));
       PacketAppend32(tmp,dswap($000A0003));
       PacketAppend32(tmp,dswap($0110028A));
       PacketSend(tmp);
       M(Memo,'>Client Ready');

       // Get offline messages
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$15,$2);
       PacketAppend32(tmp,dswap($0001000A));
       PacketAppend16(tmp,swap($0800));
       PacketAppend32(tmp,UIN);
       PacketAppend16(tmp,swap($3C00));
       PacketAppend16(tmp,swap($0200));
       PacketSend(tmp);
       M(Memo,'>Get offline messages');

       // Get Banner Address
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$15,$2);
       PacketAppend16(tmp,swap($0001));
       ss:='<key>BannersIP</key>';
       PacketAppend16(tmp,swap(14+length(ss)+1));
       PacketAppend16(tmp,swap($2100));
       PacketAppend32(tmp,UIN);
       PacketAppend16(tmp,swap($D007)); // Type
       PacketAppend16(tmp,swap($0300)); // Cookie
       PacketAppend16(tmp,swap($9808)); // SubType = xml-style (LNTS)
       PacketAppendString(tmp,ss);      // '<key>BannersIP</key>'
       PacketSend(tmp);
       M(Memo,'>Get Banner Address');

     end else  // UIN ON-line
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$0B) then begin
        ShowUserONStatus(p);

     end else  // UIN OFF-line
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$0C) then begin
        ShowUserOFFStatus(p);

     end else  // Reject notification
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$0A) then begin
        RejectNotificationFrom(p);

     end else  // SNAC 15,3  Meny purposes (offlines messages)
     if (swap(p^.SNAC.FamilyID)=$15)and
        (swap(p^.SNAC.SubTypeID)=$3) then begin
        SNAC_15_3(p);

     end else  // SNAC 4,7  Incoming message
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$7) then begin
        SNAC_4_7(p);

     end else  // Server`s ACK
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$C) then begin
        M(Memo,'< SNAC: 4,0C  Server`s ACK');
        // it`s signal to close SendMessWindow
        SEQ1:=PacketRead32(p);
        SEQ2:=PacketRead32(p);
        //M(Memo,'SEQ1:SEQ2='+s(SEQ1)+':'+s(SEQ2));
        PostMessage(Handle,msg_OnSrv,SEQ1,SEQ2);

     end else  // Users`s ACK
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$B) then begin
        M(Memo,'< SNAC: 4,0B  Users`s ACK');
        // it`s signal to close SendMessWindow
        SEQ1:=PacketRead32(p);
        SEQ2:=PacketRead32(p);
        //M(Memo,'SEQ1:SEQ2='+s(SEQ1)+':'+s(SEQ2));
        PostMessage(Handle,msg_Sent,SEQ1,SEQ2);

     end else  // Server`s ERROR CODE
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$1) then begin
        // it`s signal to close SendMessWindow
        SEQ1:=PacketRead32(p);
        SEQ2:=PacketRead32(p);
        //M(Memo,'SEQ1:SEQ2='+s(SEQ1)+':'+s(SEQ2));
        PostMessage(Handle,msg_SentErr,SEQ1,SEQ2);

     end else begin
        M(Memo,'--------------------------------------');
        M(Memo,'??? Unrecognized FLAP: ???');
        M(Memo,'??? SNAC: $'+inttohex(swap(p^.SNAC.FamilyID),2)+':'+
                              '$'+inttohex(swap(p^.SNAC.SubTypeID),2));
        M(Memo,'--------------------------------------');
     end;
end;

(****************************************************************)
procedure TForm1.RejectNotificationFrom(p:PPack);
begin
     M(Memo,'');
     M(Memo,'< Reject from UIN: '+PacketReadB_String(p));
     M(Memo,'');
end;

(****************************************************************)
procedure TForm1.ShowUserONStatus(p:PPack);
var
   T : word;
   i,k,cnt,inx : integer;
   UINonline,TLV : string;
   r_uin,r_ip,r_r_ip,r_status,Mask : longint;
   node : TTreeNode;
begin
      UINonline := PacketReadB_String(p);
      M(Memo,'');
      M(Memo,'< UIN ON-line: '+UINonline);
      try r_uin := strtoint(UINonline); except r_uin:=0; end;
      PacketRead16(p);
      cnt := swap(PacketRead16(p));
      for k:=1 to cnt do begin
        T := TLVReadStr(p,TLV);
        case T of
        6:  begin // STATUS
            move(TLV[1],IPArray(r_status),4);
            r_status := DSwap(r_status);
            M(Memo,'TLV($'+inttohex(T,2)+')'+
                 ' STATUS: $'+inttohex(r_status,8));
            end;
        $A: begin // IP
            move(TLV[1],IPArray(r_ip),4);
            M(Memo,'TLV($'+inttohex(T,2)+')'+
                   ' IP: '+IPToStr(IPArray(r_ip)));
            end;
        $C: begin // REAL_IP
            move(TLV[1],IPArray(r_r_ip),4);
            M(Memo,'TLV($'+inttohex(T,2)+')'+
                   ' Real IP: '+IPToStr(IPArray(r_r_ip)));
            end;
            //else M(Memo,'TLV($'+inttohex(T,2)+')');
        end;
      end;
      M(Memo,'');

      CL.Items.BeginUpdate;
      for i:=0 to CL.Items.Count-1 do begin
        node := CL.Items[i];
        if r_uin = PListRecord(node.Data)^.UIN  then begin
          PListRecord(node.Data)^.IP := IParray(r_ip);
          PListRecord(node.Data)^.REAL_IP := IParray(r_r_ip);
          Mask := r_status and $FFF;
          case Mask of
            $0:      inx := online;       {online}
            $1,$2:   inx := away;         {away}
            $10,$11: inx := occupied;     {DND Urgent}
            $12,$13: inx := dnd;          {DND}
            $4,$5:   inx := na;           {N/A}
            $20:     inx := freeforchat;  {free for chat}
            $100:    inx := invisible;    {invisible}
            else     inx := etc;          {unknown}
          end; // case
         node.ImageIndex := inx;
         node.SelectedIndex := inx;
         PListRecord(node.Data)^.EXTRA.ICON_INDEX := inx;
         break;
        end; //IF
      end; //FOR
      CL.Items.EndUpdate;
      CL.AlphaSort;
end;

(****************************************************************)
procedure TForm1.ShowUserOFFStatus(p:PPack);
var
   i : integer;
   UINoffline : string;
   r_uin : longint;
   node : TTreeNode;
begin
     UINoffline := PacketReadB_String(p);
     M(Memo,'');
     M(Memo,'< UIN OFF-line: '+UINoffline);
     M(Memo,'');
     try r_uin := strtoint(UINoffline); except r_uin:=0; end;
     CL.Items.BeginUpdate;
     for i:=0 to CL.Items.Count-1 do begin
        node := CL.Items[i];
        if r_uin = PListRecord(node.Data)^.UIN  then begin
           node.ImageIndex := offline;     {offline}
           node.SelectedIndex := offline;
           PListRecord(node.Data)^.EXTRA.ICON_INDEX := offline;
           break;
        end;
     end;
     CL.Items.EndUpdate;
     CL.AlphaSort;
end;

(****************************************************************)
procedure TForm1.SNAC_15_3(p:PPack);
var MessageType,Cookie : word;
    {myUIN,}hisUIN : longint;
    SubType : array[0..3] of byte;
    MessageSubType : longint absolute SubType;
    year,month,day,hour,minute,typemes,{subtypemes,}lenmes : word;
    tmp : PPack;
    i,cnt : integer;
    sTemp,URL : string;
    SearchInfo : TSearchRec;
begin
     PacketRead32(p);
     PacketRead16(p);
     {myUIN := }PacketRead32(p);
     MessageType := swap(PacketRead16(p));
     Cookie := swap(PacketRead16(p));
     //M(Memo,'< Cookie: $'+inttohex(Cookie,4));
     case MessageType of
     $DA07: begin
            SubType[3] := 0;
            SubType[2] := PacketRead8(p);
            SubType[1] := PacketRead8(p);
            SubType[0] := PacketRead8(p);
            if(MessageSubType and $FF)<>$0A then begin
              M(Memo,'<FAIL: SubType:$'+inttohex(MessageSubType,4));
              EndOfSearch:=true;
            end;
            case MessageSubType of
            $A2080A: begin // Banner URL
                      sTemp := PacketReadString(p);
                      sTemp[pos('<',sTemp)] :='_';
                      URL := 'http://'+copy(sTemp,pos('>',sTemp)+1,pos('<',sTemp)-pos('>',sTemp)-1);
                      M(Memo,'<Banner HTML-Server: '+URL);
                     end;
            $90010A,      // search-answers (not last)
            $9A010A: begin// search-answer (last)
                      if MessageSubType=$9A010A then EndOfSearch:=true;
                      PacketRead16(p);// len of LNTS
                      SearchInfo.uin := PacketRead32(p);
                      SearchInfo.nick := PacketReadString(p);
                      SearchInfo.first := PacketReadString(p);
                      SearchInfo.last := PacketReadString(p);
                      SearchInfo.email := PacketReadString(p);
                      SearchInfo.auth := PacketRead8(p);
                      SearchInfo.status := PacketRead8(p); // state ????????
                      PutSearchInfo(cookie,SearchInfo); // send it to search window
                      PacketRead8(p);// #0 of LNTS
                     end;
            $C8000A: begin// main-home-info
                      PutUserInfo(cookie,dNick,PacketReadString(p));
                      PutUserInfo(cookie,dFirst,PacketReadString(p));
                      PutUserInfo(cookie,dLast,PacketReadString(p));
                      PutUserInfo(cookie,dE_Mail,PacketReadString(p));
                      PutUserInfo(cookie,dCity,PacketReadString(p));
                      PutUserInfo(cookie,dState,PacketReadString(p));
                      PutUserInfo(cookie,dPhone,PacketReadString(p));
                      PutUserInfo(cookie,dFax,PacketReadString(p));
                      PutUserInfo(cookie,dStreet,PacketReadString(p));
                      PutUserInfo(cookie,dCellular,PacketReadString(p));
                      PutUserInfo(cookie,dZip,PacketReadString(p));
                      PutUserInfo(cookie,dCountry,s(PacketRead16(p)));
                      PutUserInfo(cookie,dTimeZone,s(PacketRead8(p)));
                     end;
            $DC000A: begin// homepage-more-info
                      PutUserInfo(cookie,dAge,s(PacketRead8(p)));    // 0xFFFF - not entered
                      PacketRead8(p);
                      PutUserInfo(cookie,dGender,s(PacketRead8(p)));  // 1 - female, 2 - male
                      PutUserInfo(cookie,dHomepage,PacketReadString(p));
                      PutUserInfo(cookie,dByear,s(PacketRead16(p)));   
                      PutUserInfo(cookie,dBmonth,s(PacketRead8(p)));
                      PutUserInfo(cookie,dBday,s(PacketRead8(p)));
                      PutUserInfo(cookie,dLang1,s(PacketRead8(p)));
                      PutUserInfo(cookie,dLang2,s(PacketRead8(p)));
                      PutUserInfo(cookie,dLang3,s(PacketRead8(p)));
                     end;
            $EB000A: begin// more-email-info
                      cnt:=PacketRead8(p);
                      if cnt>2 then cnt:=2;
                      for i:=1 to cnt do begin
                        PacketRead8(p);  
                        if i=1 then PutUserInfo(cookie,dSec_E_Mail,PacketReadString(p))
                        else PutUserInfo(cookie,dOld_E_Mail,PacketReadString(p));
                      end;
                     end;
            $0E010A: begin// additional-info
                     end;
            $D2000A: begin// work-info
                      PutUserInfo(cookie,dwCity,PacketReadString(p));
                      PutUserInfo(cookie,dwState,PacketReadString(p));
                      PutUserInfo(cookie,dwPhone,PacketReadString(p));
                      PutUserInfo(cookie,dwFax,PacketReadString(p));
                      PutUserInfo(cookie,dwStreet,PacketReadString(p));
                      PutUserInfo(cookie,dwZip,PacketReadString(p));
                      PutUserInfo(cookie,dwCountry,s(PacketRead16(p)));
                      PutUserInfo(cookie,dCompany,PacketReadString(p));
                      PutUserInfo(cookie,dDepartment,PacketReadString(p));
                      PutUserInfo(cookie,dJob,PacketReadString(p));
                      PutUserInfo(cookie,dOccupation,s(PacketRead16(p)));
                      PutUserInfo(cookie,dWhomepage,PacketReadString(p));
                     end;
            $E6000A: begin// about
                      PutUserInfo(cookie,dAbout,PacketReadString(p));
                     end;
            $F0000A: begin// personal-interests
                      cnt:=PacketRead8(p); sTemp:='';
                      for i:=1 to cnt do begin
                        swap(PacketRead16(p));
                        sTemp:=sTemp+PacketReadString(p)+#13#10;
                      end;
                      PutUserInfo(cookie,dInterests,sTemp);
                      PutUserInfo(cookie,dEnd,'');  // Last Packet
                     end;
            $FA000A,$FA0014,$FA0032:
                     begin// past-background
                      PutUserInfo(cookie,dEnd,'');  // Last Packet
                     end;
            else M(Memo,'< ??? SNAC 15,3; Type:$DA07; SubType: $'+inttohex(MessageSubType,6));
            end;//
            end;

     $4200: begin // END of offline messages
            //M(Memo,'< Message-Type: $'+inttohex(MessageType,4));
            M(Memo,'< End of OFFline messages');
            tmp := CreatePacket(2,SEQ);
            SNACAppend(tmp,$15,$2);
            PacketAppend16(tmp,swap($0001)); // TLV(1)
            PacketAppend32(tmp,dswap($000A0800));
            PacketAppend32(tmp,UIN);
            PacketAppend16(tmp,swap($3E00)); // ACK
            PacketAppend16(tmp,swap($0200));
            PacketSend(tmp);
            M(Memo,'>ACK it');
            end;
     $4100: begin // OFFLINE MESSAGE
            hisUIN := PacketRead32(p); // LE
            //M(Memo,'< Message-Type: $'+inttohex(MessageType,4));
            M(Memo,'< OFFLINE MESSAGE from UIN: '+s(hisUIN));
            year := PacketRead16(p);
            month := PacketRead8(p);
            day := PacketRead8(p);
            hour := PacketRead8(p);
            minute := PacketRead8(p);
            typemes := PacketRead8(p);
            {subtypemes := }PacketRead8(p);
            lenmes := PacketRead16(p);
            DoMsg(false,typemes,lenmes,PCharArray(@(p^.data[p^.cursor])),
                  hisUIN,UTC2LT(year,month,day,hour,minute));
            PacketGoto(p,(p^.cursor)+lenmes);
            end;
     else M(Memo,'< ??? SNAC 15,3; Type: $'+inttohex(MessageType,4));
     end;//case
end;

(****************************************************************)
procedure TForm1.SNAC_4_7(p:PPack);  // INCOMING MESSAGES
var i,cnt,T,MessageFormat,SubMode,SubMode2,Empty : word;
    {myUIN,}hisUIN : longint;
    SubType : array[0..3] of byte;
    MessageSubType : longint absolute SubType;
    tmp,tmp2,tmp3 : PPack;
    sTemp : string;
    dTemp : TByteArray;
    typemes,{subtypemes,}unk,modifier,lenmes : word;

    //for snac 4,0B  (ack for msg-2 type)
    d1,d2 : longint;
    a : PPack;

    NewMsg : PMsgItem;
    FG : array[0..3] of byte;
    BG : array[0..3] of byte;
begin
     d1:=PacketRead32(p);
     d2:=PacketRead32(p);
     MessageFormat := swap(PacketRead16(p));
     sTemp := PacketReadB_String(p);
     a := PacketNew;
     PacketAppend32(a,d1);
     PacketAppend32(a,d2);
     PacketAppend16(a,swap(MessageFormat));
     PacketAppend8(a,length(sTemp));
     PacketAppend(a,@sTemp[1],length(sTemp));
     PacketAppend16(a,swap($0003));

     try hisUIN := strtoint(sTemp); except hisUIN:=0; end;
     M(Memo,'< From: '+sTemp);
     PacketRead16(p); //warning level? garbage of OSCAR protocol
     cnt := swap(PacketRead16(p)); // num of TLVs
     for i:=1 to cnt do
       if TLVReadStr(p,sTemp)=6 then begin { this is a HIS STATUS } end;
     case MessageFormat of
     $0001: begin
            //M(Memo,'< Message-format: 1 (SIMPLE message)');
            TLVReadStr(p,sTemp);
            // copy TLV(2) to TMP
            tmp := PacketNew;
            PacketAppend(tmp,@(sTemp[1]),length(sTemp));
            PacketGoto(tmp,0);

            PacketRead16(tmp);
            PacketRead16(tmp);
            PacketRead8(tmp);
            PacketRead16(tmp);
            lenmes := swap(PacketRead16(tmp))-4;
            PacketRead32(tmp);

            PacketRead(tmp,@sTemp[1],lenmes);
            SetLength(sTemp,lenmes);
            DoSimpleMsg(hisUIN,sTemp);

            // delete TMP
            PacketDelete(tmp);
            end;
     $0002: begin
            //M(Memo,'< Message-format: 2 (ADVANCED message)');
            TLVReadStr(p,sTemp);
            // copy TLV(5) to TMP
            tmp := PacketNew;
            PacketAppend(tmp,@(sTemp[1]),length(sTemp));
            PacketGoto(tmp,0);

            SubMode := swap(PacketRead16(tmp));
            PacketRead32(tmp);
            PacketRead32(tmp);
            PacketRead(tmp,@dTemp,16); //capability 16 bytes
            case SubMode of
            $0000: begin
                   //M(Memo,'SubMode: $0000 NORMAL');
                   {T := }TLVReadWord(tmp,SubMode2);// 0001-normal 0002-file reply
                   TLVReadWord(tmp,Empty);// TLV(F) empty
                   T := TLVReadStr(tmp,sTemp);
                   if T=$2711 then begin

                   PacketAppend(a,@sTemp[1],47);
                   PacketAppend32(a,0);

                   //******************************************
                   tmp2 := PacketNew;
                   PacketAppend(tmp2,@(sTemp[1]),length(sTemp));
                   PacketGoto(tmp2,0);

                   PacketRead(tmp2,@dTemp,26);
                   PacketRead8(tmp2);
                   PacketRead16(tmp2);
                   PacketRead16(tmp2);
                   PacketRead16(tmp2);
                   PacketRead(tmp2,@dTemp,12);
                   typemes := PacketRead8(tmp2);
                   {subtypemes := }PacketRead8(tmp2);
                   unk:=swap(PacketRead16(tmp2));//0200
                   modifier:=swap(PacketRead16(tmp2));//0100
                   M(Memo,'Unk: $'+inttohex(unk,4));
                   M(Memo,'Modifier: $'+inttohex(modifier,4));

                   lenmes := PacketRead16(tmp2);
                   NewMsg:=DoMsg(true,typemes,lenmes,PCharArray(@(tmp2^.data[tmp2^.cursor])),
                         hisUIN,Now2DateTime);
                   PacketGoto(tmp2,(tmp2^.cursor)+lenmes);

                   PacketRead(tmp2,@FG,4);
                   PacketRead(tmp2,@BG,4);
                   if NewMsg<>nil then begin
                     NewMsg^.FG:='$00'+inttohex(FG[2],2)+
                                       inttohex(FG[1],2)+
                                       inttohex(FG[0],2);
                     NewMsg^.BG:='$00'+inttohex(BG[2],2)+
                                       inttohex(BG[1],2)+
                                       inttohex(BG[0],2);
                   end;
                   PacketDelete(tmp2);

                   PacketAppend16(a,1);
                   PacketAppend8(a,0);
                   PacketAppend32(a,0);
                   PacketAppend32(a,-1);

                   // Sending Ack
                   tmp3 := CreatePacket($2,SEQ);
                   SNACAppend(tmp3,$4,$0B);
                   PacketAppend(tmp3,@a.data,a.length);
                   PacketDelete(a);
                   PacketSend(tmp3);
                   //******************************************
                   end;// IF
                   end;  //Submode:$0000
            $0001: M(Memo,'SubMode:$0001 ??? message canceled ???');
            $0002: M(Memo,'SubMode:$0002 FILE-ACK (not yet)');
            end;//case SubMode
            // delete TMP
            PacketDelete(tmp);
            end;
     $0004: begin
            //M(Memo,'< Message-format: 4 (url or contacts or auth-req or userAddedYou)');
            TLVReadStr(p,sTemp);
            // copy TLV(5) to TMP
            tmp := PacketNew;
            PacketAppend(tmp,@(sTemp[1]),length(sTemp));
            PacketGoto(tmp,0);

            hisUIN := PacketRead32(tmp);
            typemes := PacketRead8(tmp);
            {subtypemes := }PacketRead8(tmp);

            lenmes := PacketRead16(tmp);
            DoMsg(true,typemes,lenmes,PCharArray(@(tmp^.data[tmp^.cursor])),
                  hisUIN,Now2DateTime);

            // delete TMP
            PacketDelete(tmp);
            end;
       else M(Memo,'< ??? SNAC 4,7; Message-format: '+s(MessageFormat));
     end;//case MessageFormat
end;

(****************************************************************)
function TForm1.DoMsg(on_off:boolean;typemes,lenmes:integer; data:PCharArray; r_uin:longint; DateTime:TDateTime):PMsgItem;
var j,i,pos1,pos2 : integer;
    sTemp,sLog,sNN : string;
    LTemp : array[1..6] of string;
    sDT : string;

    FromUIN : longint;
    TextTmp : string;
    Len,Cnt  : integer;
    Curr,PMsg : PMsgItem;
    UINinList : boolean;
    node : TTreeNode;
    tmp : PPack;
begin
     DoMsg:=nil;
     if (lenmes-1)=0 then exit;
     setlength(sTemp,lenmes-1);   // -1 for final string char #0
     move(data^,sTemp[1],lenmes-1);

     for i:=1 to 6 do LTemp[i]:='';
     if (typemes <> TYPE_MSG)and(typemes<>0) then begin
         if sTemp[length(sTemp)]<>#$FE then sTemp:=sTemp+#$FE;
         pos2:=0;
         for i:=1 to 6 do begin
           pos1 := pos2+1;
           pos2 := pos(#$FE,sTemp);
           if pos2 = 0 then break;
           LTemp[i] := copy(sTemp,pos1,pos2-pos1);
           sTemp[pos2] := #$FF;
         end;
     end else begin
     ///////////////////////
     end;
     sNN := '';
     UINinList := false;
     for j:=0 to CLNum-1 do  // set Blinking for UIN
       if ContactList[j].UIN = r_uin then begin
          ContactList[j].EXTRA.MES_IS := true;
          sNN := ContactList[j].NICK;
          UINinList := true;
          break;
       end;
     if not UINinList then begin
       ContactList[CLNum].UIN := r_uin;
       ContactList[CLNum].NICK := s(r_uin);
       ContactList[CLNum].EXTRA.ICON_INDEX := simply_icq;
       ContactList[CLNum].EXTRA.MES_IS := true;
       node := CL.Items.AddObject(nil,ContactList[CLNum].NICK,@ContactList[CLNum]);
       node.ImageIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
       node.SelectedIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
       inc(CLNum);
       CL.AlphaSort;

       WriteToContactList(ContactList[CLNum-1]);
       // Add to Contact List
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$3,$4);
       PacketAppendB_String(tmp,s(ContactList[CLNum-1].UIN));
       PacketSend(tmp);
       M(Memo,'>Add To Contact List: '+s(ContactList[CLNum-1].UIN));
     end;

     case on_off of
       true: sDT := '<-[A] ';
       false: sDT := '<-[O] ';
     end;
     sDT := sDT+DateTimeToStr(DateTime)+' ';
     case typemes of
     0,TYPE_MSG: begin
        FmtStr(sLog,sDT+sNN+' ['+s(r_uin)+'] "%s"',[sTemp]);
        TextTmp:=sTemp;
     end;
     TYPE_ADDED: begin
        FmtStr(sLog,'UIN:%d has added you to their contact list.'+
                    'Nick:%s  FName:%s LName:%s E-mail:%s',
                    [r_uin,LTemp[1],LTemp[2],LTemp[3],LTemp[4]]);
        TextTmp:='User has added you to their contact list.';
     end;
     TYPE_AUTH_REQ: begin
        FmtStr(sLog,'UIN:%d has requested your authorization.'+
                    'Nick:%s  FName:%s LName:%s E-mail:%s '#13#10'Reason:"%s"',
                    [r_uin,LTemp[1],LTemp[2],LTemp[3],LTemp[4],LTemp[6]]);
        TextTmp:='User has requested your authorization.';
     end;
     TYPE_URL: begin
        FmtStr(sLog,'URL: UIN:%d, '#13#10'URL:%s, '#13#10'Description:"%s"',
                    [r_uin,LTemp[2],LTemp[1]]);
        TextTmp:='URL: '+sTemp;
     end;
     TYPE_WEBPAGER: begin
        FmtStr(sLog,'WebPager: UIN:%d, Nick:%s, EMail:%s, '#13#10'"%s"',
                    [r_uin,LTemp[1],LTemp[4],LTemp[6]]);
        TextTmp:='WebPager: '+sTemp;
     end;
     TYPE_EXPRESS: begin
        FmtStr(sLog,'MailExpress: UIN:%d, Nick:%s, EMail:%s, '#13#10'"%s"',
                    [r_uin,LTemp[1],LTemp[4],LTemp[6]]);
        TextTmp:='MailExpress: '+sTemp;
     end;
     else begin
        FmtStr(sLog,'Instant message type %d from UIN:%d, '#13#10'Message:"%s"',
                    [typemes,r_uin,sTemp]);
     end;
     end;//case
     sLog := sDT+sLog;
     M(Memo,sLog); LogMessage(sLog);

     FromUIN := r_uin;
     for i:=0 to CLNum-1 do begin
       if ContactList[i].UIN = FromUIN then begin
         New(PMsg);
         PMsg^.Next := nil;
         PMsg^.FromUIN := FromUIN;
         PMsg^.DateTime := DateTimeToStr(DateTime);
         PMsg^.FG := '$00000000';
         PMsg^.BG := '$00DDDDDD';

         Len := length(TextTmp);
         PMsg^.Len := Len;
         GetMem(PMsg^.Text,Len);
         Move(TextTmp[1],PMsg^.Text^,Len);

         Cnt:=0;
         // AddLast
         Curr:=ContactList[i].PMSG;
         if ContactList[i].PMSG<>nil then begin
           while Curr<>nil do begin
             inc(Cnt); // and Count It
             if Curr^.Next=nil then begin
               Curr^.Next:=PMSG;
               break;
             end else Curr:=Curr^.Next;
           end;
         end else ContactList[i].PMSG:=PMSG; // list is empty

         PostMessage(Handle,msg_NextON,Cnt+1,r_uin);

         ContactList[i].EXTRA.MES_IS := true;
         DoMsg:=PMsg;
       end;
     end;
end;

(****************************************************************)
procedure TForm1.DoSimpleMsg(r_uin:longint; Text:string);
var i : integer;
    sLog,sDT : string;
    TextTmp : string;
    Len,Cnt  : integer;
    Curr,PMsg : PMsgItem;

    UINinList : boolean;
    node : TTreeNode;
    tmp : PPack;
begin
     TextTmp := Text;
     Len := length(TextTmp);

     sDT := DateTimeToStr(Now);
     sLog:= '<-[S] '+sDT+' ';

     UINinList := false;
     for i:=0 to CLNum-1 do
       if ContactList[i].UIN = r_uin then begin
         UINinList:=true; break;
       end;
     if not UINinList then begin
       ContactList[CLNum].UIN := r_uin;
       ContactList[CLNum].NICK := s(r_uin);
       ContactList[CLNum].EXTRA.ICON_INDEX := simply_icq;
       ContactList[CLNum].EXTRA.MES_IS := true;
       node := CL.Items.AddObject(nil,ContactList[CLNum].NICK,@ContactList[CLNum]);
       node.ImageIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
       node.SelectedIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
       inc(CLNum);
       CL.AlphaSort;
       WriteToContactList(ContactList[CLNum-1]);
    // Add to Contact List
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$3,$4);
       PacketAppendB_String(tmp,s(ContactList[CLNum-1].UIN));
       PacketSend(tmp);
       M(Memo,'>Add To Contact List: '+s(ContactList[CLNum-1].UIN));
     end;

     for i:=0 to CLNum-1 do begin
       if ContactList[i].UIN = r_uin then begin
         sLog:=sLog+ContactList[i].NICK+' ';
         New(PMsg);
         PMsg^.Next := nil;
         PMsg^.FromUIN := r_uin;
         PMsg^.DateTime := sDT;
         PMsg^.FG := '$00000000';
         PMsg^.BG := '$00DDDDDD';
         PMsg^.Len := Len;

         GetMem(PMsg^.Text,Len);
         Move(TextTmp[1],PMsg^.Text^,Len);

         Cnt:=0;
         // AddLast
         Curr:=ContactList[i].PMSG;
         if ContactList[i].PMSG<>nil then begin
           while Curr<>nil do begin
             inc(Cnt); // and Count It
             if Curr^.Next=nil then begin
               Curr^.Next:=PMSG;
               break;
             end else Curr:=Curr^.Next;
           end;

         end else ContactList[i].PMSG:=PMSG; // list is empty

         PostMessage(Handle,msg_NextON,Cnt+1,r_uin);

         ContactList[i].EXTRA.MES_IS := true;
       end;
     end;
     sLog := sLog+'['+s(r_uin)+'] "'+TextTmp+'"';
     M(Memo,sLog);
     LogMessage(sLog);
end;
(****************************************************************)
procedure TForm1.LoadCList;
var sTmp,sNick,sUIN : string;
    node : TTreeNode;
    L : TListRecord;
    ff : TIniFile;
    p,i : integer;
    tUINs : TStrings;
begin
     tUINs := TStringList.Create;
     ff:=TIniFile.Create(ExtractFilePath(ParamStr(0))+s(UIN)+'.dat');

     fillchar(ContactList,sizeof(ContactList),#0);
     fillchar(L,sizeof(TListRecord),#0);

     CL.Items.BeginUpdate;
     CL.Items.Clear;
     CLNum := 0;
     try
     ff.ReadSectionValues('ContactList',tUINs);
     for i:=0 to tUINs.Count-1 do begin
         if tUINs[i] = '' then continue;
         sTmp := tUINs[i];
         p := pos('=',sTmp);
         sUIN := copy(sTmp,1,p-1);
         sNick := ff.ReadString('ContactList',sUIN,'');
         L.UIN := strtoint(sUIN);
         L.NICK := sNick;
         L.FIRST := ff.ReadString(sUIN,'First','');
         L.LAST := ff.ReadString(sUIN,'Last','');
         L.PRI_E_MAIL := ff.ReadString(sUIN,'E-Mail','not yet');
         L.SEC_E_MAIL := ff.ReadString(sUIN,'Sec-E-Mail','not yet');
         L.OLD_E_MAIL := ff.ReadString(sUIN,'Old-E-Mail','not yet');
         L.CITY := ff.ReadString(sUIN,'City','');
         L.STATE := ff.ReadString(sUIN,'State','');
         L.PHONE := ff.ReadString(sUIN,'Phone','');
         L.FAX := ff.ReadString(sUIN,'Fax','');
         L.CELLULAR := ff.ReadString(sUIN,'Cellular','');
         L.STREET := ff.ReadString(sUIN,'Street','');
         L.COUNTRY := strtoint(ff.ReadString(sUIN,'Country','0'));
         L.AGE := strtoint(ff.ReadString(sUIN,'Age','0'));
         L.GENDER := strtoint(ff.ReadString(sUIN,'Gender','0'));
         L.HOMEPAGE := ff.ReadString(sUIN,'Homepage','http://');
         L.BYEAR := strtoint(ff.ReadString(sUIN,'Byear','0'));
         L.BMONTH := strtoint(ff.ReadString(sUIN,'Bmonth','0'));
         L.BDAY := strtoint(ff.ReadString(sUIN,'Bday','0'));
         strtoip(ff.ReadString(sUIN,'IP','0.0.0.0'),L.IP);
         strtoip(ff.ReadString(sUIN,'Real-IP','0.0.0.0'),L.REAL_IP);
         L.VER := strtoint(ff.ReadString(sUIN,'Ver','0'));
         L.AUTH := strtoint(ff.ReadString(sUIN,'Auth','0'));
         L.LANG1 := strtoint(ff.ReadString(sUIN,'Lang1','0'));
         L.LANG2 := strtoint(ff.ReadString(sUIN,'Lang2','0'));
         L.LANG3 := strtoint(ff.ReadString(sUIN,'Lang3','0'));
         L.COMPANY := ff.ReadString(sUIN,'Company','');
         L.DEPARTMENT := ff.ReadString(sUIN,'Department','');
         L.JOB := ff.ReadString(sUIN,'Job','');
         L.OCCUPATION := strtoint(ff.ReadString(sUIN,'Occupation','0'));
         L.WCITY := ff.ReadString(sUIN,'WCity','');
         L.WSTATE := ff.ReadString(sUIN,'WState','');
         L.WPHONE := ff.ReadString(sUIN,'WPhone','');
         L.WFAX := ff.ReadString(sUIN,'WFax','');
         L.WSTREET := ff.ReadString(sUIN,'WStreet','');
         L.WCOUNTRY := strtoint(ff.ReadString(sUIN,'WCountry','0'));
         L.WHOMEPAGE := ff.ReadString(sUIN,'WHomepage','');
         L.ABOUT := ff.ReadString(sUIN,'About','nothing...');
         while pos('^',l.about)>0 do l.about[Pos('^',l.about)] := #13;
         while pos('|',l.about)>0 do l.about[Pos('|',l.about)] := #10;
         L.INTERESTS := ff.ReadString(sUIN,'Interests','nothing...');
         while pos('^',l.interests)>0 do l.interests[Pos('^',l.interests)] := #13;
         while pos('|',l.interests)>0 do l.interests[Pos('|',l.interests)] := #10;

      // optional fields
         L.EXTRA.ICON_INDEX  := simply_icq;
         L.EXTRA.MES_IS      := false;
         L.EXTRA.STATE_BLINK := 0;
         L.EXTRA.FG          := ff.ReadString(sUIN,'FG','$00000000');
         L.EXTRA.BG          := ff.ReadString(sUIN,'BG','$00FFFFFF');

         ContactList[CLNum] := L;

         node := CL.Items.AddObject(nil,L.NICK,@ContactList[CLNum]);
         node.ImageIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
         node.SelectedIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
         inc(CLNum);
     end; // For
     CL.AlphaSort;
     CL.Items.EndUpdate;

     finally  ff.Free; end;
     tUINs.Destroy;
end;

(****************************************************************)
procedure TForm1.LoadMsgQueue;
var ff : TIniFile;
    p,i : integer;
    MsgCount : integer;
    FromUIN : longint;
    DateTime : string;
    TextTmp : string;
    Len  : integer;
    FG   : string[9];
    BG   : string[9];
    Curr,PMsg : PMsgItem;
    UINinList : boolean;
    Node : TTreeNode;
begin
     ff:=TIniFile.Create(ExtractFilePath(ParamStr(0))+s(UIN)+'.buf');
     try
     MsgCount := ff.ReadInteger('General','MsgCount',0);
     if MsgCount>0 then begin
     for i:=1 to MsgCount do begin
       FromUIN := ff.ReadInteger(s(i),'FromUIN',0);
       DateTime := ff.ReadString(s(i),'DateTime','01.01.70 12:00:00');
       TextTmp := ff.ReadString(s(i),'Text','empty');
       repeat
         p := pos('^|',TextTmp);
         if p>0 then begin
           TextTmp[p]:=#13;
           TextTmp[p+1]:=#10;
         end;
       until p=0;

       Len := length(TextTmp);
       FG := ff.ReadString(s(i),'FG','$00000000');
       if FG='' then FG:='$00000000';
       BG := ff.ReadString(s(i),'BG','$00FFFFFF');
       if BG='' then BG:='$00FFFFFF';
       UINinList := false;
       for p:=0 to CLNum-1 do
         if ContactList[p].UIN = FromUIN then begin
           UINinList:=true; break;
         end;
       if not UINinList then begin
         ContactList[CLNum].UIN := FromUIN;
         ContactList[CLNum].NICK := s(FromUIN);
         ContactList[CLNum].EXTRA.ICON_INDEX := simply_icq;
         ContactList[CLNum].EXTRA.MES_IS := true;
         node := CL.Items.AddObject(nil,ContactList[CLNum].NICK,@ContactList[CLNum]);
         node.ImageIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
         node.SelectedIndex := ContactList[CLNum].EXTRA.ICON_INDEX;
         inc(CLNum);
         CL.AlphaSort;
         WriteToContactList(ContactList[CLNum-1]);
       end;

       for p:=0 to CLNum-1 do begin
         if ContactList[p].UIN = FromUIN then begin
           New(PMsg);
           PMsg^.Next := nil;
           PMsg^.FromUIN := FromUIN;
           PMsg^.DateTime := DateTime;
           PMsg^.FG := FG;
           PMsg^.BG := BG;
           PMsg^.Len := Len;

           GetMem(PMsg^.Text,Len);
           Move(TextTmp[1],PMsg^.Text^,Len);

           // AddLast
           Curr:=ContactList[p].PMSG;
           if ContactList[p].PMSG<>nil then begin
             while Curr<>nil do
               if Curr^.Next=nil then begin
                 Curr^.Next:=PMSG;
                 break;
               end else Curr:=Curr^.Next;
           end else ContactList[p].PMSG:=PMSG; // list is empty

           ContactList[p].EXTRA.MES_IS := true;
         end;
       end;
       ff.EraseSection(s(i));
     end;
     end else; ff.WriteInteger('General','MsgCount',0);
     finally  ff.Free; end;
end;

(****************************************************************)
procedure TForm1.SaveMsgQueue;
var ff : TIniFile;
    i,p : integer;
    MsgCount : integer;
    TextTmp : string;
    Curr,T : PMsgItem;
begin
     ff:=TIniFile.Create(ExtractFilePath(ParamStr(0))+s(UIN)+'.buf');
     MsgCount := ff.ReadInteger('General','MsgCount',0);

     for i:=0 to CLNum-1 do begin
       Curr:=ContactList[i].PMSG;
       if Curr=nil then continue;
       while Curr<>nil do begin
         inc(MsgCount);

         // Write to *.BUF
         ff.WriteInteger(s(MsgCount),'FromUIN',Curr^.FromUIN);
         ff.WriteString(s(MsgCount),'DateTime',Curr^.DateTime);
         SetLength(TextTmp,Curr^.Len);
         move(Curr^.Text^,TextTmp[1],Curr^.Len);
         repeat
           p := pos(#13#10,TextTmp);
           if p>0 then begin
             TextTmp[p]:='^';
             TextTmp[p+1]:='|';
           end;
         until p=0;
         ff.WriteString(s(MsgCount),'Text',TextTmp);
         ff.WriteString(s(msgCount),'FG',Curr^.FG);
         ff.WriteString(s(msgCount),'BG',Curr^.BG);

         Curr := Curr^.Next;
         ff.WriteInteger('General','MsgCount',MsgCount);
       end;
       // Free resources
       T:=ContactList[i].PMSG;
       while T<>nil do begin
         Curr := T; T := T^.Next;
         FreeMem(Curr^.Text,Curr^.Len);
         Dispose(Curr);
       end;
     end;
     ff.WriteInteger('General','MsgCount',MsgCount);
     ff.Free;
end;
(****************************************************************)
procedure TForm1.SetCListToOFFline;
var i : integer;
    node : TTreeNode;
begin
     CL.Items.BeginUpdate;
     for i:=0 to CL.Items.Count-1 do begin
        node := CL.Items[i];
        if node<>nil then begin
           node.ImageIndex := simply_icq;
           node.SelectedIndex := node.ImageIndex;
           PListRecord(node.Data)^.EXTRA.ICON_INDEX := node.ImageIndex;
        end;
     end;
     CL.Items.EndUpdate;
     CL.AlphaSort;
end;

(****************************************************************)
procedure TForm1.CLEdited(Sender: TObject; Node: TTreeNode; var S: String);
begin
     PListRecord(node.Data)^.NICK := S;
end;

(****************************************************************)
procedure TForm1.SearchUsersClick(Sender: TObject);
var  TSU : TSearchUser;
begin
     Application.CreateForm(TSearchUser,TSU);
     TSU.Show;
end;

(****************************************************************)
procedure TForm1.SetStatus(Status:longint);
var tmp : PPack;
begin
       ICQStatus := Status;
       // Set Status Code
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$1E);
       TLVAppendDWord(tmp,6,ICQStatus);
       TLVAppendWord(tmp,8,$0000);
       // imitation TLV(C)
       PacketAppend32(tmp,dswap($000C0025)); // TLV(C)
       StrToIP(Get_my_IP,DIM_IP);
       PacketAppend(tmp,@DIM_IP,4);                  // IP address
       PacketAppend32(tmp,dswap(28000+random(1000)));// Port
       PacketAppend8(tmp,$04);
       PacketAppend16(tmp,swap($0007));
       PacketAppend16(tmp,swap($466B));
       PacketAppend16(tmp,swap($AE68));
       PacketAppend32(tmp,dswap($00000050));
       PacketAppend32(tmp,dswap($00000003));
       PacketAppend32(tmp,dswap(SecsSince1970));
       PacketAppend32(tmp,dswap(SecsSince1970));
       PacketAppend32(tmp,dswap(SecsSince1970));
       PacketAppend16(tmp,swap($0000));
       PacketSend(tmp);
       case ICQStatus of
         STATE_ONLINE:      StatusBtn.ImageIndex := online;
         STATE_AWAY:        StatusBtn.ImageIndex := away;
         STATE_DND:         StatusBtn.ImageIndex := dnd;
         STATE_OCCUPIED:    StatusBtn.ImageIndex := occupied;
         STATE_FREEFORCHAT: StatusBtn.ImageIndex := freeforchat;
         STATE_N_A:         StatusBtn.ImageIndex := na;
         STATE_INVISIBLE:   StatusBtn.ImageIndex := invisible;
         else               StatusBtn.ImageIndex := offline;
       end;
end;

(****************************************************************)
procedure TForm1.StatusChange(Status:longint);
var tmp : PPack;
begin
     if(not OL)then begin
       Get_My_IP; if not OL then begin M(Memo,'OFF-line'); exit; end;
     end;
     if (not CLI.Active) then icq_Login(Status)
     else if (not isLogged) then exit
     else begin
       ICQStatus := Status;
       case ICQStatus of
       STATE_INVISIBLE: begin
           // Send Visible List
           tmp := CreatePacket(2,SEQ);
           SNACAppend(tmp,$9,$5);
           PacketSend(tmp);
           M(Memo,'>Send Visible List (0)');
         end;
       else begin
           // Send Invisible List
           tmp := CreatePacket(2,SEQ);
           SNACAppend(tmp,$9,$7);
           PacketSend(tmp);
           M(Memo,'>Send Invisible List (0)');
         end;
       end;//case
       // Set Status Code
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$1,$1E);
       TLVAppendDWord(tmp,6,ICQStatus);
       PacketSend(tmp);
       case ICQStatus of
         STATE_ONLINE:      StatusBtn.ImageIndex := online;
         STATE_AWAY:        StatusBtn.ImageIndex := away;
         STATE_DND:         StatusBtn.ImageIndex := dnd;
         STATE_OCCUPIED:    StatusBtn.ImageIndex := occupied;
         STATE_FREEFORCHAT: StatusBtn.ImageIndex := freeforchat;
         STATE_N_A:         StatusBtn.ImageIndex := na;
         STATE_INVISIBLE:   StatusBtn.ImageIndex := invisible;
         else               StatusBtn.ImageIndex := offline;
       end;
     end;
end;

(****************************************************************)
procedure TForm1.OnlineConnected1Click(Sender: TObject);
begin
     StatusChange(STATE_ONLINE);
end;

(****************************************************************)
procedure TForm1.Away1Click(Sender: TObject);
begin
      StatusChange(STATE_AWAY);
end;

(****************************************************************)
procedure TForm1.DNDDoNotDisturb1Click(Sender: TObject);
begin
      StatusChange(STATE_DND);
end;

(****************************************************************)
procedure TForm1.PrivacyInvisible1Click(Sender: TObject);
begin
      StatusChange(STATE_INVISIBLE);
end;

(****************************************************************)
procedure TForm1.OfflineDiscconnect1Click(Sender: TObject);
begin
     ConnectMode(false);
     StatusBtn.ImageIndex := offline;
end;

(****************************************************************)
procedure TForm1.OccupiedUrgentMsgs1Click(Sender: TObject);
begin
      StatusChange(STATE_OCCUPIED);
end;

(****************************************************************)
procedure TForm1.FreeForChat1Click(Sender: TObject);
begin
      StatusChange(STATE_FREEFORCHAT);
end;

(****************************************************************)
procedure TForm1.NAExtendedAway1Click(Sender: TObject);
begin
      StatusChange(STATE_N_A);
end;

(****************************************************************)
procedure TForm1.CLCompare(Sender: TObject; Node1, Node2: TTreeNode;
  Data: Integer; var Compare: Integer);
begin
     if (node1.Data=nil)or(node2.Data=nil) then exit;
     try
      if PListRecord(node1.Data)^.EXTRA.ICON_INDEX = PListRecord(node2.Data)^.EXTRA.ICON_INDEX then begin
        if UniCase(node1.text) > UniCase(node2.text) then Compare := 1 else
        if UniCase(node1.text) < UniCase(node2.text) then Compare := -1 else
        if UniCase(node1.text) = UniCase(node2.text) then Compare := 0;
      end else
      if PListRecord(node1.Data)^.EXTRA.ICON_INDEX > PListRecord(node2.Data)^.EXTRA.ICON_INDEX then Compare := 1 else
      if PListRecord(node1.Data)^.EXTRA.ICON_INDEX < PListRecord(node2.Data)^.EXTRA.ICON_INDEX then Compare := -1;
     except end;
end;

(****************************************************************)
procedure TForm1.icq_Login(Status : longint);
begin
     Local_IP := Get_my_IP; StrToIP(Local_IP,DIM_IP);
     SetCListToOFFline;
     ICQStatus := status;
     if CLI.Active then CLI.Close;
     isAuth := true;
     isHDR := true;
     CLI.Address :='';
     CLI.Host := 'login.icq.com';
     CLI.Port := 5190;
     M(Memo,'>>>>>>>>>>  login.icq.com:5190');
     CLI.Open;
end;

(****************************************************************)
procedure TForm1.PutUserInfo(seq2:word;Field:TInfoFieldsDef;What:string);
var  PBuff : PInfoRec;
begin
     new(PBuff);
     if PBuff <> nil then begin
       pbuff^.f := Field;
       pbuff^.s := What;
       PostMessage(Handle,msg_UInfo,seq2,longint(pbuff));
     end;
end;

(****************************************************************)
procedure TForm1.PutSearchInfo(cookie:word;What:TSearchRec);
var  PBuff : PSearchRec;
begin
     new(PBuff);
     if PBuff <> nil then begin
       pbuff^ := What;
       PostMessage(Handle,msg_SInfo,cookie,longint(pbuff));
     end;
end;

(****************************************************************)
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     OfflineDiscconnect1Click(self);
     CloseLogs;
     SaveCList;
     SaveMsgQueue;
end;

(****************************************************************)
procedure TForm1.PopDeleteUserClick(Sender: TObject);
var p : PListRecord;
    user : array[0..100] of char;
    ff : TIniFile;
    sDelUIN : string;
begin
     if CL.Selected = nil then exit;
     p := CL.Selected.Data;
     sDelUIN := s(p^.UIN);
     strpcopy(user,'Delete user from Contact List?'+#13#10#13#10+p^.NICK+'  ( '+s(p^.UIN)+' )'+#0);
     if MessageBox(Handle,user,'Deleting...',
                   MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON2)
                   = IDYES then begin
       ff:=TIniFile.Create(ExtractFilePath(ParamStr(0))+s(UIN)+'.dat');
       CL.Selected.Delete;
       CL.AlphaSort;
       try
       ff.DeleteKey('ContactList',sDelUIN);
       ff.EraseSection(sDelUIN);
       finally ff.Free; end;
     end;
end;

(****************************************************************)
procedure TForm1.InitLogs;
begin
     assignfile(mess,s(UIN)+'.mes');
     try  if FileExists(s(UIN)+'.mes') then append(mess)
          else rewrite(mess);
     M(Memo,DateTimeToStr(Now));
     except end;
     assignfile(log,s(UIN)+'.log');
     try if FileExists(s(UIN)+'.log') then append(log)
         else rewrite(log);
     except end;
end;

(****************************************************************)
procedure TForm1.CloseLogs;
begin
     try closefile(mess); except end;
     try closefile(log);  except end;
end;

(****************************************************************)
procedure TForm1.LogMessage(s:string);
begin
     try writeln(mess,s); except end;
end;

(****************************************************************)
procedure TForm1.InitUser;
var cfg : TIniFile;
begin
     cfg := TIniFile.Create(ExtractFilePath(ParamStr(0))+'nICQ.ini');
     try
     UIN := cfg.ReadInteger('User','Uin',0);
     NICK := cfg.ReadString('User','Nick','');
     PASSWORD := cfg.ReadString('User','Password','');
     finally cfg.Free; end;
     Caption := NICK+' : '+s(UIN);
end;

(****************************************************************)
procedure TForm1.SaveCList;
var i : integer;
begin
     for i:=0 to CL.Items.Count-1 do
      WriteToContactList(PListRecord(CL.Items[i].Data)^);
end;

(****************************************************************)
procedure TForm1.WriteToContactList(Member:TListRecord);
var sUIN : string;
    ff : TIniFile;
begin
     ff:=TIniFile.Create(ExtractFilePath(ParamStr(0))+s(UIN)+'.dat');
     try
     with Member do begin
      sUIN := s(UIN);
      ff.WriteString('ContactList',sUIN,NICK);
      ff.writeString(sUIN,'Nick',NICK);
      ff.writeString(sUIN,'First',FIRST);
      ff.writeString(sUIN,'Last',LAST);
      ff.writeString(sUIN,'E-Mail',PRI_E_MAIL);
      ff.writeString(sUIN,'Sec-E-Mail',SEC_E_MAIL);
      ff.writeString(sUIN,'Old-E-Mail',OLD_E_MAIL);
      ff.writeString(sUIN,'IP',IPtoStr(IP));
      ff.writeString(sUIN,'Real-IP',IPtoStr(REAL_IP));
      ff.writeString(sUIN,'Ver',s(VER));
      ff.writeString(sUIN,'Auth',s(AUTH));
      ff.writeString(sUIN,'City',CITY);
      ff.writeString(sUIN,'State',STATE);
      ff.writeString(sUIN,'Phone',PHONE);
      ff.writeString(sUIN,'Fax',FAX);
      ff.writeString(sUIN,'Cellular',CELLULAR);
      ff.writeString(sUIN,'Street',STREET);
      ff.writeString(sUIN,'Country',s(COUNTRY));
      ff.writeString(sUIN,'Age',s(AGE));
      ff.writeString(sUIN,'Gender',s(GENDER));
      ff.writeString(sUIN,'Homepage',HOMEPAGE);
      ff.writeString(sUIN,'Byear',s(BYEAR));
      ff.writeString(sUIN,'Bmonth',s(BMONTH));
      ff.writeString(sUIN,'Bday',s(BDAY));
      ff.writeString(sUIN,'Lang1',s(LANG1));
      ff.writeString(sUIN,'Lang2',s(LANG2));
      ff.writeString(sUIN,'Lang3',s(LANG3));
      ff.writeString(sUIN,'Company',COMPANY);
      ff.writeString(sUIN,'Department',DEPARTMENT);
      ff.writeString(sUIN,'Job',JOB);
      ff.writeString(sUIN,'Occupation',s(Occupation));
      ff.writeString(sUIN,'WCity',WCITY);
      ff.writeString(sUIN,'WState',WSTATE);
      ff.writeString(sUIN,'WPhone',WPHONE);
      ff.writeString(sUIN,'WFax',WFAX);
      ff.writeString(sUIN,'WStreet',WSTREET);
      ff.writeString(sUIN,'WCountry',s(WCOUNTRY));
      ff.writeString(sUIN,'WHomepage',WHOMEPAGE);
      while pos(#13,about)>0 do about[Pos(#13,about)] := '^';
      while pos(#10,about)>0 do about[Pos(#10,about)] := '|';
      ff.writeString(sUIN,'About',ABOUT);
      while pos(#13,interests)>0 do interests[Pos(#13,interests)] := '^';
      while pos(#10,interests)>0 do interests[Pos(#10,interests)] := '|';
      ff.writeString(sUIN,'Interests',interests);
      ff.writeString(sUIN,'FG',EXTRA.FG);
      ff.writeString(sUIN,'BG',EXTRA.BG);
    end;
    ff.UpdateFile;
    finally ff.Free; end;
end;

(****************************************************************)
procedure TForm1.CLIDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
     M(Memo,'Disconnected: '+Socket.RemoteAddress);
end;

procedure TForm1.CLIConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
     M(Memo,'Connected: '+Socket.RemoteAddress);
end;

procedure TForm1.ClearFIFO;
var Find : PFLAP_Item;
begin
   // Del ALL
   repeat
     Find := HeadFIFO;
     if HeadFIFO<>nil then begin
       if HeadFIFO^.Next<>nil then
         HeadFIFO := HeadFIFO^.Next
       else HeadFIFO := nil;
     end;
     if Find<>nil then begin
       FreeMem(Find^.DATA,swap(Find^.FLAP.Len));
       Dispose(Find);
     end;
   until Find=nil;
end;

end.