DelphiHelp.org

procedure TForm1.AuthorizePart(p:PPack);
var ss : string;
    T : integer;
    tmp : PPack;
begin
     // позиционируемся на начало блока данных, пропустив заголовок
     PacketGoto(p,sizeof(FLAP_HDR));
     // если FLAP-данные содержат лишь 00000001,
     // то это самое начало сессии 
     if (swap(p^.Len)=4)and
        (swap(p^.SNAC.FamilyID)=0)and
        (swap(p^.SNAC.SubTypeID)=1) then begin
       M(Memo,'< Authorize Server CONNECT');
              // каждый раз, когда начинается новая TCP-сессия,
              // присваиваем SEQ случайное начальное значение
       SEQ := random($7FFF);       // в ответ надо передать пакет с UINом и паролем
       // создаем объект-пакет типа PPack: в нем формируется
       // FLAP-заголовок с Chanel_ID=1 
       tmp := CreatePacket(1,SEQ);
       // сначала надо вставить такой же DWORD=00000001
       // (еще надо помнить о порядке следования байтов в DWORD !!!)
       PacketAppend32(tmp,DSwap(1));
       // далее в поле данных добавляются несколько TLV
       // это наш UIN -  TLV(1)
       TLVAppendStr(tmp,$1,s(UIN));
       // и закодированный пароль - TLV(2) 
       TLVAppendStr(tmp,$2,Calc_Pass(PASSWORD));
       // описывать содержимое других TLV особого смысла нет
       TLVAppendStr(tmp,$3,
         'ICQ Inc. - Product of ICQ (TM).2000a.4.31.1.3143.85');
       TLVAppendWord(tmp,$16,$010A);
       TLVAppendWord(tmp,$17,$0004); // 4 - для ICQ2000a
       TLVAppendWord(tmp,$18,$001F);
       TLVAppendWord(tmp,$19,$0001);
       TLVAppendWord(tmp,$1A,$0C47);
       TLVAppendDWord(tmp,$14,$00000055);
       TLVAppendStr(tmp,$0F,'en');
       TLVAppendStr(tmp,$0E,'us');
       // посылаем пакет через  ClientSocket
       // (здесь tmp-пакет будет также и удален)
       PacketSend(tmp);
       M(Memo,'> Auth Request (Login)');

     end else  
     // на это сервер ответит так:
     // его ответ содержит TLV(1) - т.е. наш UIN
     if (TLVReadStr(p,ss)=1)and(ss=s(UIN))then begin
        // если это так, то считаем следующий TLV
        T := TLVReadStr(p,ss);
        case T of
          // если это TLV(5) - значит это адрес и порт основного сервера
          5: g>begin // BOS-IP:PORT
            M(Memo,'< Auth Responce (COOKIE)');
            // запоминаем и адрес и порт
            WorkAddress := copy(ss,1,pos(':',ss)-1);
            WorkPort := strtoint(copy(ss,pos(':',ss)+1,
                              length(ss)-pos(':',ss)));
            // за ними должен быть и TLV(6) - т.н. COOKIE (256 байт)
            // принимаем его прямо в переменную sCOOKIE
            // (он пригодится при коннекте к основному серверу)
            if (TLVReadStr(p,sCOOKIE)=6) then begin;
              // COOKIE получен и значит пора разъединяться
              // формируем пустой пакет с Channel_ID=4
              tmp:=CreatePacket(4,SEQ); // ChID=4
              // который и передаем
              PacketSend(tmp);
              // закрываем свой ClientSocket
              OfflineDiscconnect1Click(self);
              // говорим себе, что авторизация пройдена
              isAuth := false;
              // настраиваем ClientSocket на адрес:порт
              // основного (BOS) сервера
              CLI.Address := WorkAddress;
              CLI.Host := '';
              CLI.Port := WorkPort;
              M(Memo,'');
              M(Memo,'>>> Connecting to BOS: '+ss);
              // и коннектимся к нему
              CLI.Open;
{ ******************************************* }
{ в этом месте заканчивается этап авторизации }
{ ******************************************* }
            end;
          end;
          // а, например, в случае неверного UINа или пароля
          // мы получим TLV(4) и TLV(8)
          4,8: begin
               M(Memo,'< Auth ERROR');
               M(Memo,'TLV($'+inttohex(T,2)+') ERROR');
               M(Memo,'STRING: '+ss);
               if pos('http://',ss)>0 then begin
                 // и даже можем загрузить в браузер присланный нам URL
                 // с описанием ошибки
                 // Web.Navigate(ss); 
                 // {это навигатор с панели компонентов Делфи}
               end;
               TLVReadStr(p,ss); M(Memo,ss);
               // конечно же закрываем ClientSocket
               OfflineDiscconnect1Click(self);
               M(Memo,'');
             end;
        end;
     end;
end;