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


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

Приходит на ICQ сообщение:
- Do you wanna chat?
- I'm busy.
- Hello, busy. I'm Abraham!...

Урок №2

Передача сообщений

Уверен, что у вас не возникло никаких проблем со скачиванием, с компиляцией, с "конфигурированием" первого проекта. Если вы вписывали в файл nICQ.ini свой пароль, то коннект был обеспечен.

Урок №2 содержит два новых модуля. SendMess и MessFrom. Каждый из них имеет свое окно. Это - передача и прием сообщений.

Чтобы полноценно передавать сообщения, необходим и такой объект в основном окне, как список контактов. Объект TTreeView напрашивается сам. Проще некуда. Тем более каждый элемент в нем может содержать указатель на связанные данные. TTreeView меня полностью устроил.

Сам список контактов будет хранится в файле <ваш_uin>.dat

Т.к. сейчас рассматриваетя только урок №2, то и заполняться этот файл будет пока только вручную. При его заполнении вполне можно пренебречь процедурой авторизации.


[ContactList]
199111222=1st_User
199111333=2nd_User
199111444=3rd_User
345345234=Иван Иваныч
188888888=Вася Пупкин
и т.д. и т.п.

Вписывайте UINов столько, сколько нужно. Только не забудьте увеличить массив TContactList, если UINов планируете больше сотни:


type TContactList = array[0..100] of TListRecord;

И еще пару слов относительно интерфейса: те кому надоели зелененькие цветочки - могут нарисовать свои значки для контактного списка. Bitmapы прилагаются.

Теперь о том как реально передаются сообщения.

Есть два типа передаваемых сообщений: Simple Message и Advanced Message.

Если UIN (для которого предназначено сообщение) находится в оффлайне - то ему шлется Simple Message. Advanced Message посылаются тем адресатам, (кажется ) если версия аськи у них не ниже ICQ2000. Из формата Advanced Message в уроке №2 используется лишь информация о Foreground Color и Background Color (это цвета раскраски текста). Использовал бы еще что-нибудь, так там больше ничего нет такого, что можно назвать advanced.

При передаче, сообщения пакуются в SNAC(4,06).

Начнем с более простого формата - Simple Message:

FLAP
Command Start 2A
Channel ID 02
Sequence Number 34 3B
Data Field Length 00 3D
SNAC (4, 06) - Send Message (Simple)
Family ID 00 04
SubType ID 00 06
Flags[0] 00
Flags[1] 00
Request ID 00 AD 00 06

53 DE 53 75
Cookie 1
16 14 BB 50 Cookie 2
00 01 msg-format: Simple Message
09
длина его UINа почти как
PascalStr
31 39 39
37 37 37
36 36 36
его UIN
(например: '199777666')
TLV (2) - сообщение здесь
T ype 00 02
L ength 00 17
V alue 05 01 00 01 01 01 01 (unk) ???
00 0E длина сообщения
+ 4
00 00 00 00 (unk) ???
D1 EE EE E1 F9 E5 ED E8 E5 21 'Сообщение!'
TLV (6) - пустой
T ype 00 06
L ength 00 00


Продолжим более сложным форматом - Advanced Message. А он действительно по-сложнее будет.

FLAP
Command Start 2A
Channel ID 02
Sequence Number 0C A3
Data Field Length 00 99
SNAC (4, 06) - Send Message (Advanced)
Family ID 00 04
SubType ID 00 06
Flags[0] 00
Flags[1] 00
Request ID 00 C3 00 06
1C D3 C4 B7
Cookie 1
23 4D 75 95 Cookie 2
00 02 msg-format: Advanced Message
09
длина его UINа почти как
PascalStr
31 39 39
37 37 37
36 36 36
его UIN
(например: '199777666')
TLV (5)
T ype 00 05
L ength 00 73
V alue 00 00 00 00 - для посылки сообщения
1C D3 C4 B7 Cookie 1
23 4D 75 95 Cookie 1
09 46 13 49
4C 7F 11 D1
82 22 44 45
53 54 00 00
4 DWORD
наши возможности ???
(capability)
TLV (A)
T ype 00 0A
L ength 00 02
V alue 00 01 00 01 - для посылки сообщения
TLV (F) - пустой (???)
T ype 00 0F
L ength 00 00
TLV (2711) - сообщение здесь
T ype 27 11
L ength 00 4B
V alue 1B 00 07 00 00
00 00 00 00 00
00 00 00 00 00
00 00 00 00 00
00 00 03 00 00
00
26 байт (unk)
00  
FF FF  
0E 00  
FF FF  
00 00 00 00 00
00 00 00 00 00
00 00
12 байт (unk)
01 msg-subtype ( 01-обычное )
00  
00 00  
01 00  
0E 00 длина сообщения тело
сообщения
D1 EE EE E1 F9 E5 ED E8 E5 20 B9 32 2E (00) 'Сообщение №2.'
80 00 80 00 foreground color
FF FF 00 00 background color


TLV (3) - пустой
T ype 00 03
L ength 00 00 TLV(3) посылается, как запрос подтверждения


Что касается кода, то мудровать с формированием TLV я не стал. Зато получилось дешево и сердито. Одним словом - это все работает.

unit SendMess;


procedure TMessageTo.SendButtonClick(Sender: TObject);
var sNN,sMess,sUIN : string;
    tmp : PPack;
    sTmp : string;
    d1,d2 : longint;
    buf : TByteArray;
    ind,indmem : word;
const capab : string{16}= #$09#$46#$13#$49#$4C#$7F#$11#$D1+
                          #$82#$22#$44#$45#$53#$54#$00#$00;
      blok : string{26} = #$1B#$00#$07#$00#$00#$00#$00#$00+
                          #$00#$00#$00#$00#$00#$00#$00#$00+
                          #$00#$00#$00#$00#$00#$00#$03#$00+
                          #$00#$00;
     x:word=0;
begin
     sNN := NNEd.Text;
     sUIN := ICQEd.Text;
     if SendMemo.Lines.Count = 0 then exit;
     sMess := SendMemo.Text;

     // создаем новый FLAP
     tmp := CreatePacket(2,SEQ);
     // добавляем SNAC(4,6)
     SNACAppend(tmp,$4,$6);
     // генерируем Cookie-1 и Cookie-2
     d1:=random($7FFFFFFF);
     d2:=random($7FFFFFFF);
     // запоминаем их: по ним мы узнаем ACKи от сервера и клиента
     SEQ1:=dswap(d1);
     SEQ2:=dswap(d2);
     PacketAppend32(tmp,dswap(d1));
     PacketAppend32(tmp,dswap(d2));

     // проверяем какой тип сообщения выбран     case MesFmtBox.Checked of
     true:
      begin
      // advanced message
      // 0002 - advanced
        PacketAppend16(tmp,swap($0002));
        // кому ?
        // дальше, вся последовательность формируется
        // в дополнительном буфере buf
        PacketAppendB_String(tmp,sUIN);
        // TLV(5) + его длина, которую впишем в конце
        ind:=0;fillchar(buf,sizeof(buf),'^');
        PLONG(@(buf[ind]))^:=dswap($0005FFFF);inc(ind,4);
        // Cookie-1 и Cookie-2
        PWORD(@(buf[ind]))^:=0;inc(ind,2);
        PLONG(@(buf[ind]))^:=dswap(d1);inc(ind,4);
        PLONG(@(buf[ind]))^:=dswap(d2);inc(ind,4);
        // Capability
        MOVE(capab[1],buf[ind],length(capab));inc(ind,length(capab));
        //TLV(A)=0001
        PLONG(@(buf[ind]))^:=dswap($000A0002);inc(ind,4);
        PWORD(@(buf[ind]))^:=swap($0001);inc(ind,2);
        //TLV(F)-пустой
        PLONG(@(buf[ind]))^:=dswap($000F0000);inc(ind,4);

        // TLV(2711) + его длина, которую впишем в конце
        PLONG(@(buf[ind]))^:=dswap($2711FFFF);inc(ind,4);
        indmem:=ind-2;
        // 16 байт
        MOVE(blok[1],buf[ind],length(blok));inc(ind,length(blok));
        PBYTE(@(buf[ind]))^:=0;inc(ind,1);
        PWORD(@(buf[ind]))^:=swap($FFFF);inc(ind,2);
        PWORD(@(buf[ind]))^:=swap($0E00);inc(ind,2);
        PWORD(@(buf[ind]))^:=swap($FFFF);inc(ind,2);
        // 12 байт = 0
        PLONG(@(buf[ind]))^:=$00000000;inc(ind,4);
        PLONG(@(buf[ind]))^:=$00000000;inc(ind,4);
        PLONG(@(buf[ind]))^:=$00000000;inc(ind,4);
        // под-Тип сообщения = 1 (обычное)
        PBYTE(@(buf[ind]))^:=1;inc(ind,1);

        PBYTE(@(buf[ind]))^:=0;inc(ind,1);
        PWORD(@(buf[ind]))^:=swap($0000);inc(ind,2);
        PWORD(@(buf[ind]))^:=swap($0100);inc(ind,2);
        // длина сообщения
        PWORD(@(buf[ind]))^:=length(sMess)+1;inc(ind,2);
        // сообщение
        move(sMess[1],buf[ind],length(sMess));inc(ind,length(sMess));
        // завершающий ноль
        PBYTE(@(buf[ind]))^:=0;inc(ind,1);
        // foreground color
        PLONG(@(buf[ind]))^:=dswap(GetColor(SendMemo,FG));inc(ind,4);
        // background color
        PLONG(@(buf[ind]))^:=dswap(GetColor(SendMemo,BG));inc(ind,4);

        // вписываем фактическую длину в TLV(5)
        PWORD(@(buf[2]))^:=swap(ind-4);
        // подсчитывем фактическую длину TLV(2711)
        x:=length(blok)+27+length(sMess)+9;
        // ... и вписывем ее
        PWORD(@(buf[indmem]))^:=swap(x);

        // пепеносим данные с buf в FLAP
        PacketAppend(tmp,@buf,ind);
        // ack request ? (запрос подтверждения)
        // TLV(3)-пустой
        PacketAppend32(tmp,dswap($00030000));
      end;

     false:
      g>begin // simple message
        // 0001 - simple
        PacketAppend16(tmp,swap($0001));
        // кому ?
        PacketAppendB_String(tmp,sUIN);
        // tlv(2)
        PacketAppend16(tmp,swap(2));
        // длина tlv(2)
        PacketAppend16(tmp,swap(13+length(sMess)));
        // 7 байт
        PacketAppend32(tmp,dswap($05010001));
        PacketAppend16(tmp,swap($0101));
        PacketAppend8(tmp,$01);
        // длина сообщения + 4
        PacketAppend16(tmp,swap(4+length(sMess)));
        // 4 байта = 0
        PacketAppend32(tmp,dswap($0));
        // сообщение
        PacketAppend(tmp,@(sMess[1]),length(sMess));
        // tlv(6) - пустой
        PacketAppend16(tmp,swap($0006));
        PacketAppend16(tmp,0);
      end;
     end;
     //case
     // посылаем пакет
     Form1.PacketSend(tmp);
     M(SendMemo,'Sending...');

     // пишем в журнал
     case MesFmtBox.Checked of
       // A - advanced
       true:  sTmp := '[A] ';
       // S - simple
       false: sTmp := '[S] ';
     end;
     // тут и так ясно
     sTmp := '->'+sTmp+DateTimeToStr(Now)+' '+
                  sNN+' ['+sUIN+']  "'+sMess+'"';
     M(Form1.Memo,sTmp);       Form1.LogMessage(sTmp);

     if MesFmtBox.Checked then begin
       // если advanced
       SendAnime.Active := true;
       SendMemo.Enabled := false;
       SendButton.Enabled := false;
       MesFmtBox.Enabled := false;
       // окно закроется только после получения
       // ACKов от сервера и от клиента (или вручную)
     end
     else
       // если simple, то окно сразу закрывается
       Close;
end;

Исходники Урока №2 здесь.

На следующей странице уделено внимание приему сообщений.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.