Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
ICQ2000 сделай сам 6


Автор: Alexander Vaga
WEB-сайт: http://icq2000cc.hobi.ru

Приходит програмист с работы, а на него жена набрасывается с кулаками:
- Негодяй! Я столько лет тебя кормила, поила, ублажала, а ты, паразит, мне изменяешь!
- ???
- Не прикидывайся! Звонил Витька, спрашивал адрес твоей Аськи!

Обработчик WorkPart выполняет всю диспетчерскую работу на протяжении всего времени, когда мы подключены к основному ICQ-серверу. Устроен он очень просто.


procedure TForm1.WorkPart(p:PPack);
var ss,ss2,sErr : string;
    tmp : PPack;
begin
     { иногда бывает: сервер прервал соединение.
        такая ситуация возникала только в одном случае:
        сервером зафиксирован логин с нашим UINом с другого компьютера. }
     if p^.FLAP.ChID = 4 then begin 
       PacketGoto(p,sizeof(FLAP_HDR));
       // Код ошибки
       TLVReadStr(p,ss); M(Memo,ss);
       // Описание ошибки
       TLVReadStr(p,ss2); M(Memo,ss2);
       // Разьединяемся
       OfflineDiscconnect1Click(self);
       sErr:='Str1: '+Dim2Hex(@(ss[1]),length(ss));
       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 (DWORD 00000001)
     // т.е. основной сервер готов с нами общаться
     if (swap(p^.Len)=4)and
        (swap(p^.SNAC.FamilyID)=0)and
        (swap(p^.SNAC.SubTypeID)=1) then begin
        M(Memo,'< BOS connection ACK');

       // ... и мы ему передадим COOKIE
       // Sign-ON  (COOKIE)
       SEQ := random($7FFF);
       tmp := CreatePacket(1,SEQ);
       PacketAppend32(tmp,DSwap($00000001));
       TLVAppendStr(tmp,$6,sCOOKIE);
       PacketSend(tmp);
       M(Memo,'> Sign-ON (COOKIE)');

     end else  // 
     if (swap(p^.SNAC.FamilyID)=1)and
        (swap(p^.SNAC.SubTypeID)=3) then begin
        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,'< 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($0000));
       PacketAppend32(tmp,dswap($00000003));
       PacketAppend16(tmp, swap($1F40));
       PacketAppend16(tmp, swap($03E7));
       PacketAppend16(tmp, swap($03E7));
       PacketAppend16(tmp, swap($0000));
       PacketAppend16(tmp, swap($0000));
       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
       tmp := CreatePacket(2,SEQ);
       SNACAppend(tmp,$3,$4);
       // пока включаем только свой UIN
       PacketAppendB_String(tmp,s(UIN));
    // PacketAppendB_String(tmp,s(UIN_1));   
    // PacketAppendB_String(tmp,s(UIN_2));   
    // ...
    // PacketAppendB_String(tmp,s(UIN_n));   
    // Можно включить любой UIN, ... даже если он и не хочет :)   
       PacketSend(tmp);
       M(Memo,'> Send Contact List (1)');

       // если  мы начинаем с режима Invisible, то передаем
       // Visible List, во всех других режимах - Invisible List
       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');

{
Здесь заканчивается утомительная процедура вхождения в связь
(согласования различных параметров с сервером.
Возможно, что в AOL Imstant Messenger такая процедура, что-то и значит,
но в ICQ-протоколе похоже, что ничего).


В этот момент считается, что мы уже в Online
и другие клиенты наш статус увидят.
}

       // А мы можем уже запрашивать у сервера полезную информацию,
       // например, надо запросить off-лайновые сообщения
       // 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');
     end else  


{
здесь начинается секция обработки почти всех пакетов-ответов,
которые поступят во время, пока мы подключены к ICQ-серверу.
}

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

     end else  // UIN OFF-line
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$0C) then begin
        M(Memo,'');
        M(Memo,'< UIN OFF-line: '+PacketReadB_String(p));
        M(Memo,'');

     end else  // Reject notification
               // отказ сервера выдать статус этого UINа
               // (встречается очень редко)
     if (swap(p^.SNAC.FamilyID)=$3)and
        (swap(p^.SNAC.SubTypeID)=$0A) then begin
        M(Memo,'');
        M(Memo,'< Reject from UIN: '+PacketReadB_String(p));
        M(Memo,'');

     end else  // SNAC 15,3  
               // имеет много назначений:
               // - ответы с offlines messages
               // - ответы с UserInfo Results
               // - ответы с SearchUser Results
               // - и многое другое
     if (swap(p^.SNAC.FamilyID)=$15)and
        (swap(p^.SNAC.SubTypeID)=$3) then begin
        M(Memo,'');
        SNAC_15_3(p);
        M(Memo,'');

     end else  // SNAC 4,7  Входящие сообщения (всех типов)
     if (swap(p^.SNAC.FamilyID)=$4)and
        (swap(p^.SNAC.SubTypeID)=$7) then begin
        M(Memo,'');
        SNAC_4_7(p);
        M(Memo,'');

     end else begin  // и если, что-то еще не обрабатывается
        M(Memo,'');
        M(Memo,'???? Unrecognized SNAC: ????????');
        M(Memo,'???? SNAC [$'+inttohex(swap(p^.SNAC.FamilyID),2)+':$'+
                             inttohex(swap(p^.SNAC.SubTypeID),2)+']');
        M(Memo,'');
      end;
end;

Вы конечно же заметили, что я не очень подробно описывал структуру принимаемых и передаваемых SNAC-пакетов. Это огромнейшая тема. Лично я, при подготовке своих материалов черпал такую информацию на сайте:

в основном это информация из:

а также, (но в меньшей степени) из:

Чтобы картина работы приложения nICQ была более ясной, на следующей странице давайте рассмотрим ее на конкретном примере...

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay