⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 icqworks.pas

📁 本程序是转载的
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit ICQWorks {TICQClient, TICQDb contants & procedures};
{(C) Alex Demchenko(alex@ritlabs.com)}

{$R-}                           //Remove range checking
{$DEFINE USE_ASM}               //Remove this line to use pascal code instead of assembler (where it's possible)

interface
uses
  Windows, Classes;

const
  MAX_DATA_LEN = 8192;          //Maximum packet size


  //Online statuses
  S_ONLINE      = $00000000;    //Online
  S_INVISIBLE   = $00000100;    //Invisible
  S_AWAY        = $00000001;    //Away
  S_NA          = $00000005;    //N/A
  S_OCCUPIED    = $00000011;    //Occupied
  S_DND         = $00000013;    //Do Not Disturb
  S_FFC         = $00000020;    //Free For Chat

  SF_BIRTH      = $00080000;    //Birtday

  //Flags used with statuses
  S_SHOWIP      = $00020000;    //show ip (for older clients), IP edit removed in ICQ2000a+ :)
  S_WEBAWARE    = $00030000;    //do not show status from the www
  S_ALLOWDCONN  = $00000000;    //allow direct connection with everyone
  S_ALLOWDAUTH  = $10000000;    //allow direct connection upon authorization
  S_ALLOWDLIST  = $20000000;    //allow direct connection with users in contact list

  //Message types
  M_PLAIN         = $01;        //Plain message
  M_CHAT          = $02;        //Chat request
  M_FILE          = $03;        //File request
  M_URL           = $04;        //URL
  M_AUTH_REQ      = $06;        //Auth request
  M_AUTH_DENIED   = $07;        //Deny auth
  M_AUTH_GIVEN    = $08;        //Authorize
  M_WEB_PAGE      = $0D;
  M_EMAIL_EXPRESS = $0E;
  M_CONTACTS      = $13;
  M_ADVANCED      = $1A;        //Seems to be an advanced-msg type (contacts, file requests, etc)

  //Genders
  GEN_FEMALE    = 1;            //Gender: Female
  GEN_MALE      = 2;            //Gender: Male

  //CLI_TOICQSRV commands
  CMD_ACKOFFMSG = $3E;
  CMD_REQOFFMSG = $3C;
  CMD_REQINFO   = $7D0;

  TFLAPSZ: Word = 6;            //Size of FLAP header
  TSNACSZ: Word = 10;           //Size of SNAC header

  //SRV UIN Flags
  U_NORMAL         = $0000;     //Normal list entry
  U_VISIBLE_LIST   = $0002;     //User in visible list
  U_INVISIBLE_LIST = $0003;     //User in invisible list
  U_IGNORE_LIST    = $000e;     //User in ignore list


  ACC_NORMAL      = $0;         //Normally accepted
  ACC_NO_OCCUPIED = $9;         //Not accepted, occupied
  ACC_NO_DND      = $A;         //Not accepted, dnd
  ACC_AWAY        = $4;         //Accepted but away
  ACC_NA          = $E;         //Accepted but NA
  ACC_CONTACTLST  = $C;         //Accepted to contact list (no blink in tray)

  //Auto message requests
  GET_AWAY        = $E8;        //Get away message
  GET_OCCUPIED    = $E9;        //Get occupied message
  GET_NA          = $EA;        //Get N/A message
  GET_DND         = $EB;        //Get DND message
  GET_FFC         = $EC;        //Get FFC(Free For Chat) message

  //Buddy types
  BUDDY_NORMAL    = $0000;      //A normal contact list entry
  BUDDY_GROUP     = $0001;      //A larger group header
  BUDDY_IGNORE    = $000e;      //A contact on the ignore list
  BUDDY_INVISIBLE = $0003;      //A contact on the invisible list
  BUDDY_VISIBLE   = $0002;      //A contact on the visible list

  //SSL errors
  ERRSSL_NOTFOUND = $0002;      //User not found
  ERRSSL_EXISTS   = $0003;      //Added buddy already exists
  ERRSSL_AUTH     = $000e;      //User not authorized
  ERRSSL_OTHER    = $000a;      //Other SSL error
  ERRSSL_NOERROR  = $0000;      //No error (changed successfully)

  // Client Capabilities
  CAPS_ICQ           = $01;
  CAPS_ICQRTF        = $02;
  CAPS_ICQSERVERRELAY = $04;
  CAPS_2001          = $08;
  CAPS_2001a         = $10;

  ICQClientVer_Major = 1;       //Major version of component
  ICQClientVer_Minor = 19;      //Minor version of component
  ICQClientVER_Build = 'b';

type
  //File request record
  TFTRequestRec = record
    ReqType: Byte;
    ITime, IRandomID: LongWord;
    UIN: LongWord;
    Description: String;
    FileName: String;
    FileSize: LongWord;
    Seq: Word;
    Port: Word;
  end;

  //File start record
  TFTStartRec = record
    UIN: LongWord;
    FilesCount: LongWord;
    Current: Integer;
    Speed: LongWord;
  end;
  // File Send DC Record
  TSendFileRec = Record
    UIN:LongWord;
    Nick:String;
    Seq:Word;
    Files:TStrings;
    FilesCurrent:Integer;
    FilesCount:LongWord;
    FilePath:String;
    FileName:String;
    FileDescription:String;
    FileSize:LongWord;
    TotalSize:LongWord;
    Port:Word;
    Speed:Byte;
  End;
  pSendFileRec = ^TSendFileRec;

  // Port Range to support firewalls
  TPortRange = Record
    First:Word;
    Last: Word;
  End;

//Error types
  TErrorType = (ERR_SOCKET, ERR_INTERNAL, ERR_WARNING, ERR_PROXY, ERR_PROTOCOL, ERR_CONNTIMEOUT, ERR_LOGIN);

  //Proxy types
  TProxyType = (P_NONE, P_SOCKS4, P_SOCKS5, P_HTTPS, P_HTTP);

  //Info types
  TInfoType = (INFO_GENERAL, INFO_MORE, INFO_ABOUT, INFO_PASSWORD);

  //Database types, used in ICQDb.pas
  TDbType = (DB_ICQ, DB_MIRANDA);

  //Flap header
  PFlapHdr = ^TFlapHdr;
  TFlapHdr = record
    Ident: Byte;
    ChID: Byte;
    Seq: Word;
    DataLen: Word;
  end;

  //Snac header
  PSnacHdr = ^TSnacHdr;
  TSnacHdr = record
    Family: Word;
    SubType: Word;
    Flags: Word;
    ReqID: LongWord;
  end;

  //Raw packet
  PRawPkt = ^TRawPkt;
  TRawPkt = record
    Data: array[0..MAX_DATA_LEN - 1] of Byte;
    Len: Word;
  end;

  TThreadTimerTrigger = class(TThread)
  protected
    fInterval:LongInt;
    fOnTrigger:TNotifyEvent;
    Procedure Trigger;
    procedure Execute; override;
  Public
    Owner:TObject;

    Property Interval:LongInt read fInterval write fInterval;
    Property OnTrigger:TNotifyEvent read fOnTrigger write fOnTrigger;
  end;

  TTHreadTimer = Class(TObject)
  private
    fActive:Boolean;
    fInterval:LongInt;
    fOnTimer:TNotifyEvent;
    fTrigger:TThreadTimerTrigger;

    Procedure SetActive(Const IsActive:Boolean);
    Procedure SetInterval(Const aInterval:LongInt);
    Procedure SetOnTimer(Const aOnTimer:TNotifyEvent);
  public
    constructor Create;
    destructor Destroy; override;

    Property Enabled:Boolean read fActive write SetActive;
    Property Interval:LongInt read fInterval write SetInterval;
    Property OnTimer:TNotifyEvent read fOnTimer write SetOnTimer;
  end;

  //Filetransfer init call back function
  TOnFTInit = procedure(Sender: TObject; UIN: LongWord; FileCount, TotalBytes, Speed: LongWord; NickName: String) of object;
  TOnFTStart = procedure(Sender: TObject; StartRec: TFTStartRec; FileName: String; FileSize, Speed: LongWord) of object;
  TOnFTFileData = procedure(Sender: TObject; UIN: LongWord; Data: Pointer; DataLen: LongWord; LastPacket: Boolean) of object;

  TOnSendFileStart = Procedure(Sender: TObject; UIN: LongWord; SendFileRec: TSendFileRec) of Object;
  TOnSendFileData  = Procedure (Sender: TObject; UIN:LongWord; Data: Pointer;Var DataLen: LongWord; Var IsLastPacket: Boolean) of Object;
  TOnSendFileFinish= Procedure (Sender: TObject; UIN: LongWord; SendFileRec: TSendFileRec; Aborted:Boolean) of Object;

function IntToStr(Value: Int64): String;
function StrToInt(const Value: String): LongWord;
function IntToHex(Int: Int64; IntSize: Byte): String;
function HexToInt(Value: String): LongWord;
procedure ICQEncryptPass(SrcBuf: Pointer; BufLen: LongWord);
procedure ICQEncryptPassStr(var Pass: String);
function Swap16(Value: Word): Word;
function Swap32(Value: LongWord): LongWord;

{Low-level functions}
{-- Adding data --}
procedure PktAddData(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
procedure PktAddArrBuf(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
procedure PktInit(Pkt: PRawPkt; Channel: Byte; var Seq: Word);
procedure PktInitRaw(Pkt: PRawPkt);
procedure PktFinal(Pkt: PRawPkt);
procedure PktSnac(Pkt: PRawPkt; Family, SubType: Word; ID: LongWord; Flags: Word);
procedure PktInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
procedure PktLInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
procedure PktStr(Pkt: PRawPkt; const S: String);
procedure PktLStr(Pkt: PRawPkt; const S: String); overload;
procedure PktLStr(Pkt: PRawPkt; S: LongWord); overload;
procedure PktWStr(Pkt: PRawPkt; const S: String);
procedure PktDWStr(Pkt: PRawPkt; const S: String);
procedure PktLNTS(Pkt: PRawPkt; const S: String);
procedure PktLLNTS(Pkt: PRawPkt; const S: String);
procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: LongWord); overload;
procedure PktTLV(Pkt: PRawPkt; T: Word; const V: String); overload;
procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: Pointer); overload;

{-- Extracting data --}
function GetInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
function GetLInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
function GetStr(Pkt: PRawPkt; StrLen: Word): String;
function GetTLVStr(Pkt: PRawPkt; var T: Word): String;
function GetTLVInt(Pkt: PRawPkt; var T: Word): LongWord;
procedure GetSnac(Pkt: PRawPkt; var Snac: TSnacHdr);
function GetLStr(Pkt: PRawPkt): String;
function GetWStr(Pkt: PRawPkt): String;
function GetDWStr(Pkt: PRawPkt): String;
function GetLNTS(Pkt: PRawPkt): String;


{High-level functions}
function StrToLanguageI(const Value: String): Word;
function StrToCountryI(const Value: String): Word;
function StrToInterestI(const Value: String): Word;
function StrToOccupationI(const Value: String): Word;
function StrToPastI(const Value: String): Word;
function StrToOrganizationI(const Value: String): Word;
procedure ParseContacts(Value: String; var List: TStringList);
function MakeContactsStr(Contacts: TStringList): String;

{Packet creation functions}
procedure CreateCLI_IDENT(Pkt: PRawPkt; UIN: LongWord; Password: String; var Seq: Word);
procedure CreateCLI_COOKIE(Pkt: PRawPkt; const Cookie: String; var Seq: Word);
procedure CreateCLI_FAMILIES(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_RATESREQUEST(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_ACKRATES(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQINFO(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQUNKNOWN(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQROSTER(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_CHECKROSTER(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQLOCATION(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQBUDDY(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REQICBM(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_SETSTATUS(Pkt: PRawPkt; Status: LongWord; IP: LongInt; Port: Word; Cookie: LongWord; ProxyType: TProxyType; var Seq: Word);
procedure CreateCLI_SETSTATUS_SHORT(Pkt: PRawPkt; Status: LongWord; var Seq: Word);
procedure CreateCLI_REQBOS(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_SETUSERINFO(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_SETICBM(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_READY(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_TOICQSRV(Pkt: PRawPkt; UIN: LongWord; Command: Word; Data: Pointer; DataLen: LongWord; var Seq, Seq2: Word);
procedure CreateCLI_ADDCONTACT(Pkt: PRawPkt; UIN: String; var Seq: Word);
procedure CreateCLI_ADDCONTACT_MULTI(Pkt: PRawPkt; UINs: array of LongWord; var Seq: Word);
procedure CreateCLI_REMOVECONTACT(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
procedure CreateCLI_ADDVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
procedure CreateCLI_REMVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
procedure CreateCLI_ADDINVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
procedure CreateCLI_REMINVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
procedure CreateCLI_ACKOFFLINEMSGS(Pkt: PRawPkt; UIN: LongWord; var Seq, Seq2: Word);
procedure CreateCLI_SENDMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; var Seq: Word);
procedure CreateCLI_SENDURL(Pkt: PRawPkt; ITime, IRandom, MyUIN, UIN: LongWord; const URL, Description: String; var Seq: Word);
procedure CreateCLI_AUTHORIZE(Pkt: PRawPkt; UIN: LongWord; Auth: Byte; Reason: String; var Seq: Word);
procedure CreateCLI_METAREQINFO(Pkt: PRawPkt; UIN, dUIN: LongWord; var Seq, Seq2: Word);
procedure CreateCLI_SEARCHBYMAIL(Pkt: PRawPkt; UIN: LongWord; const Email: String; var Seq, Seq2: Word);
procedure CreateCLI_SEARCHBYUIN(Pkt: PRawPkt; UIN: LongWord; DUIN: LongWord; var Seq, Seq2: Word);
procedure CreateCLI_SEARCHBYNAME(Pkt: PRawPkt; UIN: LongWord; const FirstName, LastName, NickName, Email: String; var Seq, Seq2: Word);
procedure CreateCLI_SEARCHRANDOM(Pkt: PRawPkt; UIN: LongWord; Group: Word; var Seq, Seq2: Word);
procedure CreateCLI_SEARCHWP(Pkt: PRawPkt; UIN: LongWord; First, Last, Nick, Email: String; MinAge, MaxAge: Word; Gender: Byte; Language: Byte; City: String; Country: Word; Company, Department, Position: String; Occupation: Byte; Organization: Word; OrganKeyWords: String; Affiliation: Word; AffiKeyWords, KeyWord: String; Online: Byte; var Seq, Seq2: Word);
procedure CreateCLI_METASETMORE(Pkt: PRawPkt; UIN: LongWord; Age: Word; Gender: Byte; HomePage: String; BirthYear: Word; BirthMonth, BirthDay, Lang1, Lang2, Lang3: Byte; var Seq, Seq2: Word);
procedure CreateCLI_METASETGENERAL(Pkt: PRawPkt; UIN: LongWord; const NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street, Cellular, Zip: String; Country: Word; TimeZone: Byte; PublishEmail: Boolean; var Seq, Seq2: Word);
procedure CreateCLI_METASETABOUT(Pkt: PRawPkt; UIN: LongWord; const About: String; var Seq, Seq2: Word);
procedure CreateCLI_SENDSMS(Pkt: PRawPkt; UIN: LongWord; const Destination, Text: String; CodePage: Word; const Time: String; var Seq, Seq2: Word);
procedure CreateCLI_SENDMSG_ADVANCED(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; RTFFormat: Boolean; var Seq: Word);
procedure CreateCLI_SENDMSG_FILEACK(Pkt: PRawPkt; FFSeq: Word; ITime, IRandom, UIN, FileSize: LongWord; const FileDesc, FileName: String; Port: Word; var Seq: Word);
procedure CreateCLI_SENDMSG_FILEDECLINE(Pkt: PRawPkt; FFSeq: Word; ITime, IRandom, UIN, FileSize: LongWord; const FileDesc, FileName, Reason: String; Port: Word; var Seq: Word);
procedure CreateCLI_HELLO(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_GOODBYE(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_REGISTERUSER(Pkt: PRawPkt; const Password: String; var Seq: Word);
procedure CreateCLI_REQAWAYMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; Status: Byte; var Seq: Word);
procedure CreateCLI_SENDCONTACTS(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; Contacts: TStringList; var Seq: Word);
procedure CreateCLI_SENDCONTACTS_REQ(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; Reason: String; var Seq: Word);
procedure CreateCLI_UNREGUIN(Pkt: PRawPkt; UIN: LongWord; const Password: String; var Seq, Seq2: Word);
procedure CreateCLI_METASETPASS(Pkt: PRawPkt; UIN: LongWord; const Password: String; Buffer: Pointer; BufLen: Word; var Seq, Seq2: Word);
procedure CreateCLI_METASETPERMISSIONS(Pkt: PRawPkt; UIN: LongWord; AuthorizationRequired, WebAware: Boolean; var Seq, Seq2: Word);
procedure CreateCLI_METAREQINFO_SHORT(Pkt: PRawPkt; UIN, DestUIN: LongWord; var Seq, Seq2: Word);
procedure CreateCLI_REQAUTH(Pkt: PRawPkt; UIN: LongWord; Msg: String; var Seq: Word);
procedure CreateCLI_KEEPALIVE(Pkt: PRawPkt; var Seq: Word);
procedure CreateCLI_ADDSTART(Pkt: PRawPkt; FirstUpload: Boolean; var Seq: Word);
procedure CreateCLI_ADDEND(Pkt: PRawPkt; var Seq: Word);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -