icqworks.pas

本程序是转载的

    Exit;
  end;
  PktInt(Pkt, Length(S), 2);
  PktStr(Pkt, S);
end;

procedure PktDWStr(Pkt: PRawPkt; const S: String);
begin
  PktLInt(Pkt, Length(S), 4);
  PktStr(Pkt, S);
end;

procedure PktLNTS(Pkt: PRawPkt; const S: String);
begin
  if Length(S) = 0 then
  begin
    PktInt(Pkt, 0, 2);
    Exit;
  end;
  PktLInt(Pkt, Length(S) + 1, 2);
  PktStr(Pkt, S);
  PktInt(Pkt, 0, 1);
end;

procedure PktLLNTS(Pkt: PRawPkt; const S: String);
begin
  if Length(S) = 0 then
  begin
    PktInt(Pkt, 0, 2);
    Exit;
  end;
  PktLInt(Pkt, Length(S) + 3, 2);
  PktLNTS(Pkt, S);
end;



{--}
function GetInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
var
  i: Word;
begin
  Result := 0;
  if IntSize = 0 then Exit;
  if Pkt^.Len > 8100 then Exit;
  for i := Pkt^.Len to Pkt^.Len + IntSize - 1 do
    Inc(Result, PByte(LongWord(Pkt) + i)^ shl ((Pkt^.Len + IntSize - 1 - i) * 8));
  Inc(Pkt^.Len, IntSize);
end;

function GetLInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
var
  i, c: Word;
begin
  Result := 0; c := 0;
  if IntSize = 0 then Exit;
  if Pkt^.Len > 8100 then Exit;
  for i := Pkt^.Len to Pkt^.Len + IntSize - 1 do
  begin
    Inc(Result, PByte(LongWord(Pkt) + Pkt^.Len + IntSize - c - 1)^ shl ((Pkt^.Len + IntSize - 1 - i) * 8));
    Inc(c);
  end;
  Inc(Pkt^.Len, IntSize);
end;

function GetStr(Pkt: PRawPkt; StrLen: Word): String;
begin
  Result := '';
  while StrLen > 0 do
  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);
  Snac.Flags := Swap16(Snac.Flags);
  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