icqworks.pas

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

    (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'));



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

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;
  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 then Exit;
  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
  if Length(S) = 0 then Exit;
  Move(PChar(S)^, Ptr(LongWord(Pkt) + Pkt.Len)^, Length(S));
  Inc(Pkt^.Len, 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);
    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