icqworks.pas

本程序是转载的

    (Ident: 16; Value: 'Finnish'),
    (Ident: 17; Value: 'French'),
    (Ident: 18; Value: 'Gaelic'),
    (Ident: 19; Value: 'German'),
    (Ident: 20; Value: 'Greek'),
    (Ident: 21; Value: 'Hebrew'),
    (Ident: 22; Value: 'Hindi'),
    (Ident: 23; Value: 'Hungarian'),
    (Ident: 24; Value: 'Icelandic'),
    (Ident: 25; Value: 'Indonesian'),
    (Ident: 26; Value: 'Italian'),
    (Ident: 27; Value: 'Japanese'),
    (Ident: 28; Value: 'Khmer'),
    (Ident: 29; Value: 'Korean'),
    (Ident: 30; Value: 'Lao'),
    (Ident: 31; Value: 'Latvian'),
    (Ident: 32; Value: 'Lithuanian'),
    (Ident: 33; Value: 'Malay'),
    (Ident: 34; Value: 'Norwegian'),
    (Ident: 35; Value: 'Polish'),
    (Ident: 36; Value: 'Portuguese'),
    (Ident: 37; Value: 'Romanian'),
    (Ident: 38; Value: 'Russian'),
    (Ident: 39; Value: 'Serbo-Croatian'),
    (Ident: 40; Value: 'Slovak'),
    (Ident: 41; Value: 'Slovenian'),
    (Ident: 42; Value: 'Somali'),
    (Ident: 43; Value: 'Spanish'),
    (Ident: 44; Value: 'Swahili'),
    (Ident: 45; Value: 'Swedish'),
    (Ident: 46; Value: 'Tagalog'),
    (Ident: 47; Value: 'Tatar'),
    (Ident: 48; Value: 'Thai'),
    (Ident: 49; Value: 'Turkish'),
    (Ident: 50; Value: 'Ukrainian'),
    (Ident: 51; Value: 'Urdu'),
    (Ident: 52; Value: 'Vietnamese'),
    (Ident: 53; Value: 'Yiddish'),
    (Ident: 54; Value: 'Yoruba'),
    (Ident: 55; Value: 'Afrikaans'),
    (Ident: 56; Value: 'Bosnian'),
    (Ident: 57; Value: 'Persian'),
    (Ident: 58; Value: 'Albanian'),
    (Ident: 59; Value: 'Armenian'),
    (Ident: 60; Value: 'Punjabi'),
    (Ident: 61; Value: 'Chamorro'),
    (Ident: 62; Value: 'Mongolian'),
    (Ident: 63; Value: 'Mandarin'),
    (Ident: 64; Value: 'Taiwanese'),
    (Ident: 65; Value: 'Macedonian'),
    (Ident: 66; Value: 'Sindhi'),
    (Ident: 67; Value: 'Welsh'),
    (Ident: 68; Value: 'Azerbaijani'),
    (Ident: 69; Value: 'Kurdish'),
    (Ident: 70; Value: 'Gujarati'),
    (Ident: 71; Value: 'Tamil'),
    (Ident: 72; Value: 'Belorussian'),
    (Ident: 255; Value: 'Unknown'));

  Occupations: array[1..17] of record Ident: Byte; Value: String end =
    ((Ident: 1; Value: 'Academic'),
    (Ident: 2; Value: 'Administrative'),
    (Ident: 3; Value: 'Art/Entertainment'),
    (Ident: 4; Value: 'College Student'),
    (Ident: 5; Value: 'Computers'),
    (Ident: 6; Value: 'Community & Social'),
    (Ident: 7; Value: 'Education'),
    (Ident: 8; Value: 'Engineering'),
    (Ident: 9; Value: 'Financial Services'),
    (Ident: 10; Value: 'Government'),
    (Ident: 11; Value: 'High School Student'),
    (Ident: 12; Value: 'Home'),
    (Ident: 13; Value: 'ICQ - Providing Help'),
    (Ident: 14; Value: 'Law'),
    (Ident: 15; Value: 'Managerial'),
    (Ident: 16; Value: 'Manufacturing'),
    (Ident: 17; Value: 'Medical/Health'));

  Interests: array[100..150] of record Ident: Byte; Value: String end =
    ((Ident: 100; Value: 'Art'),
    (Ident: 101; Value: 'Cars'),
    (Ident: 102; Value: 'Celebrity Fans'),
    (Ident: 103; Value: 'Collections'),
    (Ident: 104; Value: 'Computers'),
    (Ident: 105; Value: 'Culture & Literature'),
    (Ident: 106; Value: 'Fitness'),
    (Ident: 107; Value: 'Games'),
    (Ident: 108; Value: 'Hobbies'),
    (Ident: 109; Value: 'ICQ - Providing Help'),
    (Ident: 110; Value: 'Internet'),
    (Ident: 111; Value: 'Lifestyle'),
    (Ident: 112; Value: 'Movies/TV'),
    (Ident: 113; Value: 'Music'),
    (Ident: 114; Value: 'Outdoor Activities'),
    (Ident: 115; Value: 'Parenting'),
    (Ident: 116; Value: 'Pets/Animals'),
    (Ident: 117; Value: 'Religion'),
    (Ident: 118; Value: 'Science/Technology'),
    (Ident: 119; Value: 'Skills'),
    (Ident: 120; Value: 'Sports'),
    (Ident: 121; Value: 'Web Design'),
    (Ident: 122; Value: 'Nature and Environment'),
    (Ident: 123; Value: 'News & Media'),
    (Ident: 124; Value: 'Government'),
    (Ident: 125; Value: 'Business & Economy'),
    (Ident: 126; Value: 'Mystics'),
    (Ident: 127; Value: 'Travel'),
    (Ident: 128; Value: 'Astronomy'),
    (Ident: 129; Value: 'Space'),
    (Ident: 130; Value: 'Clothing'),
    (Ident: 131; Value: 'Parties'),
    (Ident: 132; Value: 'Women'),
    (Ident: 133; Value: 'Social science'),
    (Ident: 134; Value: '60''s'),
    (Ident: 135; Value: '70''s'),
    (Ident: 136; Value: '80''s'),
    (Ident: 137; Value: '50''s'),
    (Ident: 138; Value: 'Finance and corporate'),
    (Ident: 139; Value: 'Entertainment'),
    (Ident: 140; Value: 'Consumer electronics'),
    (Ident: 141; Value: 'Retail stores'),
    (Ident: 142; Value: 'Health and beauty'),
    (Ident: 143; Value: 'Media'),
    (Ident: 144; Value: 'Household products'),
    (Ident: 145; Value: 'Mail order catalog'),
    (Ident: 146; Value: 'Business services'),
    (Ident: 147; Value: 'Audio and visual'),
    (Ident: 148; Value: 'Sporting and athletic'),
    (Ident: 149; Value: 'Publishing'),
    (Ident: 150; Value: 'Home automation'));

  RandGroups: array[1..11] of record Ident: Byte; Value: String end =
    ((Ident: 1; Value: 'General'),
    (Ident: 2; Value: 'Romance'),
    (Ident: 3; Value: 'Games'),
    (Ident: 4; Value: 'Students'),
    (Ident: 5; Value: '20 something'),
    (Ident: 6; Value: '30 something'),
    (Ident: 7; Value: '40 something'),
    (Ident: 8; Value: '50+'),
    (Ident: 9; Value: 'Romance'),
    (Ident: 10; Value: 'Man requesting woman'),
    (Ident: 11; Value: 'Woman requesting man'));

  Organizations: array[0..19] of record Ident: Word; Value: String end =
    ((Ident: 200; Value: 'Alumni Org.'),
    (Ident: 201; Value: 'Charity Org.'),
    (Ident: 202; Value: 'Club/Social Org.'),
    (Ident: 203; Value: 'Community Org.'),
    (Ident: 204; Value: 'Cultural Org.'),
    (Ident: 205; Value: 'Fan Clubs'),
    (Ident: 206; Value: 'Fraternity/Sorority'),
    (Ident: 207; Value: 'Hobbyists Org.'),
    (Ident: 208; Value: 'International Org.'),
    (Ident: 209; Value: 'Nature and Environment Org.'),
    (Ident: 210; Value: 'Professional Org.'),
    (Ident: 211; Value: 'Scientific/Technical Org.'),
    (Ident: 212; Value: 'Self Improvement Group'),
    (Ident: 213; Value: 'Spiritual/Religious Org.'),
    (Ident: 214; Value: 'Sports Org.'),
    (Ident: 215; Value: 'Support Org.'),
    (Ident: 216; Value: 'Trade and Business Org.'),
    (Ident: 217; Value: 'Union'),
    (Ident: 218; Value: 'Volunteer Org.'),
    (Ident: 299; Value: 'Other'));

  Pasts: array[0..7] of record Ident: Word; Value: String end =
    ((Ident: 300; Value: 'Elementary School'),
    (Ident: 301; Value: 'High School'),
    (Ident: 302; Value: 'College'),
    (Ident: 303; Value: 'University'),
    (Ident: 304; Value: 'Military'),
    (Ident: 305; Value: 'Past Work Place'),
    (Ident: 306; Value: 'Past Organization'),
    (Ident: 399; Value: 'Other'));



//------------------------------------------------------------------------------------------------------------\
//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Var
  gPortRange:TPortRange;
  
implementation
const
  FileSignature: array[0..15] of Byte = ($f0, $2d, $12, $d9, $30, $91, $d3, $11,
                                         $8d, $d7, $00, $10, $4b, $06, $46, $2e);

  ContactsSignature: array[0..15] of Byte = ($2a, $0e, $7d, $46, $76, $76, $d4, $11,
                                             $bc, $e6, $00, $04, $ac, $96, $1e, $a6);



function IntToStr(Value: Int64): String;
begin
  Str(Value, Result);
end;

function StrToInt(const Value: String): LongWord;
var
  nCode: Integer;
begin
  Val(Value, Result, nCode);
end;

const
  HexChars: array[0..15] of Char = ('0', '1', '2', '3', '4', '5',
                                    '6', '7', '8', '9', 'a', 'b',
                                    'c', 'd', 'e', 'f');

function IntToHex(Int: Int64; IntSize: Byte): String;
var
  n: Byte;
begin
  Result := '';
  for n := 0 to IntSize - 1 do
  begin
    Result := HexChars[Int and $F] + Result;
    Int := Int shr $4;
  end;
end;

function HexToInt(Value: String): LongWord;
const
  HexStr: String = '0123456789abcdef';
var
  i: Word;
begin
  Result := 0;
  if Value = '' then Exit;
  for i := 1 to Length(Value) do
    Inc(Result, (Pos(Value[i], HexStr) - 1) shl ((Length(Value) - i) shl 2));
end;

const
  TXorData: array[0..15] of Byte = (
    $F3, $26, $81, $C4, $39, $86, $DB, $92,
    $71, $A3, $B9, $E6, $53, $7A, $95, $7C
  );

procedure ICQEncryptPass(SrcBuf: Pointer; BufLen: LongWord); assembler;
asm
  or    edx,edx
  jz    @@end
@@loop:
  mov   cl,byte ptr[eax + edx - 1]
  xor   cl,byte ptr[TXorData + edx - 1]
  mov   byte ptr[eax + edx - 1],cl
  dec   edx
  jnz   @@loop
@@end:
end;

procedure ICQEncryptPassStr(var Pass: String);
var
  i: Word;
begin
  for i := 1 to Length(Pass) do
    Pass[i] := Chr(Ord(Pass[i]) xor TXorData[i - 1]);
end;

function Swap16(Value: Word): Word; assembler;
asm
  rol   ax,8
end;

function Swap32(Value: LongWord): LongWord; assembler;
asm
  bswap eax
end;

{----------------------------------------------}
//Adding data in reverse order
procedure PktAddData(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
var
  i: Word;
begin
  if DataLen = 0 then Exit;
  if Pkt^.Len + DataLen >= 8192 then
  begin
    DataLen := MAX_DATA_LEN - Pkt^.Len;
    if DataLen = 0 then Exit;
  end;
  for i := 0 to DataLen - 1 do
    PByte(LongWord(Pkt) + Pkt^.Len + i)^ := PByte(LongWord(Data) + DataLen - i - 1)^;
  Inc(Pkt^.Len, DataLen);
end;

//Adding data in direct order(local arrays, merging 2 or more packets)
procedure PktAddArrBuf(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
begin
  if (DataLen = 0) or (Pkt^.Len >= MAX_DATA_LEN) then
  begin
    Exit;
  end;
  if Pkt^.Len + DataLen >= 8192 then
  begin
    DataLen := MAX_DATA_LEN - Pkt^.Len;
    if DataLen = 0 then Exit;
  end;
  Move(Data^, Ptr(LongWord(Pkt) + Pkt^.Len)^, DataLen);
  Inc(Pkt^.Len, DataLen);
end;

procedure PktInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
begin
  PktAddData(Pkt, @Value, IntSize);
end;

procedure PktLInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
begin
  PktAddArrBuf(Pkt, @Value, IntSize);
end;

procedure PktStr(Pkt: PRawPkt; const S: String);
begin
  PktAddArrBuf(Pkt, @S[1], Length(S));
end;

procedure PktLStr(Pkt: PRawPkt; const S: String); overload;
begin
  PktInt(Pkt, Length(S), 1);
  PktStr(Pkt, S);
end;

procedure PktLStr(Pkt: PRawPkt; S: LongWord); overload;
begin
  PktLStr(Pkt, IntToStr(S));
end;

procedure PktWStr(Pkt: PRawPkt; const S: String);
begin
  if Length(S) = 0 then
  begin
    PktInt(Pkt, 0, 2);