icqworks.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

  begin
    Result := Result + PChar(LongWord(Pkt) + Pkt^.Len)^;
    Inc(Pkt^.Len);
    Dec(StrLen);
    if Pkt^.Len > 8100 then Exit;
  end;
end;

function GetTLVStr(Pkt: PRawPkt; var T: Word): String;
var
  ISize: Word;
begin
  T := GetInt(Pkt, 2);          //Get type
  ISize := GetInt(Pkt, 2);      //Get data length
  Result := GetStr(Pkt, ISize); //Get data
end;

function GetTLVInt(Pkt: PRawPkt; var T: Word): LongWord;
var
  ISize: Word;
begin
  T := GetInt(Pkt, 2);          //Get type
  ISize := GetInt(Pkt, 2);      //Get data length
  Result := GetInt(Pkt, ISize); //Get data
end;

procedure GetSnac(Pkt: PRawPkt; var Snac: TSnacHdr);
begin
  Snac := PSnacHdr(LongWord(Pkt) + Pkt^.Len)^;
  Snac.Family := Swap16(Snac.Family);
  Snac.SubType := Swap16(Snac.SubType);
  Snac.ReqID := Swap32(Snac.ReqID);
  Inc(Pkt^.Len, TSNACSZ);
end;

function GetLStr(Pkt: PRawPkt): String;
begin
  Result := GetStr(Pkt, GetInt(Pkt, 1));
end;

function GetWStr(Pkt: PRawPkt): String;
begin
  Result := GetStr(Pkt, GetInt(Pkt, 2));
end;

function GetDWStr(Pkt: PRawPkt): String;
begin
  Result := GetStr(Pkt, GetLInt(Pkt, 4));
end;

function GetLNTS(Pkt: PRawPkt): String;
begin
  Result := GetStr(Pkt, GetLInt(Pkt, 2) - 1);
  Inc(Pkt^.Len, 1);
end;


{--------}
procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: LongWord); overload;
begin
  PktInt(Pkt, T, 2);  //Add type
  PktInt(Pkt, L, 2);  //Add length
  PktInt(Pkt, V, L);  //Add value
end;

procedure PktTLV(Pkt: PRawPkt; T: Word; const V: String); overload;
begin
  PktInt(Pkt, T, 2);            //Add type
  PktInt(Pkt, Length(V), 2);    //Add length
  PktStr(Pkt, V);               //Add value
end;

procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: Pointer); overload; //for arrays
begin
  PktInt(Pkt, T, 2);            //Add type
  PktInt(Pkt, L, 2);            //Add length
  PktAddArrBuf(Pkt, V, L);      //Add value
end;

procedure PktInit(Pkt: PRawPkt; Channel: Byte; var Seq: Word);
begin
  Pkt^.Len := 0;                //Starting size of packet to 0
  PktInt(Pkt, $2A, 1);          //Ident, always $2A
  PktInt(Pkt, Channel, 1);      //Channel
  PktInt(Pkt, SEQ, 2); Inc(SEQ);//Seq
  PktInt(Pkt, 0, 2);            //Reserved for size
end;


{$IFDEF USE_ASM}
procedure PktInitRaw(Pkt: PRawPkt); assembler;
asm
  mov   word ptr[eax + MAX_DATA_LEN], 0         //Default size of the packet
end;
{$ELSE}
procedure PktInitRaw(Pkt: PRawPkt);
begin
  Pkt^.Len := 0;                                //Default size of the packet
end;
{$ENDIF}


//Used with PktInit only
{$IFDEF USE_ASM}
procedure PktFinal(Pkt: PRawPkt); assembler;
asm
  mov   cx,word ptr[eax + MAX_DATA_LEN]
  sub   cx,TFLAPSZ
  rol   cx,8
  mov   word ptr[eax + 4], cx   //Store the packet size (without flap header size)
end;
{$ELSE}
procedure PktFinal(Pkt: PRawPkt);
begin
  PWord(LongWord(Pkt) + 4)^ := Swap16(Pkt.Len - TFLAPSZ); //Store the packet size (without flap header size)
end;
{$ENDIF}

procedure PktSnac(Pkt: PRawPkt; Family, SubType: Word; ID: LongWord; Flags: Word);
begin
  PktInt(Pkt, Family, 2);       //Snac family
  PktInt(Pkt, SubType, 2);      //Snac subtype
  PktInt(Pkt, Flags, 2);        //Snac flags
  PktInt(Pkt, ID, 4);           //Snac reference
end;

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
function StrToLanguageI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Languages) to High(Languages) do
    if Languages[i].Value = Value then
    begin
      Result := Languages[i].Ident;
      Exit;
    end;
  Result := 0;
end;

function StrToCountryI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Countries) to High(Countries) do
    if Countries[i].Value = Value then
    begin
      Result := Countries[i].Ident;
      Exit;
    end;
  Result := 0;
end;

function StrToInterestI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Interests) to High(Interests) do
    if Interests[i].Value = Value then
    begin
      Result := Interests[i].Ident;
      Exit;
    end;
  Result := 0;
end;

function StrToOccupationI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Occupations) to High(Occupations) do
    if Occupations[i].Value = Value then
    begin
      Result := Occupations[i].Ident;
      Exit;
    end;
  Result := 0;
end;

function StrToPastI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Pasts) to High(Pasts) do
    if Pasts[i].Value = Value then
    begin
      Result := Pasts[i].Ident;
      Exit;
    end;
  Result := 0;
end;

function StrToOrganizationI(const Value: String): Word;
var
  i: Word;
begin
  for i := Low(Organizations) to High(Organizations) do
    if Organizations[i].Value = Value then
    begin
      Result := Organizations[i].Ident;
      Exit;
    end;
  Result := 0;
end;

{Parse contacts responses.}
procedure ParseContacts(Value: String; var List: TStringList);
var
  i, l: Word;
  FName, FUIN: String;
begin
  l := 0; FName := ''; FUIN := '';
  if Length(Value) > Pos(#$fe, Value) + 1 then
    for i := Pos(#$fe, Value) + 1 to Length(Value) do
    begin
      if Value[i] = #$fe then
        Inc(l)
      else
      begin
        if l mod 2 = 0 then
          FName := FName + Value[i]
        else
          FUIN := FUIN + Value[i];
      end;
      if l = 2 then
      begin
        if (FName <> '') and (FUIN <> '') then
          List.Add(FName + '=' + FUIN);
        FName := '';
        FUIN := '';
        l := 0;
      end;
    end;
end;

{Create string representation of list with contacts.}
function MakeContactsStr(Contacts: TStringList): String;
var
  i, count: Word;
  S: String;
begin
  count := 0;
  S := '';
  if Contacts.Count > 0 then
    for i := 0 to Contacts.Count - 1 do
    begin
      if ExtractName(Contacts.Strings[i]) <> '' then
      begin
        S := S + ExtractName(Contacts.Strings[i]) + #$fe;
        if ExtractValue(Contacts.Strings[i]) = '' then
          S := S + ExtractName(Contacts.Strings[i]) + #$fe
        else
          S := S + ExtractValue(Contacts.Strings[i]) + #$fe;
        Inc(count);
      end;
    end;
  Result := IntToStr(count) + #$fe + S;
end;

{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
{The first packet sent by the client after connecting and receiving
the SRV_HELLO packet from the server. The packet basiclly identifies
what kind and version of client is connecting along with the user's
UIN and password.}
procedure CreateCLI_IDENT(Pkt: PRawPkt; UIN: LongWord; Password: String; var Seq: Word);
begin
  PktInit(Pkt, 1, Seq);                         //Channel 1
  PktInt(Pkt, 1, 4);                            //00 00 00 01
  PktTLV(Pkt, 1, IntToStr(UIN));                //Adding user's UIN

  ICQEncryptPassStr(Password);                  //Encrypt password
  PktTLV(Pkt, 2, Password);                     //Adding encrypted password

  PktTLV(Pkt, 3, 'ICQ Inc. - Product of ICQ (TM).2001b.5.15.1.3634.85');   //Cookie
  //Uknowns
  PktInt(Pkt, $00160002, 4); PktInt(Pkt, $010a, 2);
  PktInt(Pkt, $00170002, 4); PktInt(Pkt, $0005, 2);
  PktInt(Pkt, $00180002, 4); PktInt(Pkt, $000f, 2);
  PktInt(Pkt, $00190002, 4); PktInt(Pkt, $0001, 2);
  PktInt(Pkt, $001a0002, 4); PktInt(Pkt, $0e32, 2);
  PktInt(Pkt, $00140004, 4); PktInt(Pkt, $00000055, 4);
  PktTLV(Pkt, $000f, 'en');
  PktTLV(Pkt, $000e, 'us');
  PktFinal(Pkt);                                //Finalize packet
end;

{Sent as the first packet after the client has logged in
to the second server and received the SRV_HELLO packet.}
procedure CreateCLI_COOKIE(Pkt: PRawPkt; const Cookie: String; var Seq: Word);
begin
  PktInit(Pkt, 1, Seq);                         //Channel 1
  PktInt(Pkt, 1, 4);                            //00 00 00 01
  PktTLV(Pkt, 6, Cookie);                       //TLV(06) Cookie
  PktFinal(Pkt);                                //Finalize packet
end;

{This packet is a response to SNAC(1,3), SRV_FAMILIES. This tells
the server which SNAC families and their corresponding versions
which the client understands. This also seems to identify the client
as an ICQ vice AIM client to the server.}
procedure CreateCLI_FAMILIES(Pkt: PRawPkt; var Seq: Word);
begin
  PktInit(Pkt, 2, Seq);                         //Channel 2
  PktSnac(Pkt, 1, $17, 0, 0);                   //Snac: Type x01/x17, ID x0000, Flags 0
  PktInt(Pkt, $00010003, 4);                    //Family x01 is Version x03
  PktInt(Pkt, $00130002, 4);                    //Family x13 at Version x02
  PktInt(Pkt, $00020001, 4);                    //Family x02 at Version x01
  PktInt(Pkt, $00030001, 4);                    //Family x03 at Version x01
  PktInt(Pkt, $00150001, 4);                    //Family x15 at Version x01
  PktInt(Pkt, $00040001, 4);                    //Family x04 at Version x01
  PktInt(Pkt, $00060001, 4);                    //Family x06 at Version x01
  PktInt(Pkt, $00090001, 4);                    //Family x09 at Version x01
  PktInt(Pkt, $000A0001, 4);                    //Family x0A at Version x01
  PktInt(Pkt, $000B0001, 4);                    //Family x0B at Version x01
  PktFinal(Pkt);                                //Finalize packet
end;

{This packet requests from the server several bits of information most
likely regarding how fast certain packets can be sent to the server and
possibly a maximum packet size as well.}
procedure CreateCLI_RATESREQUEST(Pkt: PRawPkt; var Seq: Word);
begin
  PktInit(Pkt, 2, Seq);                         //Channel 2
  PktSnac(Pkt, $01, $06, 0, 0);                 //Snac: Type x01/x06, ID x0000, Flags 0
  PktFinal(Pkt);                                //Finalize packet
end;

{This packet is sent in response to the SRV_RATES SNAC(1,7). This