home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / ICQ.ZIP / ICQ / Component / ICQWorks.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-08-16  |  136.2 KB  |  3,476 lines
  1. unit ICQWorks;
  2. {(C) Alex Demchenko(alex@ritlabs.com)}
  3. {$R-}
  4.  
  5. interface
  6. uses
  7.   Windows, Classes;
  8.  
  9. const
  10.   MAX_DATA_LEN = 8192;          //Maximum packet size
  11.  
  12.  
  13.   //Online statuses
  14.   S_ONLINE      = $00000000;    //Online
  15.   S_INVISIBLE   = $00000100;    //Invisible
  16.   S_AWAY        = $00000001;    //Away
  17.   S_NA          = $00000005;    //N/A
  18.   S_OCCUPIED    = $00000011;    //Occupied
  19.   S_DND         = $00000013;    //Do Not Disturb
  20.   S_FFC         = $00000020;    //Free For Chat
  21.  
  22.   //Flags used with statuses
  23.   S_SHOWIP      = $00020000;    //show ip (for older clients), IP edit removed in ICQ2000a+ :)
  24.   S_WEBAWARE    = $00030000;    //do not show status from the www
  25.   S_ALLOWDCONN  = $00000000;    //allow direct connection with everyone
  26.   S_ALLOWDAUTH  = $10000000;    //allow direct connection upon authorization
  27.   S_ALLOWDLIST  = $20000000;    //allow direct connection with users in contact list
  28.  
  29.   //Message types
  30.   M_PLAIN         = $01;
  31.   M_CHAT          = $02;
  32.   M_URL           = $04;
  33.   M_AUTH_REQ      = $06;
  34.   M_AUTH_DENIED   = $07;
  35.   M_AUTH_GIVEN    = $08;
  36.   M_WEB_PAGE      = $0D;
  37.   M_EMAIL_EXPRESS = $0E;
  38.   M_CONTACTS      = $13;
  39.   M_GREETING      = $1A;
  40.  
  41.   //Genders
  42.   GEN_FEMALE    = 1;            //Gender: Female
  43.   GEN_MALE      = 2;            //Gender: Male
  44.  
  45.   //CLI_TOICQSRV commands
  46.   CMD_ACKOFFMSG = $3E;
  47.   CMD_REQOFFMSG = $3C;
  48.   CMD_REQINFO   = $7D0;
  49.  
  50.   TFLAPSZ = 6;                  //Size of FLAP header
  51.   TSNACSZ = 10;                 //Size of SNAC header
  52.  
  53.   //SRV UIN Flags
  54.   U_NORMAL         = $0000;     //Normal list entry
  55.   U_VISIBLE_LIST   = $0002;     //User in visible list
  56.   U_INVISIBLE_LIST = $0003;     //User in invisible list
  57.   U_IGNORE_LIST    = $000e;     //User in ignore list
  58.  
  59.  
  60.   ACC_NORMAL      = $0;         //Normally accepted
  61.   ACC_NO_OCCUPIED = $9;         //Not accepted, occupied
  62.   ACC_NO_DND      = $A;         //Not accepted, dnd
  63.   ACC_AWAY        = $4;         //Accepted but away
  64.   ACC_NA          = $E;         //Accepted but NA
  65.   ACC_CONTACTLST  = $C;         //Accepted to contact list (no blink in tray)
  66.  
  67.   //Auto message requests
  68.   GET_AWAY        = $E8;        //Get away message
  69.   GET_OCCUPIED    = $E9;        //Get occupied message
  70.   GET_NA          = $EA;        //Get N/A message
  71.   GET_DND         = $EB;        //Get DND message
  72.   GET_FFC         = $EC;        //Get FFC(Free For Chat) message
  73.  
  74.   //Buddy types
  75.   BUDDY_NORMAL    = $0000;      //A normal contact list entry
  76.   BUDDY_GROUP     = $0001;      //A larger group header
  77.   BUDDY_IGNORE    = $000e;      //A contact on the ignore list
  78.   BUDDY_INVISIBLE = $0003;      //A contact on the invisible list
  79.   BUDDY_VISIBLE   = $0002;      //A contact on the visible list
  80.  
  81.   //SSL errors
  82.   ERRSSL_NOTFOUND = $0002;      //User not found
  83.   ERRSSL_EXISTS   = $0003;      //Added buddy already exists
  84.   ERRSSL_AUTH     = $000e;      //User not authorized
  85.   ERRSSL_OTHER    = $000a;      //Other SSL error
  86.   ERRSSL_NOERROR  = $0000;      //No error (changed successfully)
  87.  
  88.  
  89. type
  90.   //Error types
  91.   TErrorType = (ERR_SOCKET, ERR_INTERNAL, ERR_WARNING, ERR_PROXY, ERR_PROTOCOL, ERR_CONNTIMEOUT, ERR_LOGIN);
  92.  
  93.   //Proxy types
  94.   TProxyType = (P_NONE, P_SOCKS4, P_SOCKS5);
  95.  
  96.   //Info types
  97.   TInfoType = (INFO_GENERAL, INFO_MORE, INFO_ABOUT);
  98.  
  99.   //Database types, used in ICQDb.pas
  100.   TDbType = (DB_ICQ, DB_MIRANDA);
  101.  
  102.   //Flap header
  103.   PFlapHdr = ^TFlapHdr;
  104.   TFlapHdr = record
  105.     Ident: Byte;
  106.     ChID: Byte;
  107.     Seq: Word;
  108.     DataLen: Word;
  109.   end;
  110.  
  111.   //Snac header
  112.   PSnacHdr = ^TSnacHdr;
  113.   TSnacHdr = record
  114.     Family: Word;
  115.     SubType: Word;
  116.     Flags: array[0..1] of Byte;
  117.     ReqID: LongWord;
  118.   end;
  119.  
  120.   //Raw packet
  121.   PRawPkt = ^TRawPkt;
  122.   TRawPkt = record
  123.     Data: array[0..MAX_DATA_LEN - 1] of Byte;
  124.     Len: Word;
  125.   end;
  126.  
  127.  
  128. function IntToStr(Value: Int64): String;
  129. function StrToInt(const Value: String): LongWord;
  130. function IntToHex(Int: Int64; IntSize: Byte): String;
  131. function HexToInt(Value: String): LongWord;
  132. procedure ICQEncryptPass(SrcBuf: Pointer; BufLen: LongWord);
  133. procedure ICQEncryptPassStr(var Pass: String);
  134. function Swap16(Value: Word): Word;
  135. function Swap32(Value: LongWord): LongWord;
  136.  
  137. {Low-level functions}
  138. {-- Adding data --}
  139. procedure PktAddData(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
  140. procedure PktAddArrBuf(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
  141. procedure PktInit(Pkt: PRawPkt; Channel: Byte; var Seq: Word);
  142. procedure PktInitRaw(Pkt: PRawPkt);
  143. procedure PktFinal(Pkt: PRawPkt);
  144. procedure PktSnac(Pkt: PRawPkt; Family, SubType: Word; ID: LongWord; Flags: Word);
  145. procedure PktInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
  146. procedure PktLInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
  147. procedure PktStr(Pkt: PRawPkt; const S: String);
  148. procedure PktLStr(Pkt: PRawPkt; const S: String);
  149. procedure PktWStr(Pkt: PRawPkt; const S: String);
  150. procedure PktLNTS(Pkt: PRawPkt; const S: String);
  151. procedure PktLLNTS(Pkt: PRawPkt; const S: String);
  152. procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: LongWord); overload;
  153. procedure PktTLV(Pkt: PRawPkt; T: Word; const V: String); overload;
  154. procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: Pointer); overload;
  155.  
  156. {-- Extracting data --}
  157. function GetInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
  158. function GetLInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
  159. function GetStr(Pkt: PRawPkt; StrLen: Word): String;
  160. function GetTLVStr(Pkt: PRawPkt; var T: Word): String;
  161. function GetTLVInt(Pkt: PRawPkt; var T: Word): LongWord;
  162. procedure GetSnac(Pkt: PRawPkt; var Snac: TSnacHdr);
  163. function GetLStr(Pkt: PRawPkt): String;
  164. function GetWStr(Pkt: PRawPkt): String;
  165. function GetLNTS(Pkt: PRawPkt): String;
  166.  
  167.  
  168. {High-level functions}
  169. function StrToLanguageI(const Value: String): Word;
  170. function StrToCountryI(const Value: String): Word;
  171. function StrToInterestI(const Value: String): Word;
  172. function StrToOccupationI(const Value: String): Word;
  173. function StrToPastI(const Value: String): Word;
  174. function StrToAffiliationI(const Value: String): Word;
  175.  
  176. {Packet creation functions}
  177. procedure CreateCLI_IDENT(Pkt: PRawPkt; UIN: LongWord; Password: String; var Seq: Word);
  178. procedure CreateCLI_COOKIE(Pkt: PRawPkt; const Cookie: String; var Seq: Word);
  179. procedure CreateCLI_FAMILIES(Pkt: PRawPkt; var Seq: Word);
  180. procedure CreateCLI_RATESREQUEST(Pkt: PRawPkt; var Seq: Word);
  181. procedure CreateCLI_ACKRATES(Pkt: PRawPkt; var Seq: Word);
  182. procedure CreateCLI_REQINFO(Pkt: PRawPkt; var Seq: Word);
  183. procedure CreateCLI_REQUNKNOWN(Pkt: PRawPkt; var Seq: Word);
  184. procedure CreateCLI_REQROSTER(Pkt: PRawPkt; var Seq: Word);
  185. procedure CreateCLI_CHECKROSTER(Pkt: PRawPkt; var Seq: Word);
  186. procedure CreateCLI_REQLOCATION(Pkt: PRawPkt; var Seq: Word);
  187. procedure CreateCLI_REQBUDDY(Pkt: PRawPkt; var Seq: Word);
  188. procedure CreateCLI_REQICBM(Pkt: PRawPkt; var Seq: Word);
  189. procedure CreateCLI_SETSTATUS(Pkt: PRawPkt; Status: LongWord; IP: LongInt; Port: Word; Cookie: LongWord; ProxyType: TProxyType; var Seq: Word);
  190. procedure CreateCLI_SETSTATUS_SHORT(Pkt: PRawPkt; Status: LongWord; var Seq: Word);
  191. procedure CreateCLI_REQBOS(Pkt: PRawPkt; var Seq: Word);
  192. procedure CreateCLI_SETUSERINFO(Pkt: PRawPkt; var Seq: Word);
  193. procedure CreateCLI_SETICBM(Pkt: PRawPkt; var Seq: Word);
  194. procedure CreateCLI_READY(Pkt: PRawPkt; var Seq: Word);
  195. procedure CreateCLI_TOICQSRV(Pkt: PRawPkt; UIN: LongWord; Command: Word; Data: Pointer; DataLen: LongWord; var Seq, Seq2: Word);
  196. procedure CreateCLI_ADDCONTACT(Pkt: PRawPkt; UIN: String; var Seq: Word);
  197. procedure CreateCLI_REMOVECONTACT(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  198. procedure CreateCLI_ADDVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
  199. procedure CreateCLI_REMVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  200. procedure CreateCLI_ADDINVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
  201. procedure CreateCLI_REMINVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  202. procedure CreateCLI_ACKOFFLINEMSGS(Pkt: PRawPkt; UIN: LongWord; var Seq, Seq2: Word);
  203. procedure CreateCLI_SENDMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; var Seq: Word);
  204. procedure CreateCLI_SENDURL(Pkt: PRawPkt; ITime, IRandom, MyUIN, UIN: LongWord; const URL, Description: String; var Seq: Word);
  205. procedure CreateCLI_AUTHORIZE(Pkt: PRawPkt; UIN: LongWord; Auth: Byte; Reason: String; var Seq: Word);
  206. procedure CreateCLI_METAREQINFO(Pkt: PRawPkt; UIN, dUIN: LongWord; var Seq, Seq2: Word);
  207. procedure CreateCLI_SEARCHBYMAIL(Pkt: PRawPkt; UIN: LongWord; const Email: String; var Seq, Seq2: Word);
  208. procedure CreateCLI_SEARCHBYUIN(Pkt: PRawPkt; UIN: LongWord; DUIN: LongWord; var Seq, Seq2: Word);
  209. procedure CreateCLI_SEARCHBYNAME(Pkt: PRawPkt; UIN: LongWord; const FirstName, LastName, NickName, Email: String; var Seq, Seq2: Word);
  210. procedure CreateCLI_SEARCHRANDOM(Pkt: PRawPkt; UIN: LongWord; Group: Word; var Seq, Seq2: Word);
  211. procedure CreateCLI_SEARCHWP(Pkt: PRawPkt; UIN: LongWord; First, Last, Nick, Email: String; MinAge, MaxAge: Word; Gender: Byte; Language: Byte; City, State: String; Country: Word; Company, Department, Position: String; Occupation: Byte; Past: Word; PastDesc: String; Interests: Word; InterDesc: String; Affiliation: Word; AffiDesc: String; HomePage: String; Online: Byte; var Seq, Seq2: Word);
  212. 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);
  213. 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);
  214. procedure CreateCLI_METASETABOUT(Pkt: PRawPkt; UIN: LongWord; const About: String; var Seq, Seq2: Word);
  215. procedure CreateCLI_SENDSMS(Pkt: PRawPkt; UIN: LongWord; const Destination, Text: String; CodePage: Word; const Time: String; var Seq, Seq2: Word);
  216. procedure CreateCLI_SENDMSG_ADVANCED(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; RTFFormat: Boolean; var Seq: Word);
  217. procedure CreateCLI_HELLO(Pkt: PRawPkt; var Seq: Word);
  218. procedure CreateCLI_GOODBYE(Pkt: PRawPkt; var Seq: Word);
  219. procedure CreateCLI_REGISTERUSER(Pkt: PRawPkt; const Password: String; var Seq: Word);
  220. procedure CreateCLI_REQAWAYMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; Status: Byte; var Seq: Word);
  221. procedure CreateCLI_UNREGUIN(Pkt: PRawPkt; UIN: LongWord; const Password: String; var Seq, Seq2: Word);
  222. procedure CreateCLI_METASETPASS(Pkt: PRawPkt; UIN: LongWord; const Password: String; var Seq, Seq2: Word);
  223. procedure CreateCLI_METASETPERMISSIONS(Pkt: PRawPkt; UIN: LongWord; AuthorizationRequired, WebAware: Boolean; var Seq, Seq2: Word);
  224. procedure CreateCLI_REQAUTH(Pkt: PRawPkt; UIN: LongWord; Msg: String; var Seq: Word);
  225. procedure CreateCLI_KEEPALIVE(Pkt: PRawPkt; var Seq: Word);
  226. procedure CreateCLI_ADDSTART(Pkt: PRawPkt; FirstUpload: Boolean; var Seq: Word);
  227. procedure CreateCLI_ADDEND(Pkt: PRawPkt; var Seq: Word);
  228. procedure CreateCLI_UPDATEGROUP(Pkt: PRawPkt; Name: String; Tag: Word; IDs: TStringList; var Seq: Word);
  229. procedure CreateCLI_UPDATEBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized: Boolean; var Seq: Word);
  230. procedure CreateCLI_ADDBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized: Boolean; var Seq: Word);
  231. procedure CreateCLI_DELETEBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized, IsGroup: Boolean; var Seq: Word);
  232.  
  233.  
  234.  
  235. {Misc functions}
  236. function SnacToStr(Family, SubType: Word): String;
  237. function SrvMetaToStr(V1, V2: Word): String;
  238. function PeerCmdToStr(Cmd: Byte): String;
  239. function DumpPacket(Buffer: Pointer; BufLen: Word): String;
  240. function Rtf2Txt(const Value: String): String;
  241. function StatusToStr(Value: LongWord): String;
  242. function CountryToStr(Value: Word): String;
  243. function LanguageToStr(Value: Byte): String;
  244. function OccupationToStr(Value: Word): String;
  245. function InterestToStr(Value: Word): String;
  246. function PastToStr(Value: Word): String;
  247. function AffiliationToStr(Value: Word): String;
  248. function LoadPacketRaw(Pkt: PRawPkt; const FName: String): Boolean;
  249. function LoadPacket(Pkt: PRawPkt; const FName: String; var Flap: TFlapHdr; var Snac: TSnacHdr): Boolean;
  250. function FileExists(const FileName: String): Boolean;
  251. function FileSize(const FName: String): LongWord;
  252. procedure LogText(const FName, Text: String);
  253. procedure ShowMessage(const Value: String); overload;
  254. procedure ShowMessage(Value: LongWord); overload;
  255. function ExtractName(const Value: String): String;
  256. function ExtractValue(const Value: String): String;
  257. function UTF8ToStr(Value: String): String;
  258. function UTF8ToStrSmart(Value: String): String;
  259. function GetXMLEntry(const Tag, Msg: String): String;
  260.  
  261. {SMS functions}
  262. function StrToUTF8(Value: String): String;
  263. function GetSMSTime: String;
  264.  
  265. function DecryptPak(Pak: Pointer; Size: LongWord; Ver: Byte): Boolean;
  266. procedure EncryptPak(Pak: Pointer; Size: LongWord; Ver: Byte);
  267.  
  268. procedure CreatePEER_INIT(Pkt: PRawPkt; Cookie, DestUIN, SrcUIN, SrcPort, SrcIPExt, SrcIPInt: LongWord; ProxyType: TProxyType);
  269. procedure CreatePEER_INIT2(Pkt: PRawPkt; Ack: Boolean);
  270. procedure CreatePEER_ACK(Pkt: PRawPkt);
  271. function CreatePEER_MSG(Pkt: PRawPkt; const Msg: String; RTFFormat: Boolean; var Seq: Word): Word;
  272. procedure CreatePEER_MSGACK(Pkt: PRawPkt; Seq: Word);
  273. procedure CreatePEER_AUTOMSG_ACK(Pkt: PRawPkt; Answer: String; Status, Seq: Word);
  274. function CreatePEER_CONTACTS(Pkt: PRawPkt; Contacts: TStringList; var Seq: Word): Word;
  275. function CreatePEER_CONTACTREQ(Pkt: PRawPkt; const Reason: String; var Seq: Word): Word;
  276.  
  277. function Decrypt99bPassword(UIN, CryptIV: LongWord; const HexPass: String): String;
  278. function DecryptMirandaPassword(const Value: String): String;
  279.  
  280. //Text constants
  281. //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  282. //------------------------------------------------------------------------------------------------------------\
  283. const
  284.   Countries: array[0..242] of record Ident: Word; Value: String end =
  285.     ((Ident: 1; Value: 'USA'),
  286.     (Ident: 7; Value: 'Russia'),
  287.     (Ident: 20; Value: 'Egypt'),
  288.     (Ident: 27; Value: 'South Africa'),
  289.     (Ident: 30; Value: 'Greece'),
  290.     (Ident: 31; Value: 'Netherlands'),
  291.     (Ident: 32; Value: 'Belgium'),
  292.     (Ident: 33; Value: 'France'),
  293.     (Ident: 34; Value: 'Spain'),
  294.     (Ident: 36; Value: 'Hungary'),
  295.     (Ident: 39; Value: 'Italy'),
  296.     (Ident: 40; Value: 'Romania'),
  297.     (Ident: 41; Value: 'Switzerland'),
  298.     (Ident: 42; Value: 'Czech Republic'),
  299.     (Ident: 43; Value: 'Austria'),
  300.     (Ident: 44; Value: 'United Kingdom'),
  301.     (Ident: 45; Value: 'Denmark'),
  302.     (Ident: 46; Value: 'Sweden'),
  303.     (Ident: 47; Value: 'Norway'),
  304.     (Ident: 48; Value: 'Poland'),
  305.     (Ident: 49; Value: 'Germany'),
  306.     (Ident: 51; Value: 'Peru'),
  307.     (Ident: 52; Value: 'Mexico'),
  308.     (Ident: 53; Value: 'Cuba'),
  309.     (Ident: 54; Value: 'Argentina'),
  310.     (Ident: 55; Value: 'Brazil'),
  311.     (Ident: 56; Value: 'Chile'),
  312.     (Ident: 57; Value: 'Colombia'),
  313.     (Ident: 58; Value: 'Venezuela'),
  314.     (Ident: 60; Value: 'Malaysia'),
  315.     (Ident: 61; Value: 'Australia'),
  316.     (Ident: 62; Value: 'Indonesia'),
  317.     (Ident: 63; Value: 'Philippines'),
  318.     (Ident: 64; Value: 'New Zealand'),
  319.     (Ident: 65; Value: 'Singapore'),
  320.     (Ident: 66; Value: 'Thailand'),
  321.     (Ident: 81; Value: 'Japan'),
  322.     (Ident: 82; Value: 'Korea (Republic of)'),
  323.     (Ident: 84; Value: 'Vietnam'),
  324.     (Ident: 86; Value: 'China'),
  325.     (Ident: 90; Value: 'Turkey'),
  326.     (Ident: 91; Value: 'India'),
  327.     (Ident: 92; Value: 'Pakistan'),
  328.     (Ident: 93; Value: 'Afghanistan'),
  329.     (Ident: 94; Value: 'Sri Lanka'),
  330.     (Ident: 95; Value: 'Myanmar'),
  331.     (Ident: 98; Value: 'Iran'),
  332.     (Ident: 101; Value: 'Anguilla'),
  333.     (Ident: 102; Value: 'Antigua'),
  334.     (Ident: 103; Value: 'Bahamas'),
  335.     (Ident: 104; Value: 'Barbados'),
  336.     (Ident: 105; Value: 'Bermuda'),
  337.     (Ident: 106; Value: 'British Virgin Islands'),
  338.     (Ident: 107; Value: 'Canada'),
  339.     (Ident: 108; Value: 'Cayman Islands'),
  340.     (Ident: 109; Value: 'Dominica'),
  341.     (Ident: 110; Value: 'Dominican Republic'),
  342.     (Ident: 111; Value: 'Grenada'),
  343.     (Ident: 112; Value: 'Jamaica'),
  344.     (Ident: 113; Value: 'Montserrat'),
  345.     (Ident: 114; Value: 'Nevis'),
  346.     (Ident: 115; Value: 'St. Kitts'),
  347.     (Ident: 116; Value: 'St. Vincent and the Grenadines'),
  348.     (Ident: 117; Value: 'Trinidad and Tobago'),
  349.     (Ident: 118; Value: 'Turks and Caicos Islands'),
  350.     (Ident: 120; Value: 'Barbuda'),
  351.     (Ident: 121; Value: 'Puerto Rico'),
  352.     (Ident: 122; Value: 'Saint Lucia'),
  353.     (Ident: 123; Value: 'United States Virgin Islands'),
  354.     (Ident: 212; Value: 'Morocco'),
  355.     (Ident: 213; Value: 'Algeria'),
  356.     (Ident: 216; Value: 'Tunisia'),
  357.     (Ident: 218; Value: 'Libya'),
  358.     (Ident: 220; Value: 'Gambia'),
  359.     (Ident: 221; Value: 'Senegal Republic'),
  360.     (Ident: 222; Value: 'Mauritania'),
  361.     (Ident: 223; Value: 'Mali'),
  362.     (Ident: 224; Value: 'Guinea'),
  363.     (Ident: 225; Value: 'Ivory Coast'),
  364.     (Ident: 226; Value: 'Burkina Faso'),
  365.     (Ident: 227; Value: 'Niger'),
  366.     (Ident: 228; Value: 'Togo'),
  367.     (Ident: 229; Value: 'Benin'),
  368.     (Ident: 230; Value: 'Mauritius'),
  369.     (Ident: 231; Value: 'Liberia'),
  370.     (Ident: 232; Value: 'Sierra Leone'),
  371.     (Ident: 233; Value: 'Ghana'),
  372.     (Ident: 234; Value: 'Nigeria'),
  373.     (Ident: 235; Value: 'Chad'),
  374.     (Ident: 236; Value: 'Central African Republic'),
  375.     (Ident: 237; Value: 'Cameroon'),
  376.     (Ident: 238; Value: 'Cape Verde Islands'),
  377.     (Ident: 239; Value: 'Sao Tome and Principe'),
  378.     (Ident: 240; Value: 'Equatorial Guinea'),
  379.     (Ident: 241; Value: 'Gabon'),
  380.     (Ident: 242; Value: 'Congo'),
  381.     (Ident: 243; Value: 'Dem. Rep. of the Congo'),
  382.     (Ident: 244; Value: 'Angola'),
  383.     (Ident: 245; Value: 'Guinea-Bissau'),
  384.     (Ident: 246; Value: 'Diego Garcia'),
  385.     (Ident: 247; Value: 'Ascension Island'),
  386.     (Ident: 248; Value: 'Seychelle Islands'),
  387.     (Ident: 249; Value: 'Sudan'),
  388.     (Ident: 250; Value: 'Rwanda'),
  389.     (Ident: 251; Value: 'Ethiopia'),
  390.     (Ident: 252; Value: 'Somalia'),
  391.     (Ident: 253; Value: 'Djibouti'),
  392.     (Ident: 254; Value: 'Kenya'),
  393.     (Ident: 255; Value: 'Tanzania'),
  394.     (Ident: 256; Value: 'Uganda'),
  395.     (Ident: 257; Value: 'Burundi'),
  396.     (Ident: 258; Value: 'Mozambique'),
  397.     (Ident: 260; Value: 'Zambia'),
  398.     (Ident: 261; Value: 'Madagascar'),
  399.     (Ident: 262; Value: 'Reunion Island'),
  400.     (Ident: 263; Value: 'Zimbabwe'),
  401.     (Ident: 264; Value: 'Namibia'),
  402.     (Ident: 265; Value: 'Malawi'),
  403.     (Ident: 266; Value: 'Lesotho'),
  404.     (Ident: 267; Value: 'Botswana'),
  405.     (Ident: 268; Value: 'Swaziland'),
  406.     (Ident: 269; Value: 'Mayotte Island'),
  407.     (Ident: 290; Value: 'St. Helena'),
  408.     (Ident: 291; Value: 'Eritrea'),
  409.     (Ident: 297; Value: 'Aruba'),
  410.     (Ident: 298; Value: 'Faeroe Islands'),
  411.     (Ident: 299; Value: 'Greenland'),
  412.     (Ident: 350; Value: 'Gibraltar'),
  413.     (Ident: 351; Value: 'Portugal'),
  414.     (Ident: 352; Value: 'Luxembourg'),
  415.     (Ident: 353; Value: 'Ireland'),
  416.     (Ident: 354; Value: 'Iceland'),
  417.     (Ident: 355; Value: 'Albania'),
  418.     (Ident: 356; Value: 'Malta'),
  419.     (Ident: 357; Value: 'Cyprus'),
  420.     (Ident: 358; Value: 'Finland'),
  421.     (Ident: 359; Value: 'Bulgaria'),
  422.     (Ident: 370; Value: 'Lithuania'),
  423.     (Ident: 371; Value: 'Latvia'),
  424.     (Ident: 372; Value: 'Estonia'),
  425.     (Ident: 373; Value: 'Moldova'),
  426.     (Ident: 374; Value: 'Armenia'),
  427.     (Ident: 375; Value: 'Belarus'),
  428.     (Ident: 376; Value: 'Andorra'),
  429.     (Ident: 377; Value: 'Monaco'),
  430.     (Ident: 378; Value: 'San Marino'),
  431.     (Ident: 379; Value: 'Vatican City'),
  432.     (Ident: 380; Value: 'Ukraine'),
  433.     (Ident: 381; Value: 'Yugoslavia'),
  434.     (Ident: 385; Value: 'Croatia'),
  435.     (Ident: 386; Value: 'Slovenia'),
  436.     (Ident: 387; Value: 'Bosnia and Herzegovina'),
  437.     (Ident: 389; Value: 'F.Y.R.O.M. (Former Yugoslav Republic of Macedonia)'),
  438.     (Ident: 500; Value: 'Falkland Islands'),
  439.     (Ident: 501; Value: 'Belize'),
  440.     (Ident: 502; Value: 'Guatemala'),
  441.     (Ident: 503; Value: 'El Salvador'),
  442.     (Ident: 504; Value: 'Honduras'),
  443.     (Ident: 505; Value: 'Nicaragua'),
  444.     (Ident: 506; Value: 'Costa Rica'),
  445.     (Ident: 507; Value: 'Panama'),
  446.     (Ident: 508; Value: 'St. Pierre and Miquelon'),
  447.     (Ident: 509; Value: 'Haiti'),
  448.     (Ident: 590; Value: 'Guadeloupe'),
  449.     (Ident: 591; Value: 'Bolivia'),
  450.     (Ident: 592; Value: 'Guyana'),
  451.     (Ident: 593; Value: 'Ecuador'),
  452.     (Ident: 594; Value: 'French Guiana'),
  453.     (Ident: 595; Value: 'Paraguay'),
  454.     (Ident: 596; Value: 'Martinique'),
  455.     (Ident: 597; Value: 'Suriname'),
  456.     (Ident: 598; Value: 'Uruguay'),
  457.     (Ident: 599; Value: 'Netherlands Antilles'),
  458.     (Ident: 670; Value: 'Saipan Island'),
  459.     (Ident: 671; Value: 'Guam'),
  460.     (Ident: 672; Value: 'Christmas Island'),
  461.     (Ident: 673; Value: 'Brunei'),
  462.     (Ident: 674; Value: 'Nauru'),
  463.     (Ident: 675; Value: 'Papua New Guinea'),
  464.     (Ident: 676; Value: 'Tonga'),
  465.     (Ident: 677; Value: 'Solomon Islands'),
  466.     (Ident: 678; Value: 'Vanuatu'),
  467.     (Ident: 679; Value: 'Fiji Islands'),
  468.     (Ident: 680; Value: 'Palau'),
  469.     (Ident: 681; Value: 'Wallis and Futuna Islands'),
  470.     (Ident: 682; Value: 'Cook Islands'),
  471.     (Ident: 683; Value: 'Niue'),
  472.     (Ident: 684; Value: 'American Samoa'),
  473.     (Ident: 685; Value: 'Western Samoa'),
  474.     (Ident: 686; Value: 'Kiribati Republic'),
  475.     (Ident: 687; Value: 'New Caledonia'),
  476.     (Ident: 688; Value: 'Tuvalu'),
  477.     (Ident: 689; Value: 'French Polynesia'),
  478.     (Ident: 690; Value: 'Tokelau'),
  479.     (Ident: 691; Value: 'Micronesia, Federated States of'),
  480.     (Ident: 692; Value: 'Marshall Islands'),
  481.     (Ident: 705; Value: 'Kazakhstan'),
  482.     (Ident: 706; Value: 'Kyrgyz Republic'),
  483.     (Ident: 708; Value: 'Tajikistan'),
  484.     (Ident: 709; Value: 'Turkmenistan'),
  485.     (Ident: 711; Value: 'Uzbekistan'),
  486.     (Ident: 800; Value: 'International Freephone Service'),
  487.     (Ident: 850; Value: 'Korea (North)'),
  488.     (Ident: 852; Value: 'Hong Kong'),
  489.     (Ident: 853; Value: 'Macau'),
  490.     (Ident: 855; Value: 'Cambodia'),
  491.     (Ident: 856; Value: 'Laos'),
  492.     (Ident: 870; Value: 'INMARSAT'),
  493.     (Ident: 871; Value: 'INMARSAT (Atlantic-East)'),
  494.     (Ident: 872; Value: 'INMARSAT (Pacific)'),
  495.     (Ident: 873; Value: 'INMARSAT (Indian)'),
  496.     (Ident: 874; Value: 'INMARSAT (Atlantic-West)'),
  497.     (Ident: 880; Value: 'Bangladesh'),
  498.     (Ident: 886; Value: 'Taiwan, Republic of China'),
  499.     (Ident: 960; Value: 'Maldives'),
  500.     (Ident: 961; Value: 'Lebanon'),
  501.     (Ident: 962; Value: 'Jordan'),
  502.     (Ident: 963; Value: 'Syria'),
  503.     (Ident: 964; Value: 'Iraq'),
  504.     (Ident: 965; Value: 'Kuwait'),
  505.     (Ident: 966; Value: 'Saudi Arabia'),
  506.     (Ident: 967; Value: 'Yemen'),
  507.     (Ident: 968; Value: 'Oman'),
  508.     (Ident: 971; Value: 'United Arab Emirates'),
  509.     (Ident: 972; Value: 'Israel'),
  510.     (Ident: 973; Value: 'Bahrain'),
  511.     (Ident: 974; Value: 'Qatar'),
  512.     (Ident: 975; Value: 'Bhutan'),
  513.     (Ident: 976; Value: 'Mongolia'),
  514.     (Ident: 977; Value: 'Nepal'),
  515.     (Ident: 994; Value: 'Azerbaijan'),
  516.     (Ident: 995; Value: 'Georgia'),
  517.     (Ident: 2691; Value: 'Comoros'),
  518.     (Ident: 4101; Value: 'Liechtenstein'),
  519.     (Ident: 4201; Value: 'Slovak Republic'),
  520.     (Ident: 5399; Value: 'Guantanamo Bay'),
  521.     (Ident: 5901; Value: 'French Antilles'),
  522.     (Ident: 6101; Value: 'Cocos-Keeling Islands'),
  523.     (Ident: 6701; Value: 'Rota Island'),
  524.     (Ident: 6702; Value: 'Tinian Island'),
  525.     (Ident: 6721; Value: 'Australian Antarctic Territory'),
  526.     (Ident: 6722; Value: 'Norfolk Island'),
  527.     (Ident: 9999; Value: 'Unknown'));
  528.  
  529.   Languages: array[0..72] of record Ident: Byte; Value: String end =
  530.     ((Ident: 1; Value: 'Arabic'),
  531.     (Ident: 2; Value: 'Bhojpuri'),
  532.     (Ident: 3; Value: 'Bulgarian'),
  533.     (Ident: 4; Value: 'Burmese'),
  534.     (Ident: 5; Value: 'Cantonese'),
  535.     (Ident: 6; Value: 'Catalan'),
  536.     (Ident: 7; Value: 'Chinese'),
  537.     (Ident: 8; Value: 'Croatian'),
  538.     (Ident: 9; Value: 'Czech'),
  539.     (Ident: 10; Value: 'Danish'),
  540.     (Ident: 11; Value: 'Dutch'),
  541.     (Ident: 12; Value: 'English'),
  542.     (Ident: 13; Value: 'Esperanto'),
  543.     (Ident: 14; Value: 'Estonian'),
  544.     (Ident: 15; Value: 'Farci'),
  545.     (Ident: 16; Value: 'Finnish'),
  546.     (Ident: 17; Value: 'French'),
  547.     (Ident: 18; Value: 'Gaelic'),
  548.     (Ident: 19; Value: 'German'),
  549.     (Ident: 20; Value: 'Greek'),
  550.     (Ident: 21; Value: 'Hebrew'),
  551.     (Ident: 22; Value: 'Hindi'),
  552.     (Ident: 23; Value: 'Hungarian'),
  553.     (Ident: 24; Value: 'Icelandic'),
  554.     (Ident: 25; Value: 'Indonesian'),
  555.     (Ident: 26; Value: 'Italian'),
  556.     (Ident: 27; Value: 'Japanese'),
  557.     (Ident: 28; Value: 'Khmer'),
  558.     (Ident: 29; Value: 'Korean'),
  559.     (Ident: 30; Value: 'Lao'),
  560.     (Ident: 31; Value: 'Latvian'),
  561.     (Ident: 32; Value: 'Lithuanian'),
  562.     (Ident: 33; Value: 'Malay'),
  563.     (Ident: 34; Value: 'Norwegian'),
  564.     (Ident: 35; Value: 'Polish'),
  565.     (Ident: 36; Value: 'Portuguese'),
  566.     (Ident: 37; Value: 'Romanian'),
  567.     (Ident: 38; Value: 'Russian'),
  568.     (Ident: 39; Value: 'Serbo-Croatian'),
  569.     (Ident: 40; Value: 'Slovak'),
  570.     (Ident: 41; Value: 'Slovenian'),
  571.     (Ident: 42; Value: 'Somali'),
  572.     (Ident: 43; Value: 'Spanish'),
  573.     (Ident: 44; Value: 'Swahili'),
  574.     (Ident: 45; Value: 'Swedish'),
  575.     (Ident: 46; Value: 'Tagalog'),
  576.     (Ident: 47; Value: 'Tatar'),
  577.     (Ident: 48; Value: 'Thai'),
  578.     (Ident: 49; Value: 'Turkish'),
  579.     (Ident: 50; Value: 'Ukrainian'),
  580.     (Ident: 51; Value: 'Urdu'),
  581.     (Ident: 52; Value: 'Vietnamese'),
  582.     (Ident: 53; Value: 'Yiddish'),
  583.     (Ident: 54; Value: 'Yoruba'),
  584.     (Ident: 55; Value: 'Afrikaans'),
  585.     (Ident: 56; Value: 'Bosnian'),
  586.     (Ident: 57; Value: 'Persian'),
  587.     (Ident: 58; Value: 'Albanian'),
  588.     (Ident: 59; Value: 'Armenian'),
  589.     (Ident: 60; Value: 'Punjabi'),
  590.     (Ident: 61; Value: 'Chamorro'),
  591.     (Ident: 62; Value: 'Mongolian'),
  592.     (Ident: 63; Value: 'Mandarin'),
  593.     (Ident: 64; Value: 'Taiwanese'),
  594.     (Ident: 65; Value: 'Macedonian'),
  595.     (Ident: 66; Value: 'Sindhi'),
  596.     (Ident: 67; Value: 'Welsh'),
  597.     (Ident: 68; Value: 'Azerbaijani'),
  598.     (Ident: 69; Value: 'Kurdish'),
  599.     (Ident: 70; Value: 'Gujarati'),
  600.     (Ident: 71; Value: 'Tamil'),
  601.     (Ident: 72; Value: 'Belorussian'),
  602.     (Ident: 255; Value: 'Unknown'));
  603.  
  604.   Occupations: array[1..17] of record Ident: Byte; Value: String end =
  605.     ((Ident: 1; Value: 'Academic'),
  606.     (Ident: 2; Value: 'Administrative'),
  607.     (Ident: 3; Value: 'Art/Entertainment'),
  608.     (Ident: 4; Value: 'College Student'),
  609.     (Ident: 5; Value: 'Computers'),
  610.     (Ident: 6; Value: 'Community & Social'),
  611.     (Ident: 7; Value: 'Education'),
  612.     (Ident: 8; Value: 'Engineering'),
  613.     (Ident: 9; Value: 'Financial Services'),
  614.     (Ident: 10; Value: 'Government'),
  615.     (Ident: 11; Value: 'High School Student'),
  616.     (Ident: 12; Value: 'Home'),
  617.     (Ident: 13; Value: 'ICQ - Providing Help'),
  618.     (Ident: 14; Value: 'Law'),
  619.     (Ident: 15; Value: 'Managerial'),
  620.     (Ident: 16; Value: 'Manufacturing'),
  621.     (Ident: 17; Value: 'Medical/Health'));
  622.  
  623.   Interests: array[100..150] of record Ident: Byte; Value: String end =
  624.     ((Ident: 100; Value: 'Art'),
  625.     (Ident: 101; Value: 'Cars'),
  626.     (Ident: 102; Value: 'Celebrity Fans'),
  627.     (Ident: 103; Value: 'Collections'),
  628.     (Ident: 104; Value: 'Computers'),
  629.     (Ident: 105; Value: 'Culture & Literature'),
  630.     (Ident: 106; Value: 'Fitness'),
  631.     (Ident: 107; Value: 'Games'),
  632.     (Ident: 108; Value: 'Hobbies'),
  633.     (Ident: 109; Value: 'ICQ - Providing Help'),
  634.     (Ident: 110; Value: 'Internet'),
  635.     (Ident: 111; Value: 'Lifestyle'),
  636.     (Ident: 112; Value: 'Movies/TV'),
  637.     (Ident: 113; Value: 'Music'),
  638.     (Ident: 114; Value: 'Outdoor Activities'),
  639.     (Ident: 115; Value: 'Parenting'),
  640.     (Ident: 116; Value: 'Pets/Animals'),
  641.     (Ident: 117; Value: 'Religion'),
  642.     (Ident: 118; Value: 'Science/Technology'),
  643.     (Ident: 119; Value: 'Skills'),
  644.     (Ident: 120; Value: 'Sports'),
  645.     (Ident: 121; Value: 'Web Design'),
  646.     (Ident: 122; Value: 'Nature and Environment'),
  647.     (Ident: 123; Value: 'News & Media'),
  648.     (Ident: 124; Value: 'Government'),
  649.     (Ident: 125; Value: 'Business & Economy'),
  650.     (Ident: 126; Value: 'Mystics'),
  651.     (Ident: 127; Value: 'Travel'),
  652.     (Ident: 128; Value: 'Astronomy'),
  653.     (Ident: 129; Value: 'Space'),
  654.     (Ident: 130; Value: 'Clothing'),
  655.     (Ident: 131; Value: 'Parties'),
  656.     (Ident: 132; Value: 'Women'),
  657.     (Ident: 133; Value: 'Social science'),
  658.     (Ident: 134; Value: '60''s'),
  659.     (Ident: 135; Value: '70''s'),
  660.     (Ident: 136; Value: '80''s'),
  661.     (Ident: 137; Value: '50''s'),
  662.     (Ident: 138; Value: 'Finance and corporate'),
  663.     (Ident: 139; Value: 'Entertainment'),
  664.     (Ident: 140; Value: 'Consumer electronics'),
  665.     (Ident: 141; Value: 'Retail stores'),
  666.     (Ident: 142; Value: 'Health and beauty'),
  667.     (Ident: 143; Value: 'Media'),
  668.     (Ident: 144; Value: 'Household products'),
  669.     (Ident: 145; Value: 'Mail order catalog'),
  670.     (Ident: 146; Value: 'Business services'),
  671.     (Ident: 147; Value: 'Audio and visual'),
  672.     (Ident: 148; Value: 'Sporting and athletic'),
  673.     (Ident: 149; Value: 'Publishing'),
  674.     (Ident: 150; Value: 'Home automation'));
  675.  
  676.   RandGroups: array[1..11] of record Ident: Byte; Value: String end =
  677.     ((Ident: 1; Value: 'General'),
  678.     (Ident: 2; Value: 'Romance'),
  679.     (Ident: 3; Value: 'Games'),
  680.     (Ident: 4; Value: 'Students'),
  681.     (Ident: 5; Value: '20 something'),
  682.     (Ident: 6; Value: '30 something'),
  683.     (Ident: 7; Value: '40 something'),
  684.     (Ident: 8; Value: '50+'),
  685.     (Ident: 9; Value: 'Romance'),
  686.     (Ident: 10; Value: 'Man requesting woman'),
  687.     (Ident: 11; Value: 'Woman requesting man'));
  688.  
  689.   Affiliations: array[0..19] of record Ident: Word; Value: String end =
  690.     ((Ident: 200; Value: 'Alumni Org.'),
  691.     (Ident: 201; Value: 'Charity Org.'),
  692.     (Ident: 202; Value: 'Club/Social Org.'),
  693.     (Ident: 203; Value: 'Community Org.'),
  694.     (Ident: 204; Value: 'Cultural Org.'),
  695.     (Ident: 205; Value: 'Fan Clubs'),
  696.     (Ident: 206; Value: 'Fraternity/Sorority'),
  697.     (Ident: 207; Value: 'Hobbyists Org.'),
  698.     (Ident: 208; Value: 'International Org.'),
  699.     (Ident: 209; Value: 'Nature and Environment Org.'),
  700.     (Ident: 210; Value: 'Professional Org.'),
  701.     (Ident: 211; Value: 'Scientific/Technical Org.'),
  702.     (Ident: 212; Value: 'Self Improvement Group'),
  703.     (Ident: 213; Value: 'Spiritual/Religious Org.'),
  704.     (Ident: 214; Value: 'Sports Org.'),
  705.     (Ident: 215; Value: 'Support Org.'),
  706.     (Ident: 216; Value: 'Trade and Business Org.'),
  707.     (Ident: 217; Value: 'Union'),
  708.     (Ident: 218; Value: 'Volunteer Org.'),
  709.     (Ident: 299; Value: 'Other'));
  710.  
  711.   Pasts: array[0..7] of record Ident: Word; Value: String end =
  712.     ((Ident: 300; Value: 'Elementary School'),
  713.     (Ident: 301; Value: 'High School'),
  714.     (Ident: 302; Value: 'College'),
  715.     (Ident: 303; Value: 'University'),
  716.     (Ident: 304; Value: 'Military'),
  717.     (Ident: 305; Value: 'Past Work Place'),
  718.     (Ident: 306; Value: 'Past Organization'),
  719.     (Ident: 399; Value: 'Other'));
  720.  
  721.  
  722.  
  723. //------------------------------------------------------------------------------------------------------------\
  724. //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  725.  
  726. implementation
  727. function IntToStr(Value: Int64): String;
  728. begin
  729.   Str(Value, Result);
  730. end;
  731.  
  732. function StrToInt(const Value: String): LongWord;
  733. var
  734.   nCode: Integer;
  735. begin
  736.   Val(Value, Result, nCode);
  737. end;
  738.  
  739. const
  740.   HexChars: array[0..15] of Char = ('0', '1', '2', '3', '4', '5',
  741.                                     '6', '7', '8', '9', 'a', 'b',
  742.                                     'c', 'd', 'e', 'f');
  743.  
  744. function IntToHex(Int: Int64; IntSize: Byte): String;
  745. var
  746.   n: Byte;
  747. begin
  748.   Result := '';
  749.   for n := 0 to IntSize - 1 do
  750.   begin
  751.     Result := HexChars[Int and $F] + Result;
  752.     Int := Int shr $4;
  753.   end;
  754. end;
  755.  
  756. function HexToInt(Value: String): LongWord;
  757. const
  758.   HexStr: String = '0123456789abcdef';
  759. var
  760.   i: Word;
  761. begin
  762.   Result := 0;
  763.   if Value = '' then Exit;
  764.   for i := 1 to Length(Value) do
  765.     Inc(Result, (Pos(Value[i], HexStr) - 1) shl ((Length(Value) - i) shl 2));
  766. end;
  767.  
  768. const
  769.   TXorData: array[0..15] of Byte = (
  770.     $F3, $26, $81, $C4, $39, $86, $DB, $92,
  771.     $71, $A3, $B9, $E6, $53, $7A, $95, $7C
  772.   );
  773.  
  774. procedure ICQEncryptPass(SrcBuf: Pointer; BufLen: LongWord); assembler;
  775. asm
  776.   or    edx,edx
  777.   jz    @@end
  778. @@loop:
  779.   mov   cl,byte ptr[eax + edx - 1]
  780.   xor   cl,byte ptr[TXorData + edx - 1]
  781.   mov   byte ptr[eax + edx - 1],cl
  782.   dec   edx
  783.   jnz   @@loop
  784. @@end:
  785. end;
  786.  
  787. procedure ICQEncryptPassStr(var Pass: String);
  788. var
  789.   i: Word;
  790. begin
  791.   for i := 1 to Length(Pass) do
  792.     Pass[i] := Chr(Ord(Pass[i]) xor TXorData[i - 1]);
  793. end;
  794.  
  795. function Swap16(Value: Word): Word; assembler;
  796. asm
  797.   rol   ax,8
  798. end;
  799.  
  800. function Swap32(Value: LongWord): LongWord; assembler;
  801. asm
  802.   bswap eax
  803. end;
  804.  
  805. {----------------------------------------------}
  806. //Adding data in reverse order
  807. procedure PktAddData(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
  808. var
  809.   i: Word;
  810. begin
  811.   if DataLen = 0 then Exit;
  812.   for i := 0 to DataLen - 1 do
  813.     PByte(LongWord(Pkt) + Pkt^.Len + i)^ := PByte(LongWord(Data) + DataLen - i - 1)^;
  814.   Inc(Pkt^.Len, DataLen);
  815. end;
  816.  
  817. //Adding data in direct order(local arrays, merging 2 or more packets)
  818. procedure PktAddArrBuf(Pkt: PRawPkt; Data: Pointer; DataLen: LongWord);
  819. begin
  820.   if DataLen = 0 then Exit;
  821.   Move(Data^, Ptr(LongWord(Pkt) + Pkt^.Len)^, DataLen);
  822.   Inc(Pkt^.Len, DataLen);
  823. end;
  824.  
  825. procedure PktInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
  826. begin
  827.   PktAddData(Pkt, @Value, IntSize);
  828. end;
  829.  
  830. procedure PktLInt(Pkt: PRawPkt; Value: LongWord; IntSize: Byte);
  831. begin
  832.   PktAddArrBuf(Pkt, @Value, IntSize);
  833. end;
  834.  
  835. procedure PktStr(Pkt: PRawPkt; const S: String);
  836. begin
  837.   if Length(S) = 0 then Exit;
  838.   Move(PChar(S)^, Ptr(LongWord(Pkt) + Pkt.Len)^, Length(S));
  839.   Inc(Pkt^.Len, Length(S));
  840. end;
  841.  
  842. procedure PktLStr(Pkt: PRawPkt; const S: String);
  843. begin
  844.   PktInt(Pkt, Length(S), 1);
  845.   PktStr(Pkt, S);
  846. end;
  847.  
  848. procedure PktWStr(Pkt: PRawPkt; const S: String);
  849. begin
  850.   if Length(S) = 0 then
  851.   begin
  852.     PktInt(Pkt, 0, 2);
  853.     Exit;
  854.   end;
  855.   PktInt(Pkt, Length(S), 2);
  856.   PktStr(Pkt, S);
  857. end;
  858.  
  859. procedure PktLNTS(Pkt: PRawPkt; const S: String);
  860. begin
  861.   if Length(S) = 0 then
  862.   begin
  863.     PktInt(Pkt, 0, 2);
  864.     Exit;
  865.   end;
  866.   PktLInt(Pkt, Length(S) + 1, 2);
  867.   PktStr(Pkt, S);
  868.   PktInt(Pkt, 0, 1);
  869. end;
  870.  
  871. procedure PktLLNTS(Pkt: PRawPkt; const S: String);
  872. begin
  873.   if Length(S) = 0 then
  874.   begin
  875.     PktInt(Pkt, 0, 2);
  876.     Exit;
  877.   end;
  878.   PktLInt(Pkt, Length(S) + 3, 2);
  879.   PktLNTS(Pkt, S);
  880. end;
  881.  
  882.  
  883.  
  884. {--}
  885. function GetInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
  886. var
  887.   i: Word;
  888. begin
  889.   Result := 0;
  890.   if IntSize = 0 then Exit;
  891.   if Pkt^.Len > 8100 then Exit;
  892.   for i := Pkt^.Len to Pkt^.Len + IntSize - 1 do
  893.     Inc(Result, PByte(LongWord(Pkt) + i)^ shl ((Pkt^.Len + IntSize - 1 - i) * 8));
  894.   Inc(Pkt^.Len, IntSize);
  895. end;
  896.  
  897. function GetLInt(Pkt: PRawPkt; IntSize: Byte): LongWord;
  898. var
  899.   i, c: Word;
  900. begin
  901.   Result := 0; c := 0;
  902.   if IntSize = 0 then Exit;
  903.   if Pkt^.Len > 8100 then Exit;
  904.   for i := Pkt^.Len to Pkt^.Len + IntSize - 1 do
  905.   begin
  906.     Inc(Result, PByte(LongWord(Pkt) + Pkt^.Len + IntSize - c - 1)^ shl ((Pkt^.Len + IntSize - 1 - i) * 8));
  907.     Inc(c);
  908.   end;
  909.   Inc(Pkt^.Len, IntSize);
  910. end;
  911.  
  912. function GetStr(Pkt: PRawPkt; StrLen: Word): String;
  913. begin
  914.   Result := '';
  915.   while StrLen > 0 do
  916.   begin
  917.     Result := Result + PChar(LongWord(Pkt) + Pkt^.Len)^;
  918.     Inc(Pkt^.Len);
  919.     Dec(StrLen);
  920.     if Pkt^.Len > 8100 then Exit;
  921.   end;
  922. end;
  923.  
  924. function GetTLVStr(Pkt: PRawPkt; var T: Word): String;
  925. var
  926.   ISize: Word;
  927. begin
  928.   T := GetInt(Pkt, 2);          //Get type
  929.   ISize := GetInt(Pkt, 2);      //Get data length
  930.   Result := GetStr(Pkt, ISize); //Get data
  931. end;
  932.  
  933. function GetTLVInt(Pkt: PRawPkt; var T: Word): LongWord;
  934. var
  935.   ISize: Word;
  936. begin
  937.   T := GetInt(Pkt, 2);          //Get type
  938.   ISize := GetInt(Pkt, 2);      //Get data length
  939.   Result := GetInt(Pkt, ISize); //Get data
  940. end;
  941.  
  942. procedure GetSnac(Pkt: PRawPkt; var Snac: TSnacHdr);
  943. begin
  944.   Snac := PSnacHdr(LongWord(Pkt) + Pkt^.Len)^;
  945.   Snac.Family := Swap16(Snac.Family);
  946.   Snac.SubType := Swap16(Snac.SubType);
  947.   Snac.ReqID := Swap32(Snac.ReqID);
  948.   Inc(Pkt^.Len, TSNACSZ);
  949. end;
  950.  
  951. function GetLStr(Pkt: PRawPkt): String;
  952. begin
  953.   Result := GetStr(Pkt, GetInt(Pkt, 1));
  954. end;
  955.  
  956. function GetWStr(Pkt: PRawPkt): String;
  957. begin
  958.   Result := GetStr(Pkt, GetInt(Pkt, 2));
  959. end;
  960.  
  961. function GetLNTS(Pkt: PRawPkt): String;
  962. begin
  963.   Result := GetStr(Pkt, GetLInt(Pkt, 2) - 1);
  964.   Inc(Pkt^.Len, 1);
  965. end;
  966.  
  967.  
  968. {--------}
  969. procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: LongWord); overload;
  970. begin
  971.   PktInt(Pkt, T, 2);  //Add type
  972.   PktInt(Pkt, L, 2);  //Add length
  973.   PktInt(Pkt, V, L);  //Add value
  974. end;
  975.  
  976. procedure PktTLV(Pkt: PRawPkt; T: Word; const V: String); overload;
  977. begin
  978.   PktInt(Pkt, T, 2);            //Add type
  979.   PktInt(Pkt, Length(V), 2);    //Add length
  980.   PktStr(Pkt, V);               //Add value
  981. end;
  982.  
  983. procedure PktTLV(Pkt: PRawPkt; T, L: Word; V: Pointer); overload; //for arrays
  984. begin
  985.   PktInt(Pkt, T, 2);            //Add type
  986.   PktInt(Pkt, L, 2);            //Add length
  987.   PktAddArrBuf(Pkt, V, L);      //Add value
  988. end;
  989.  
  990. procedure PktInit(Pkt: PRawPkt; Channel: Byte; var Seq: Word);
  991. begin
  992.   Pkt^.Len := 0;                //Starting size of packet to 0
  993.   PktInt(Pkt, $2A, 1);          //Ident, always $2A
  994.   PktInt(Pkt, Channel, 1);      //Channel
  995.   PktInt(Pkt, SEQ, 2); Inc(SEQ);//Seq
  996.   PktInt(Pkt, 0, 2);            //Reserved for size
  997. end;
  998.  
  999. procedure PktInitRaw(Pkt: PRawPkt);
  1000. begin
  1001.   Pkt^.Len := 0;                //Default size of the packet
  1002. end;
  1003.  
  1004. procedure PktFinal(Pkt: PRawPkt); //Used with PktInit only
  1005. begin
  1006.   PWord(LongWord(Pkt) + 4)^ := Swap16(Pkt.Len - TFLAPSZ); //Store the packet size (without flap header size)
  1007. end;
  1008.  
  1009. procedure PktSnac(Pkt: PRawPkt; Family, SubType: Word; ID: LongWord; Flags: Word);
  1010. begin
  1011.   PktInt(Pkt, Family, 2);       //Snac family
  1012.   PktInt(Pkt, SubType, 2);      //Snac subtype
  1013.   PktInt(Pkt, Flags, 2);        //Snac flags
  1014.   PktInt(Pkt, ID, 4);           //Snac reference
  1015. end;
  1016.  
  1017. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  1018. function StrToLanguageI(const Value: String): Word;
  1019. var
  1020.   i: Word;
  1021. begin
  1022.   for i := Low(Languages) to High(Languages) do
  1023.     if Languages[i].Value = Value then
  1024.     begin
  1025.       Result := Languages[i].Ident;
  1026.       Exit;
  1027.     end;
  1028.   Result := 0;
  1029. end;
  1030.  
  1031. function StrToCountryI(const Value: String): Word;
  1032. var
  1033.   i: Word;
  1034. begin
  1035.   for i := Low(Countries) to High(Countries) do
  1036.     if Countries[i].Value = Value then
  1037.     begin
  1038.       Result := Countries[i].Ident;
  1039.       Exit;
  1040.     end;
  1041.   Result := 0;
  1042. end;
  1043.  
  1044. function StrToInterestI(const Value: String): Word;
  1045. var
  1046.   i: Word;
  1047. begin
  1048.   for i := Low(Interests) to High(Interests) do
  1049.     if Interests[i].Value = Value then
  1050.     begin
  1051.       Result := Interests[i].Ident;
  1052.       Exit;
  1053.     end;
  1054.   Result := 0;
  1055. end;
  1056.  
  1057. function StrToOccupationI(const Value: String): Word;
  1058. var
  1059.   i: Word;
  1060. begin
  1061.   for i := Low(Occupations) to High(Occupations) do
  1062.     if Occupations[i].Value = Value then
  1063.     begin
  1064.       Result := Occupations[i].Ident;
  1065.       Exit;
  1066.     end;
  1067.   Result := 0;
  1068. end;
  1069.  
  1070. function StrToPastI(const Value: String): Word;
  1071. var
  1072.   i: Word;
  1073. begin
  1074.   for i := Low(Pasts) to High(Pasts) do
  1075.     if Pasts[i].Value = Value then
  1076.     begin
  1077.       Result := Pasts[i].Ident;
  1078.       Exit;
  1079.     end;
  1080.   Result := 0;
  1081. end;
  1082.  
  1083. function StrToAffiliationI(const Value: String): Word;
  1084. var
  1085.   i: Word;
  1086. begin
  1087.   for i := Low(Affiliations) to High(Affiliations) do
  1088.     if Affiliations[i].Value = Value then
  1089.     begin
  1090.       Result := Affiliations[i].Ident;
  1091.       Exit;
  1092.     end;
  1093.   Result := 0;
  1094. end;
  1095.  
  1096. {-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  1097. {The first packet sent by the client after connecting and receiving
  1098. the SRV_HELLO packet from the server. The packet basiclly identifies
  1099. what kind and version of client is connecting along with the user's
  1100. UIN and password.}
  1101. procedure CreateCLI_IDENT(Pkt: PRawPkt; UIN: LongWord; Password: String; var Seq: Word);
  1102. begin
  1103.   PktInit(Pkt, 1, Seq);                         //Channel 1
  1104.   PktInt(Pkt, 1, 4);                            //00 00 00 01
  1105.   PktTLV(Pkt, 1, IntToStr(UIN));                //Adding user's UIN
  1106.  
  1107.   ICQEncryptPassStr(Password);                  //Encrypt password
  1108.   PktTLV(Pkt, 2, Password);                     //Adding encrypted password
  1109.  
  1110.   PktTLV(Pkt, 3, 'ICQ Inc. - Product of ICQ (TM).2001b.5.15.1.3634.85');   //Cookie
  1111.   //Uknowns
  1112.   PktInt(Pkt, $00160002, 4); PktInt(Pkt, $010a, 2);
  1113.   PktInt(Pkt, $00170002, 4); PktInt(Pkt, $0005, 2);
  1114.   PktInt(Pkt, $00180002, 4); PktInt(Pkt, $000f, 2);
  1115.   PktInt(Pkt, $00190002, 4); PktInt(Pkt, $0001, 2);
  1116.   PktInt(Pkt, $001a0002, 4); PktInt(Pkt, $0e32, 2);
  1117.   PktInt(Pkt, $00140004, 4); PktInt(Pkt, $00000055, 4);
  1118.   PktTLV(Pkt, $000f, 'en');
  1119.   PktTLV(Pkt, $000e, 'us');
  1120.   PktFinal(Pkt);                                //Finalize packet
  1121. end;
  1122.  
  1123. {Sent as the first packet after the client has logged in
  1124. to the second server and received the SRV_HELLO packet.}
  1125. procedure CreateCLI_COOKIE(Pkt: PRawPkt; const Cookie: String; var Seq: Word);
  1126. begin
  1127.   PktInit(Pkt, 1, Seq);                         //Channel 1
  1128.   PktInt(Pkt, 1, 4);                            //00 00 00 01
  1129.   PktTLV(Pkt, 6, Cookie);                       //TLV(06) Cookie
  1130.   PktFinal(Pkt);                                //Finalize packet
  1131. end;
  1132.  
  1133. {This packet is a response to SNAC(1,3), SRV_FAMILIES. This tells
  1134. the server which SNAC families and their corresponding versions
  1135. which the client understands. This also seems to identify the client
  1136. as an ICQ vice AIM client to the server.}
  1137. procedure CreateCLI_FAMILIES(Pkt: PRawPkt; var Seq: Word);
  1138. begin
  1139.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1140.   PktSnac(Pkt, 1, $17, 0, 0);                   //Snac: Type x01/x17, ID x0000, Flags 0
  1141.   PktInt(Pkt, $00010003, 4);                    //Family x01 is Version x03
  1142.   PktInt(Pkt, $00130002, 4);                    //Family x13 at Version x02
  1143.   PktInt(Pkt, $00020001, 4);                    //Family x02 at Version x01
  1144.   PktInt(Pkt, $00030001, 4);                    //Family x03 at Version x01
  1145.   PktInt(Pkt, $00150001, 4);                    //Family x15 at Version x01
  1146.   PktInt(Pkt, $00040001, 4);                    //Family x04 at Version x01
  1147.   PktInt(Pkt, $00060001, 4);                    //Family x06 at Version x01
  1148.   PktInt(Pkt, $00090001, 4);                    //Family x09 at Version x01
  1149.   PktInt(Pkt, $000A0001, 4);                    //Family x0A at Version x01
  1150.   PktInt(Pkt, $000B0001, 4);                    //Family x0B at Version x01
  1151.   PktFinal(Pkt);                                //Finalize packet
  1152. end;
  1153.  
  1154. {This packet requests from the server several bits of information most
  1155. likely regarding how fast certain packets can be sent to the server and
  1156. possibly a maximum packet size as well.}
  1157. procedure CreateCLI_RATESREQUEST(Pkt: PRawPkt; var Seq: Word);
  1158. begin
  1159.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1160.   PktSnac(Pkt, $01, $06, 0, 0);                 //Snac: Type x01/x06, ID x0000, Flags 0
  1161.   PktFinal(Pkt);                                //Finalize packet
  1162. end;
  1163.  
  1164. {This packet is sent in response to the SRV_RATES SNAC(1,7). This
  1165. packet contains the same group numbers as was in the SRV_RATES
  1166. packet and is an acknowledgement of their receipt.}
  1167. procedure CreateCLI_ACKRATES(Pkt: PRawPkt; var Seq: Word);
  1168. begin
  1169.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1170.   PktSnac(Pkt, $01, $08, 0, 0);                 //Type x01/x08, ID x0000, Flags 0
  1171.   PktInt(Pkt, $0001, 2);                        //Group1 - 0x0001
  1172.   PktInt(Pkt, $0002, 2);                        //Group2 - 0x0002
  1173.   PktInt(Pkt, $0003, 2);                        //Group3 - 0x0003
  1174.   PktInt(Pkt, $0004, 2);                        //Group4 - 0x0004
  1175.   PktInt(Pkt, $0005, 2);                        //Group5 - 0x0005
  1176.   PktFinal(Pkt);                                //Finalize packet
  1177. end;
  1178.  
  1179. {This command requests from the server certain information
  1180. about the client that is stored on the server}
  1181. procedure CreateCLI_REQINFO(Pkt: PRawPkt; var Seq: Word);
  1182. begin
  1183.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1184.   PktSnac(Pkt, $01, $0E, 0, 0);                 //Snac: Type x01/x0E, ID x0000, Flags 0
  1185.   PktFinal(Pkt);                                //Finalize packet
  1186. end;
  1187.  
  1188. {Unknown}
  1189. procedure CreateCLI_REQUNKNOWN(Pkt: PRawPkt; var Seq: Word);
  1190. begin
  1191.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1192.   PktSnac(Pkt, $13, $02, 0, 0);                 //Snac: Type x13/x02, ID x0000, Flags 0
  1193.   PktFinal(Pkt);                                //Finalize packet
  1194. end;
  1195.  
  1196. {This command, like CLI_CHECKROSTER, requests the server side contact list.
  1197. The difference between CLI_REQROSTER and CLI_CHECKROSTER is that CLI_REQROSTER
  1198. has no parameters, and always causes SRV_REPLYROSTER (rather than
  1199. SRV_REPLYROSTEROK). My guess is that CLI_REQROSTER is sent instead of
  1200. CLI_CHECKROSTER when the client does not have a cached copy of the contact
  1201. list; ie, the first time a user logs in with a particular client.}
  1202. procedure CreateCLI_REQROSTER(Pkt: PRawPkt; var Seq: Word);
  1203. begin
  1204.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1205.   PktSnac(Pkt, $13, $04, $00010004, 0);         //Snac: Type x13/x04, ID x00010004, Flags 0
  1206.   PktFinal(Pkt);                                //Finalize packet
  1207. end;
  1208.  
  1209. {Synchronizes the server side contact list with the client's.
  1210. If the passed values match those on the server, SNAC(13,F)
  1211. SRV_REPLYROSTEROK will be returned. If the values are older
  1212. than what is on the server then SNAC(13,6) SRV_REPLYROSTER will
  1213. be returned.}
  1214. procedure CreateCLI_CHECKROSTER(Pkt: PRawPkt; var Seq: Word);
  1215. begin
  1216.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1217.   PktSnac(Pkt, $13, $05, $00010005, 0);         //Snac: Type x13/x05, ID x00010005, Flags 0
  1218.   PktInt(Pkt, $3C36D709, 4);                    //time(NULL), The last modification time of the server side contact list.
  1219.   PktInt(Pkt, $0000, 2);                        //Size of server side contact list.
  1220.   PktFinal(Pkt);                                //Finalize packet
  1221. end;
  1222.  
  1223. {Request rights information for location service. This is from
  1224. the OSCAR document.}
  1225. procedure CreateCLI_REQLOCATION(Pkt: PRawPkt; var Seq: Word);
  1226. begin
  1227.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1228.   PktSnac(Pkt, $02, $02, 0, 0);                 //Snac: Type x02/x02, ID x0000, Flags 0
  1229.   PktFinal(Pkt);                                //Finalize packet
  1230. end;
  1231.  
  1232. {Request rights information for buddy service. This from the OSCAR document.}
  1233. procedure CreateCLI_REQBUDDY(Pkt: PRawPkt; var Seq: Word);
  1234. begin
  1235.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1236.   PktSnac(Pkt, $03, $02, 0, 0);                 //Snac: Type x03/x02, ID x0000, Flags 0
  1237.   PktFinal(Pkt);                                //Finalize packet
  1238. end;
  1239.  
  1240. {Request rights information for ICBM (instant messages) operations. This
  1241. from the OSCAR document.}
  1242. procedure CreateCLI_REQICBM(Pkt: PRawPkt; var Seq: Word);
  1243. begin
  1244.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1245.   PktSnac(Pkt, $04, $04, 0, 0);                 //Snac: Type x04/x04, ID x0000, Flags 0
  1246.   PktFinal(Pkt);                                //Finalize packet
  1247. end;
  1248.  
  1249. {Request BOS rights. This from the OSCAR document.}
  1250. procedure CreateCLI_REQBOS(Pkt: PRawPkt; var Seq: Word);
  1251. begin
  1252.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1253.   PktSnac(Pkt, $09, $02, 0, 0);                 //Snac: Type x09/x02, ID x0000, Flags 0
  1254.   PktFinal(Pkt);                                //Finalize packet
  1255. end;
  1256.  
  1257. {This packet sends the client's capabilities information to the server.}
  1258. procedure CreateCLI_SETUSERINFO(Pkt: PRawPkt; var Seq: Word);
  1259. const
  1260.   caps: array[0..$40 - 1] of Byte = (
  1261.     $09, $46, $13, $49, $4C, $7F, $11, $D1, $82, $22, $44, $45, $53, $54, $00, $00,
  1262.     $97, $B1, $27, $51, $24, $3C, $43, $34, $AD, $22, $D6, $AB, $F7, $3F, $14, $92,
  1263.     $2E, $7A, $64, $75, $FA, $DF, $4D, $C8, $88, $6F, $EA, $35, $95, $FD, $B6, $DF,
  1264.     $09, $46, $13, $44, $4C, $7F, $11, $D1, $82, $22, $44, $45, $53, $54, $00, $00
  1265.   );
  1266. begin
  1267.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1268.   PktSnac(Pkt, $02, $04, 0, 0);                 //Snac: Type x02/x04, ID x0000, Flags 0
  1269.   PktTLV(Pkt, 5, Length(caps), @caps);          //Client's capabilities
  1270.   PktFinal(Pkt);                                //Finalize packet
  1271. end;
  1272.  
  1273. {This packet seems to change some of the values passed from the server
  1274. in SRV_REPLYICBM SNAC(4,5).}
  1275. procedure CreateCLI_SETICBM(Pkt: PRawPkt; var Seq: Word);
  1276. begin
  1277.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1278.   PktSnac(Pkt, $04, $02, 0, 0);                 //Snac: Type x04/x02, ID x0000, Flags 0
  1279.   PktInt(Pkt, 0, 4);                            //0, Unknown; Numbers similar to x04/x05
  1280.   PktInt(Pkt, $0003, 2);                        //3, Unknown
  1281.   PktInt(Pkt, $1F40, 2);                        //8000, Unknown
  1282.   PktInt(Pkt, $03E7, 2);                        //999, Unknown
  1283.   PktInt(Pkt, $03E7, 2);                        //999, Unknown
  1284.   PktInt(Pkt, 0, 4);                            //0, Unknown
  1285.   PktFinal(Pkt);                                //Finalize packet
  1286. end;
  1287.  
  1288. {This sets the clients online status code and some other direct client
  1289. to client information as well. Used in login sequence.}
  1290. procedure CreateCLI_SETSTATUS(Pkt: PRawPkt; Status: LongWord; IP: LongInt; Port: Word; Cookie: LongWord; ProxyType: TProxyType; var Seq: Word);
  1291. var
  1292.   lpkt: TRawPkt;
  1293. begin
  1294.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1295.   PktSnac(Pkt, $01, $1E, 0, 0);                 //Snac: Type x01/x1E, ID x0000, Flags 0
  1296.   PktTLV(Pkt, $06, 4, Status);                  //TLV(06) Status
  1297.   PktTLV(Pkt, $08, 2, 0);                       //TLV(08) Error code
  1298.   PktInitRaw(@lpkt);
  1299.   //{$R-}
  1300.   PktInt(@lpkt, Swap32(IP), 4);                 //The client computer's local IP address.(internal)
  1301.   //{$R+}
  1302.   PktInt(@lpkt, Port, 4);                       //This is the port to connect with when making client to client connections.
  1303.   if ProxyType = P_NONE then
  1304.     PktInt(@lpkt, $04, 1)                       //01 = Firewall (or HTTPS proxy); 02 = SOCKS4/5 proxy; 04 = 'normal' connection
  1305.   else if (ProxyType = P_SOCKS4) or (ProxyType = P_SOCKS5) then
  1306.     PktInt(@lpkt, $02, 1);
  1307.   PktInt(@lpkt, $0008, 2);                      //The highest client to client protocol version this client uses.
  1308.   PktInt(@lpkt, Cookie, 4);                     //Probably a direct client to client connection cookie.
  1309.   PktInt(@lpkt, $0000, 2);                      //0, Unknown
  1310.   PktInt(@lpkt, $0050, 2);                      //80, Unknown
  1311.   PktInt(@lpkt, $0000, 2);                      //0, Unknown
  1312.   PktInt(@lpkt, $0003, 2);                      //Count: 3
  1313.     //Theese are used in miranda-icq
  1314.     //PktInt(@lpkt, $FFFFFFFF, 4);                  //time(NULL): Wed Sep 19 13:53:51 2001
  1315.     //PktInt(@lpkt, $00010201, 4);                  //time(NULL): Thu Nov 08 22:54:27 2001
  1316.     //PktInt(@lpkt, $3B7248ED, 4);                  //time(NULL): Thu Nov 08 22:49:54 2001
  1317.   PktInt(@lpkt, $00000000, 4);                  //time(NULL)
  1318.   PktInt(@lpkt, $00000000, 4);                  //time(NULL)
  1319.   PktInt(@lpkt, $00000000, 4);                  //time(NULL)
  1320.   PktInt(@lpkt, $0000, 2);                      //0, Unknown
  1321.   PktTLV(Pkt, $0C, lpkt.len, @lpkt.Data);       //TLV(0C)
  1322.   PktFinal(Pkt);                                //Finalize packet
  1323. end;
  1324.  
  1325. {Set client's online status after login.}
  1326. procedure CreateCLI_SETSTATUS_SHORT(Pkt: PRawPkt; Status: LongWord; var Seq: Word);
  1327. begin
  1328.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1329.   PktSnac(Pkt, $01, $1E, 0, 0);                 //Snac: Type x01/x1E, ID x0000, Flags 0
  1330.   PktTLV(Pkt, $06, 4, Status);                  //TLV(06) Status
  1331.   PktFinal(Pkt);                                //Finalize packet
  1332. end;
  1333.  
  1334. {This packet seems to pass the SNAC Families and their versions
  1335. along with some unknown other information back to the server.}
  1336. procedure CreateCLI_READY(Pkt: PRawPkt; var Seq: Word);
  1337. const
  1338.   buf: array[0..79] of Byte = (
  1339.     $00, $01, $00, $03, $01, $10, $04, $7B,
  1340.     $00, $13, $00, $02, $01, $10, $04, $7B,
  1341.     $00, $02, $00, $01, $01, $01, $04, $7B,
  1342.     $00, $03, $00, $01, $01, $10, $04, $7B,
  1343.     $00, $15, $00, $01, $01, $10, $04, $7B,
  1344.     $00, $04, $00, $01, $01, $10, $04, $7B,
  1345.     $00, $06, $00, $01, $01, $10, $04, $7B,
  1346.     $00, $09, $00, $01, $01, $10, $04, $7B,
  1347.     $00, $0A, $00, $01, $01, $10, $04, $7B,
  1348.     $00, $0B, $00, $01, $01, $10, $04, $7B
  1349.   );
  1350. begin
  1351.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1352.   PktSnac(Pkt, $01, $02, 0, 0);                 //Snac: Type x01/x02, ID x0000, Flags 0
  1353.   PktAddArrBuf(Pkt, @buf, SizeOf(buf));         //Number sequence matches SNAC(x01/x17)
  1354.   PktFinal(Pkt);                                //Finalize packet
  1355. end;
  1356.  
  1357. {This packet seems to act as an interface between the AIM OSCAR-based server
  1358. and the old original ICQ server database.}
  1359. procedure CreateCLI_TOICQSRV(Pkt: PRawPkt; UIN: LongWord; Command: Word; Data: Pointer; DataLen: LongWord; var Seq, Seq2: Word);
  1360. var
  1361.   lpkt: TRawPkt;
  1362.   len: Word;
  1363. begin
  1364.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1365.   if Seq2 = 2 then
  1366.     PktSnac(Pkt, $15, $02, $00010002, 0)        //Snac: Type x15/x02, ID x00010002, Flags 0
  1367.   else
  1368.     PktSnac(Pkt, $15, $02, $00000000, 0);       //Snac: Type x15/x02, ID x00000000, Flags 0
  1369.   PktInitRaw(@lpkt);
  1370.   Inc(lpkt.Len, 2);
  1371.   PktInt(@lpkt, Swap32(UIN), 4);
  1372.   PktInt(@lpkt, Swap16(Command), 2);
  1373.   PktInt(@lpkt, Swap16(Seq2), 2);
  1374.   PktAddArrBuf(@lpkt, Data, DataLen);
  1375.   //Store remaining size
  1376.   len := lpkt.Len;
  1377.   lpkt.Len := 0;
  1378.   PktLInt(@lpkt, len - 2, 2);
  1379.   lpkt.Len := len;
  1380.   //--
  1381.   PktTLV(Pkt, 1, lpkt.Len, @lpkt);
  1382.   PktFinal(Pkt);
  1383.   Inc(Seq2);
  1384. end;
  1385.  
  1386. {This is sent at login and when you add a new user to your
  1387. contact list. It contains a list of all the uin's in you're
  1388. contact list. ****May be repeated multiple times****}
  1389. procedure CreateCLI_ADDCONTACT(Pkt: PRawPkt; UIN: String; var Seq: Word);
  1390. begin
  1391.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1392.   PktSnac(Pkt, $03, $04, 0, 0);                 //Snac: Type x03/x04, ID x0000, Flags 0
  1393.   PktLStr(Pkt, UIN);                            //UIN
  1394.   PktFinal(Pkt);                                //Finalize packet
  1395. end;
  1396.  
  1397. {Sent to remove contacts from contact list.}
  1398. procedure CreateCLI_REMOVECONTACT(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  1399. begin
  1400.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1401.   PktSnac(Pkt, $03, $05, 0, 0);                 //Snac: Type x03/x05, ID x0000, Flags 0
  1402.   PktLStr(Pkt, IntToStr(UIN));                  //List of UINs to remove from contact list.
  1403.   PktFinal(Pkt);                                //Finalize packet
  1404. end;
  1405.  
  1406. {Add UINs to your visible list.}
  1407. procedure CreateCLI_ADDVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
  1408. var
  1409.   i: Word;
  1410. begin
  1411.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1412.   PktSnac(Pkt, $09, $05, 0, 0);                 //Snac: Type x09/x05, ID x0000, Flags 0
  1413.   if UINs.Count > 0 then
  1414.     for i := 0 to UINs.Count - 1 do
  1415.       PktLStr(Pkt, UINs.Strings[i]);
  1416.   PktFinal(Pkt);                                //Finalize packet
  1417. end;
  1418.  
  1419. {Remove UINs from your visible list.}
  1420. procedure CreateCLI_REMVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  1421. begin
  1422.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1423.   PktSnac(Pkt, $09, $06, 0, 0);                 //Snac: Type x09/x05, ID x0000, Flags 0
  1424.   PktLStr(Pkt, IntToStr(UIN));                  //The UINs to remove from your invisible list.
  1425.   PktFinal(Pkt);                                //Finalize packet
  1426. end;
  1427.  
  1428. {List of UINs to add to invisible list. ****May be repeated multiple times****}
  1429. procedure CreateCLI_ADDINVISIBLE(Pkt: PRawPkt; UINs: TStrings; var Seq: Word);
  1430. var
  1431.   i: Word;
  1432. begin
  1433.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1434.   PktSnac(Pkt, $09, $07, 0, 0);                 //Snac: Type x09/x05, ID x0000, Flags 0
  1435.   if UINs.Count > 0 then
  1436.     for i := 0 to UINs.Count - 1 do
  1437.       PktLStr(Pkt, UINs.Strings[i]);
  1438.   PktFinal(Pkt);                                //Finalize packet
  1439. end;
  1440.  
  1441. {Remove UINs from your invisible list...}
  1442. procedure CreateCLI_REMINVISIBLE(Pkt: PRawPkt; UIN: LongWord; var Seq: Word);
  1443. begin
  1444.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1445.   PktSnac(Pkt, $09, $08, 0, 0);                 //Snac: Type x09/x05, ID x0000, Flags 0
  1446.   PktLStr(Pkt, IntToStr(UIN));                  //The UINs to remove from your invisible list.
  1447.   PktFinal(Pkt);                                //Finalize packet
  1448. end;
  1449.  
  1450. {Acknowledge the receipt of all offline messages.}
  1451. procedure CreateCLI_ACKOFFLINEMSGS(Pkt: PRawPkt; UIN: LongWord; var Seq, Seq2: Word);
  1452. begin
  1453.   CreateCLI_TOICQSRV(Pkt, UIN, CMD_ACKOFFMSG, nil, 0, Seq, Seq2);
  1454. end;
  1455.  
  1456. {Send a message.}
  1457. procedure CreateCLI_SENDMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; var Seq: Word);
  1458. var
  1459.   lpkt: TRawPkt;
  1460.   pmsg: TRawPkt;
  1461. begin
  1462.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1463.   PktSnac(Pkt, $04, $06, 0, 0);                 //Snac: Type x04/x06, ID x0000, Flags 0
  1464.   PktInt(Pkt, ITime, 4);                        //MID
  1465.   PktInt(Pkt, IRandom, 4);                      //MID
  1466.   PktInt(Pkt, 1, 2);                            //type, 1 - text messages
  1467.   PktLStr(Pkt, IntToStr(UIN));                  //The UIN to send the message to.
  1468.   PktInitRaw(@lpkt);                            //Allocate packet for incapsulated TLV(02)
  1469.   PktTLV(@lpkt, 1281, 1, 1);                    //Unknown: 0x1 = 1.
  1470.   PktInitRaw(@pmsg);                            //Allocate packet for incapsulated TLV(257)
  1471.   PktInt(@pmsg, 0, 4);                          //Unknown: empty. vICQ uses 00 00 ff ff.
  1472.   PktStr(@pmsg, Msg);                           //Finally, the message to send.
  1473.   PktTLV(@lpkt, 257, pmsg.Len, @pmsg);          //Add TLV(257)
  1474.   PktTLV(Pkt, 2, lpkt.Len, @lpkt);              //Add TLV(2)
  1475.   PktTLV(Pkt, 6, 0, 0);                         //Always present empty TLV.
  1476.   PktFinal(Pkt);                                //Finalize packet
  1477. end;
  1478.  
  1479. {Send an URL.}
  1480. procedure CreateCLI_SENDURL(Pkt: PRawPkt; ITime, IRandom, MyUIN, UIN: LongWord; const URL, Description: String; var Seq: Word);
  1481. var
  1482.   lpkt: TRawPkt;
  1483.   S: String;
  1484. begin
  1485.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1486.   PktSnac(Pkt, $04, $06, 0, 0);                 //Snac: Type x04/x06, ID x0000, Flags 0
  1487.   PktInt(Pkt, ITime, 4);                        //MID
  1488.   PktInt(Pkt, IRandom, 4);                      //MID
  1489.   PktInt(Pkt, 4, 2);                            //type, 1 - url etc messages
  1490.   PktLStr(Pkt, IntToStr(UIN));                  //The UIN to sent the message to.
  1491.   PktInitRaw(@lpkt);                            //Allocate packet for incapsulated TLV(5)
  1492.   PktLInt(@lpkt, MyUIN, 4);                     //My UIN.
  1493.   PktInt(@lpkt, 4, 1);                          //The message type as in the old protocol.
  1494.   PktInt(@lpkt, 0, 1);                          //Unknown flags; possibly the message flags.
  1495.   S := Description + #$fe + URL;                //Concatinate: Decription + 0xFE + URL
  1496.   PktLNTS(@lpkt, S);                            //Finally the URL to send.
  1497.   PktTLV(Pkt, 5, lpkt.Len, @lpkt);              //Add TLV(5)
  1498.   PktTLV(Pkt, 6, 0, 0);                         //Always present empty TLV.
  1499.   PktFinal(Pkt);                                //Finalize packet
  1500. end;
  1501.  
  1502. {Grant another user's request for authorization (in response to SRV_AUTH_REQ).}
  1503. procedure CreateCLI_AUTHORIZE(Pkt: PRawPkt; UIN: LongWord; Auth: Byte; Reason: String; var Seq: Word);
  1504. begin
  1505.   if Auth = 1 then Reason := '';
  1506.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1507.   PktSnac(Pkt, $13, $1A, 0, 0);                 //Snac: Type x13/x1A, ID x0000, Flags 0
  1508.   PktLStr(Pkt, IntToStr(UIN));                  //UIN of the user to authorize.
  1509.   PktInt(Pkt, Auth, 1);                         //Decline or authorize the contact add request: 00 - decline, 01 - authorize
  1510.   PktInt(Pkt, Length(Reason), 2);               //Length of the following reason; always 0 for authorize.
  1511.   PktStr(Pkt, Reason);                          //Reason for declining authorization as ASCII string.
  1512.   PktInt(Pkt, 0, 2);                            //Unknown: empty.
  1513.   PktFinal(Pkt);                                //Finalize packet
  1514. end;
  1515.  
  1516. {Request information about another user.}
  1517. procedure CreateCLI_METAREQINFO(Pkt: PRawPkt; UIN, dUIN: LongWord; var Seq, Seq2: Word);
  1518. var
  1519.   lpkt: TRawPkt;
  1520. begin
  1521.   PktInitRaw(@lpkt);
  1522.   PktLInt(@lpkt, $04D0, 2); //CLI_METAREQINFO
  1523.   PktLInt(@lpkt, dUIN, 4);
  1524.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2);
  1525. end;
  1526.  
  1527. {Searches user by email.}
  1528. procedure CreateCLI_SEARCHBYMAIL(Pkt: PRawPkt; UIN: LongWord; const Email: String; var Seq, Seq2: Word);
  1529. var
  1530.   lpkt: TRawPkt;
  1531. begin
  1532.   PktInitRaw(@lpkt);
  1533.   PktInt(@lpkt, $7305, 2); //CLI_SEARCHBYMAIL
  1534.   PktInt(@lpkt, $5e01, 2); //The key to search for: 0x15e = 350 = email address
  1535.   PktLLNTS(@lpkt, Email);  //The email address to search for.
  1536.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1537. end;
  1538.  
  1539. {Searches user by UIN.}
  1540. procedure CreateCLI_SEARCHBYUIN(Pkt: PRawPkt; UIN: LongWord; DUIN: LongWord; var Seq, Seq2: Word);
  1541. var
  1542.   lpkt: TRawPkt;
  1543. begin
  1544.   PktInitRaw(@lpkt);
  1545.   PktInt(@lpkt, $6905, 2); //CLI_SEARCHBYUIN
  1546.   PktInt(@lpkt, $3601, 2); //The key to search for: 0x15e = 350 = email address
  1547.   PktInt(@lpkt, $0400, 2); //Length of the following data
  1548.   PktInt(@lpkt, Swap32(DUIN), 4); //UIN
  1549.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1550. end;
  1551.  
  1552. {Search for a user by most common options.}
  1553. procedure CreateCLI_SEARCHBYNAME(Pkt: PRawPkt; UIN: LongWord; const FirstName, LastName, NickName, Email: String; var Seq, Seq2: Word);
  1554. var
  1555.   lpkt: TRawPkt;
  1556. begin
  1557.   PktInitRaw(@lpkt);
  1558.   PktInt(@lpkt, $5F05, 2);    //CLI_SEARCHBYNAME
  1559.   if Length(FirstName) <> 0 then
  1560.   begin
  1561.     PktInt(@lpkt, $4001, 2);    //The key to search for: 0x140 = 320 = first name.
  1562.     PktLLNTS(@lpkt, FirstName); //The first name to search for.
  1563.   end;
  1564.   if Length(LastName) <> 0 then
  1565.   begin
  1566.     PktInt(@lpkt, $4a01, 2);    //The key to search for: 0x14a = 330 = last name.
  1567.     PktLLNTS(@lpkt, LastName);  //The last name to search for.
  1568.   end;
  1569.   if Length(NickName) <> 0 then
  1570.   begin
  1571.     PktInt(@lpkt, $5401, 2);    //The key to search for: 0x154 = 340 = nick.
  1572.     PktLLNTS(@lpkt, NickName);  //The nick name to search for.
  1573.   end;
  1574.   if Length(Email) <> 0 then
  1575.   begin
  1576.     PktInt(@lpkt, $5e01, 2);    //The key to search for: 0x15e = 350 = email address.
  1577.     PktLLNTS(@lpkt, Email);     //The email address to search for.
  1578.   end;
  1579.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1580. end;
  1581.  
  1582. {Ask for a random UIN from a user in given chat group.}
  1583. procedure CreateCLI_SEARCHRANDOM(Pkt: PRawPkt; UIN: LongWord; Group: Word; var Seq, Seq2: Word);
  1584. var
  1585.   lpkt: TRawPkt;
  1586. begin
  1587.   PktInitRaw(@lpkt);
  1588.   PktInt(@lpkt, $4E07, 2); //CLI_SEARCHRANDOM Channel: 2, SNAC(21,2) 2000/1870
  1589.   PktInt(@lpkt, Swap16(Group), 2); //The random chat group to request a UIN from.
  1590.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1591. end;
  1592.  
  1593. {Do an extensive search for a user.}
  1594. procedure CreateCLI_SEARCHWP(Pkt: PRawPkt; UIN: LongWord; First, Last, Nick, Email: String; MinAge, MaxAge: Word; Gender: Byte; Language: Byte; City, State: String; Country: Word; Company, Department, Position: String; Occupation: Byte; Past: Word; PastDesc: String; Interests: Word; InterDesc: String; Affiliation: Word; AffiDesc, HomePage: String; Online: Byte; var Seq, Seq2: Word);
  1595. var
  1596.   lpkt: TRawPkt;
  1597. begin
  1598.   if (Gender <> GEN_MALE) and (Gender <> GEN_FEMALE) then
  1599.     Gender := 0;                        //Don't care about gender
  1600.   PktInitRaw(@lpkt);                    //Initialize temporary packet
  1601.   PktInt(@lpkt, $3305, 2);              //CLI_SEARCHWP Channel: 2, SNAC(21,2) 2000/1331
  1602.   PktLNTS(@lpkt, First);                //The first name to search for.
  1603.   PktLNTS(@lpkt, Last);                 //The last name to search for.
  1604.   PktLNTS(@lpkt, Nick);                 //The nick name to search for.
  1605.   PktLNTS(@lpkt, Email);                //The email to search for.
  1606.   PktInt(@lpkt, Swap16(MinAge), 2);     //The minimum age to search for.
  1607.   PktInt(@lpkt, Swap16(MaxAge), 2);     //The maximum age to search for.
  1608.   PktInt(@lpkt, Gender, 1);             //The sex to search for.; 1 - female; 2 - male; 0 - don't care
  1609.   PktInt(@lpkt, Language, 1);           //The language to search for.
  1610.   PktLNTS(@lpkt, City);                 //The city to search for.
  1611.   PktLNTS(@lpkt, State);                //The state to search for.
  1612.   PktInt(@lpkt, Swap16(Country), 2);    //The country to search for.
  1613.   PktLNTS(@lpkt, Company);              //The company to search for.
  1614.   PktLNTS(@lpkt, Department);           //The department to search for.
  1615.   PktLNTS(@lpkt, Position);             //The position to search for.
  1616.   PktInt(@lpkt, Occupation, 1);         //The occupation to search for.
  1617.   PktLInt(@lpkt, Past, 2);              //The past information to search for.
  1618.   PktLNTS(@lpkt, PastDesc);             //The past description to search for.
  1619.   PktLInt(@lpkt, Interests, 2);         //The interests category to search for.
  1620.   PktLNTS(@lpkt, InterDesc);            //The interests description to search for.
  1621.   PktLInt(@lpkt, Affiliation, 2);       //The affiliation to search for.
  1622.   PktLNTS(@lpkt, AffiDesc);             //The affiliation description to search for.
  1623.   PktInt(@lpkt, 0, 2);                  //The home page category to search for.
  1624.   PktLNTS(@lpkt, HomePage);             //The home page description to search for.
  1625.   PktInt(@lpkt, Online, 1);             //Set to 1 if the searched contacts have to be online, 0 otherwise.
  1626.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1627. end;
  1628.  
  1629. {Set more information about yourself.}
  1630. 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);
  1631. var
  1632.   lpkt: TRawPkt;
  1633. begin
  1634.   if (Gender <> GEN_MALE) and (Gender <> GEN_FEMALE) then
  1635.     Gender := 0;                //Gender not specified.
  1636.   PktInitRaw(@lpkt);            //Initialize packet
  1637.   PktInt(@lpkt, $FD03, 2);      //CLI_METASETMORE Channel: 2, SNAC(21,2) 2000/1021 
  1638.   PktLInt(@lpkt, Age, 2);       //Your age.
  1639.   PktInt(@lpkt, Gender, 1);     //Your gender.
  1640.   PktLNTS(@lpkt, HomePage);     //Your personal home page.
  1641.   PktLInt(@lpkt, BirthYear, 2); //Your year of birth.
  1642.   PktInt(@lpkt, BirthMonth, 1); //Your month of birth.
  1643.   PktInt(@lpkt, BirthDay, 1);   //Your day of birth.
  1644.   PktInt(@lpkt, Lang1, 1);      //Your first language. Numbers according to a table.
  1645.   PktInt(@lpkt, Lang2, 1);      //Your second language. Numbers according to a table.
  1646.   PktInt(@lpkt, Lang3, 1);      //Your third language. Numbers according to a table.
  1647.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1648. end;
  1649.  
  1650. {Set general information about yourself.}
  1651. 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);
  1652. var
  1653.   lpkt: TRawPkt;
  1654. begin
  1655.   PktInitRaw(@lpkt);
  1656.   PktInt(@lpkt, $EA03, 2);      //CLI_METASETGENERAL Channel: 2, SNAC(21,2) 2000/1002
  1657.   PktLNTS(@lpkt, NickName);     //The nick of the user.
  1658.   PktLNTS(@lpkt, FirstName);    //The first name of the user.
  1659.   PktLNTS(@lpkt, LastName);     //The last name of the user.
  1660.   PktLNTS(@lpkt, Email);        //The email address of the user.
  1661.   PktLNTS(@lpkt, City);         //The city the user lives in.
  1662.   PktLNTS(@lpkt, State);        //The state the user lives in.
  1663.   PktLNTS(@lpkt, Phone);        //The phone number of the user.
  1664.   PktLNTS(@lpkt, Fax);          //The fax number of the user.
  1665.   PktLNTS(@lpkt, Street);       //The street the user lives in.
  1666.   PktLNTS(@lpkt, Cellular);     //The cell phone number of the user.
  1667.   PktLNTS(@lpkt, Zip);          //The zip code of the user.
  1668.   PktLInt(@lpkt, Country, 2);   //The country the user lives in according to a table.
  1669.   PktInt(@lpkt, TimeZone, 1);   //The timezone the user lives in, as multiples of 30minutes relative to UTC.
  1670.   PktInt(@lpkt, Ord(PublishEmail), 1); //Publush email: 1 = yes, 0 = no. 
  1671.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1672. end;
  1673.  
  1674. {Set the about string.}
  1675. procedure CreateCLI_METASETABOUT(Pkt: PRawPkt; UIN: LongWord; const About: String; var Seq, Seq2: Word);
  1676. var
  1677.   lpkt: TRawPkt;
  1678. begin
  1679.   PktInitRaw(@lpkt);
  1680.   PktInt(@lpkt, $0604, 2);      //CLI_METASETABOUT Channel: 2, SNAC(21,2) 2000/1030
  1681.   PktLNTS(@lpkt, About);        //The about information string to set.
  1682.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1683. end;
  1684.  
  1685. {Send SMS message.}
  1686. procedure CreateCLI_SENDSMS(Pkt: PRawPkt; UIN: LongWord; const Destination, Text: String; CodePage: Word; const Time: String; var Seq, Seq2: Word);
  1687. var
  1688.   lpkt: TRawPkt;
  1689.   S: String;
  1690. begin
  1691.   PktInitRaw(@lpkt);
  1692.   PktInt(@lpkt, $8214, 2);      //CLI_SENDSMS Channel: 2, SNAC(21,2) 2000/5250
  1693.   PktInt(@lpkt, $0001, 2);      //Unknown: 0x1 = 1.
  1694.   PktInt(@lpkt, $0016, 2);      //Unknown: 0x16 = 22.
  1695.   PktInt(@lpkt, 0, 4);
  1696.   PktInt(@lpkt, 0, 4);
  1697.   PktInt(@lpkt, 0, 4);
  1698.   PktInt(@lpkt, 0, 4);
  1699.   //Format message
  1700.   S := '<icq_sms_message>' +
  1701.        '<destination>' + Destination + '</destination>' +
  1702.        '<text>' + StrToUTF8(Text) + '</text>' +
  1703.        '<codepage>' + IntToStr(CodePage) + '</codepage>' +
  1704.        '<senders_UIN>' + IntToStr(UIN) + '</senders_UIN>' +
  1705.        '<senders_name>TICQClient</senders_name>' +
  1706.        '<delivery_receipt>Yes</delivery_receipt>' +
  1707.        '<time>' + Time + '</time>' +
  1708.        '</icq_sms_message>';
  1709.   PktTLV(@lpkt, 0, S);          //The message as a XML entity
  1710.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1711. end;
  1712.  
  1713. {Sends a messaged with advanced options}
  1714. procedure CreateCLI_SENDMSG_ADVANCED(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; const Msg: String; RTFFormat: Boolean; var Seq: Word);
  1715. var
  1716.   lpTLV05: TRawPkt;
  1717.   lpTLV2711: TRawPkt;
  1718. const
  1719.   StrGuid: String = '{97B12751-243C-4334-AD22-D6ABF73F1492}';
  1720.   Capabilities: array[0..15] of Byte = ($09, $46, $13, $49, $4C, $7F, $11, $D1,
  1721.                                         $82, $22, $44, $45, $53, $54, $00, $00);
  1722. begin
  1723.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1724.   PktSnac(Pkt, $04, $06, 0, 0);                 //Snac: Type x04/x06, ID x0000, Flags 0
  1725.   PktInt(Pkt, ITime, 4);                        //Seems to be a time stamp in 1/1500 sec since 8am of that Sunday.
  1726.   PktInt(Pkt, IRandom, 2);                      //A seemingly random ID generated for each message.
  1727.   PktInt(Pkt, $00000002, 4);                    //The message type used
  1728.   PktLStr(Pkt, IntToStr(UIN));                  //Destination UIN.
  1729.  
  1730.   PktInitRaw(@lpTLV2711);                       //TLV(2711)
  1731.   PktInt(@lpTLV2711, $1b, 1);                   //If this value is not present, this is not a message packet.
  1732.   PktInt(@lpTLV2711, $0008, 2);                 //This is the version of the TCP protocol that the sending client uses.
  1733.   PktInt(@lpTLV2711, $00, 1);                   //Unknown
  1734.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1735.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1736.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1737.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1738.   PktInt(@lpTLV2711, $0000, 2);                 //Unknown
  1739.   PktInt(@lpTLV2711, $03, 1);                   //Unknown
  1740.   PktInt(@lpTLV2711, $00000000, 4);             //0 = normal message, 4 = file ok or file request.
  1741.   PktInt(@lpTLV2711, $FFFF, 2);                 //SEQ1
  1742.   PktInt(@lpTLV2711, $0e00, 2);                 //Unknown, seen: 0x1200 and 0x0e00.
  1743.   PktInt(@lpTLV2711, $FFFF, 2);                 //SEQ1
  1744.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1745.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1746.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1747.   PktInt(@lpTLV2711, $01, 1);                   //1 - normal message
  1748.   PktInt(@lpTLV2711, $00, 1);                   //00 - normal message 80 - multiple recipients 03 - auto reply message request.
  1749.   PktInt(@lpTLV2711, $0000, 2);                 //Usually 0, seen 0x2000.
  1750.   PktInt(@lpTLV2711, $0000, 2);                 //Usually 0, seen 0x0002 in information request messages.
  1751.   PktLNTS(@lpTLV2711, Msg);                     //The message!
  1752.   PktInt(@lpTLV2711, $00000000, 4);             //Only present in actual real messages, this will be the background color of the text box in RGB0 format.
  1753.   PktInt(@lpTLV2711, $FFFFFF00, 4);             //Only present in actual real messages, this will be the text color of the message in RGB0 format.
  1754.   if RTFFormat then                             //If we are using RTF format, then add GUID
  1755.   begin
  1756.     PktLInt(@lpTLV2711, Length(StrGuid), 4);    //This is a little-endian string length of the following GUID. This is only present in real messages sent by the latest 2001b client build 3659.
  1757.     PktStr(@lpTLV2711, StrGuid);                //This GUID seems to indicate that the client is capable of handling Multibyte Wide Character Strings as messages. Only present in real messages sent by build 3659 2001b clients.
  1758.   end;
  1759.  
  1760.   PktInitRaw(@lpTLV05);                         //TLV(05)
  1761.   PktInt(@lpTLV05, $0000, 2);                   //0x0000 - normal message
  1762.   PktInt(@lpTLV05, ITime, 4);                   //Seems to be a time stamp in 1/1500 sec since 8am of that Sunday.
  1763.   PktInt(@lpTLV05, IRandom, 2);                 //A seemingly random ID generated for each message.
  1764.   PktInt(@lpTLV05, $0000, 2);                   //Unknown: 0.
  1765.   PktAddArrBuf(@lpTLV05, @Capabilities, 16);    //One of the capabilities sent in CLI_SETUSERINFO
  1766.   PktTLV(@lpTLV05, $000a, 2, $0001);            //0x0001 - normal message 0x0002 - file ack or file ok
  1767.   PktTLV(@lpTLV05, $000f, 0, $00);              //Unknown, empty.
  1768.  
  1769.   PktTLV(@lpTLV05, $2711, lpTLV2711.Len, @lpTLV2711); //Incapsulate TLV2711 into TLV05
  1770.  
  1771.   PktTLV(Pkt, $05, lpTLV05.Len, @lpTLV05);      //Incapsulate TLV05 into Pkt
  1772.  
  1773.   PktTLV(Pkt, $0003, 0, 0);                     //Unknown, empty TLV(03)
  1774.   PktFinal(Pkt);                                //Finalize packet
  1775. end;
  1776.  
  1777. {Sends CLI_HELLO, used in registering the new UIN}
  1778. procedure CreateCLI_HELLO(Pkt: PRawPkt; var Seq: Word);
  1779. begin
  1780.   PktInit(Pkt, 1, Seq);                         //Channel 2
  1781.   PktInt(Pkt, $00000001, 4);                    //Always sent as the first parameter of a Channel 1 packet.
  1782.   PktFinal(Pkt);                                //Finalize packet
  1783. end;
  1784.  
  1785. {Sends CLI_HELLO, used in unregistering the existing UIN}
  1786. procedure CreateCLI_GOODBYE(Pkt: PRawPkt; var Seq: Word);
  1787. begin
  1788.   PktInit(Pkt, 1, Seq);                         //Channel 2
  1789.   PktFinal(Pkt);                                //Finalize packet
  1790. end;
  1791.  
  1792. {Register a new UIN.}
  1793. procedure CreateCLI_REGISTERUSER(Pkt: PRawPkt; const Password: String; var Seq: Word);
  1794. var
  1795.   lpTLV01: TRawPkt;
  1796. begin
  1797.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1798.   PktSnac(Pkt, $17, $04, 0, 0);                 //Snac: Type x17/x04, ID x0000, Flags 0
  1799.  
  1800.   PktInitRaw(@lpTLV01);                         //TLV(01), - this TLV contains all information needed to request a new UIN.
  1801.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1802.   PktInt(@lpTLV01, $28000300, 4);               //Unknown.
  1803.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1804.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1805.   PktInt(@lpTLV01, $9E270000, 4);               //Unknown. Seen: 03 46 00 00, B4 25 00 00, 9E 27 00 00.
  1806.   PktInt(@lpTLV01, $9E270000, 4);               //Same UNKNOWN2 as above.
  1807.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1808.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1809.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1810.   PktInt(@lpTLV01, $00000000, 4);               //Unknown: empty.
  1811.   PktLNTS(@lpTLV01, Password);                  //The password to use with your new UIN.
  1812.   PktInt(@lpTLV01, $9E270000, 4);               //The same UNKNOWN2 again.
  1813.   PktInt(@lpTLV01, $0000, 2);                   //Unknown: empty.
  1814.   PktInt(@lpTLV01, $0302, 2);                   //Unknown. Seen: CF 01, 03 02.
  1815.  
  1816.   PktTLV(Pkt, $01, lpTLV01.Len, @lpTLV01);      //Incapsulate TLV01 into Pkt
  1817.   PktFinal(Pkt);                                //Finalize packet
  1818. end;
  1819.  
  1820. {Request an auto-away message.}
  1821. procedure CreateCLI_REQAWAYMSG(Pkt: PRawPkt; ITime, IRandom, UIN: LongWord; Status: Byte; var Seq: Word);
  1822. var
  1823.   lpTLV05: TRawPkt;
  1824.   lpTLV2711: TRawPkt;
  1825. const
  1826.   Capabilities: array[0..15] of Byte = ($09, $46, $13, $49, $4C, $7F, $11, $D1,
  1827.                                         $82, $22, $44, $45, $53, $54, $00, $00);
  1828. begin
  1829.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1830.   PktSnac(Pkt, $04, $06, 0, 0);                 //Snac: Type x04/x06, ID x0000, Flags 0
  1831.   PktInt(Pkt, ITime, 4);                        //Seems to be a time stamp in 1/1500 sec since 8am of that Sunday.
  1832.   PktInt(Pkt, IRandom, 2);                      //A seemingly random ID generated for each message.
  1833.   PktInt(Pkt, $00000002, 4);                    //The message type used
  1834.   PktLStr(Pkt, IntToStr(UIN));                  //Destination UIN.
  1835.  
  1836.   PktInitRaw(@lpTLV2711);                       //TLV(2711)
  1837.   PktInt(@lpTLV2711, $1b, 1);                   //If this value is not present, this is not a message packet.
  1838.   PktInt(@lpTLV2711, $0008, 2);                 //This is the version of the TCP protocol that the sending client uses.
  1839.   PktInt(@lpTLV2711, $00, 1);                   //Unknown
  1840.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1841.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1842.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1843.   PktInt(@lpTLV2711, $00000000, 4);             //Caps, empty
  1844.   PktInt(@lpTLV2711, $0000, 2);                 //Unknown
  1845.   PktInt(@lpTLV2711, $03, 1);                   //Unknown
  1846.   PktInt(@lpTLV2711, $00000000, 4);             //0 = normal message, 4 = file ok or file request.
  1847.   PktInt(@lpTLV2711, $FFFF, 2);                 //SEQ1
  1848.   PktInt(@lpTLV2711, $0e00, 2);                 //Unknown, seen: 0x1200 and 0x0e00.
  1849.   PktInt(@lpTLV2711, $FFFF, 2);                 //SEQ1
  1850.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1851.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1852.   PktInt(@lpTLV2711, $00000000, 4);             //Unknown, always zero.
  1853.   PktInt(@lpTLV2711, Status, 1);                //Auto-msg-req
  1854.   PktInt(@lpTLV2711, $03, 1);                   //Msg-flags: special (used for auto-msg-req)
  1855.   PktInt(@lpTLV2711, $00000100, 4);             //Unknown
  1856.   PktInt(@lpTLV2711, $0100, 2);                 //Unknown
  1857.   PktInt(@lpTLV2711, $0000, 2);                 //Unknown
  1858.  
  1859.   PktInitRaw(@lpTLV05);                         //TLV(05)
  1860.   PktInt(@lpTLV05, $0000, 2);                   //0x0000 - normal message
  1861.   PktInt(@lpTLV05, ITime, 4);                   //Seems to be a time stamp in 1/1500 sec since 8am of that Sunday.
  1862.   PktInt(@lpTLV05, IRandom, 2);                 //A seemingly random ID generated for each message.
  1863.   PktInt(@lpTLV05, $0000, 2);                   //Unknown: 0.
  1864.   PktAddArrBuf(@lpTLV05, @Capabilities, 16);    //One of the capabilities sent in CLI_SETUSERINFO
  1865.   PktTLV(@lpTLV05, $000a, 2, $0001);            //0x0001 - normal message 0x0002 - file ack or file ok
  1866.   PktTLV(@lpTLV05, $000f, 0, $00);              //Unknown, empty.
  1867.  
  1868.   PktTLV(@lpTLV05, $2711, lpTLV2711.Len, @lpTLV2711); //Incapsulate TLV2711 into TLV05
  1869.  
  1870.   PktTLV(Pkt, $05, lpTLV05.Len, @lpTLV05);      //Incapsulate TLV05 into Pkt
  1871.  
  1872.   PktTLV(Pkt, $0003, 0, 0);                     //Unknown, empty TLV(03)
  1873.   PktFinal(Pkt);                                //Finalize packet
  1874. end;
  1875.  
  1876. {Unregister an UIN number.}
  1877. procedure CreateCLI_UNREGUIN(Pkt: PRawPkt; UIN: LongWord; const Password: String; var Seq, Seq2: Word);
  1878. var
  1879.   lpkt: TRawPkt;
  1880. begin
  1881.   PktInitRaw(@lpkt);
  1882.   PktInt(@lpkt, $c404, 2);                      //CLI_METAUNREG Channel: 2, SNAC(21,2) 2000/1220
  1883.   PktLInt(@lpkt, UIN, 4);                       //User's UIN
  1884.   PktLNTS(@lpkt, Password);                     //User's Password
  1885.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1886. end;
  1887.  
  1888. {Change user's password.}
  1889. procedure CreateCLI_METASETPASS(Pkt: PRawPkt; UIN: LongWord; const Password: String; var Seq, Seq2: Word);
  1890. var
  1891.   lpkt: TRawPkt;
  1892. begin
  1893.   PktInitRaw(@lpkt);
  1894.   PktInt(@lpkt, $2e04, 2);                      //CLI_METASETPASS Channel: 2, SNAC(21,2) 2000/1070
  1895.   PktLNTS(@lpkt, Password);                     //User's Password
  1896.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1897. end;
  1898.  
  1899. {Set permissions.}
  1900. procedure CreateCLI_METASETPERMISSIONS(Pkt: PRawPkt; UIN: LongWord; AuthorizationRequired, WebAware: Boolean; var Seq, Seq2: Word);
  1901. var
  1902.   lpkt: TRawPkt;
  1903. begin
  1904.   PktInitRaw(@lpkt);
  1905.   PktInt(@lpkt, $2404, 2);                      //CLI_METASETPERMISSION Channel: 2, SNAC(21,2) 2000/1060
  1906.   PktInt(@lpkt, Ord(not AuthorizationRequired), 1); //Authorization required?
  1907.   PktInt(@lpkt, Ord(WebAware), 1);              //Webaware?
  1908.   PktInt(@lpkt, $0100, 2);                      //Unknown: 01 00
  1909.   CreateCLI_TOICQSRV(Pkt, UIN, $07D0, @lpkt, lpkt.Len, Seq, Seq2); //Incapsulate in CLI_TOICQSRV
  1910. end;
  1911.  
  1912. {Request authorization from another user so we can add them to our contact list.}
  1913. procedure CreateCLI_REQAUTH(Pkt: PRawPkt; UIN: LongWord; Msg: String; var Seq: Word);
  1914. begin
  1915.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1916.   PktSnac(Pkt, $13, $18, $18, 0);               //SNAC: 0x13/0x18, Ref 0x00000018, Flags 0
  1917.   PktLStr(Pkt, IntToStr(UIN));                  //The UIN of the user authorization is requested from.
  1918.   PktWStr(Pkt, Msg);                            //Message sent to user in the authorization request.
  1919.   PktInt(Pkt, $0000, 2);                        //Unknown: empty.
  1920.   PktFinal(Pkt);                                //Finalize packet.
  1921. end;
  1922.  
  1923. {Keep alive packet.}
  1924. procedure CreateCLI_KEEPALIVE(Pkt: PRawPkt; var Seq: Word);
  1925. begin
  1926.   PktInit(Pkt, 5, Seq);                         //Channel 5
  1927.   PktFinal(Pkt);                                //Finalize packet
  1928. end;
  1929.  
  1930. {This SNAC is sent just before CLI_ADDBUDDY when adding a new contact to the
  1931. contact list. This SNAC is NOT sent when adding a UIN to the Ignore list. A
  1932. CLI_ADDEND when finished modifying the server side contact list.}
  1933. procedure CreateCLI_ADDSTART(Pkt: PRawPkt; FirstUpload: Boolean; var Seq: Word);
  1934. begin
  1935.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1936.   PktSnac(Pkt, $13, $11, $00000011, 0);         //SNAC: 0x13/0x18, Ref 0x00000011, Flags 0
  1937.   if FirstUpload then
  1938.     PktInt(Pkt, $00010000, 4);                  //Add 0x00010000 value when uploading w/o authorization
  1939.   PktFinal(Pkt);                                //Finalize packet
  1940. end;
  1941.  
  1942. {This SNAC is sent to tell the server that modifications to the server side contact
  1943. list are finished.}
  1944. procedure CreateCLI_ADDEND(Pkt: PRawPkt; var Seq: Word);
  1945. begin
  1946.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1947.   PktSnac(Pkt, $13, $12, $00000012, 0);         //SNAC: 0x13/0x18, Ref 0x00000012, Flags 0
  1948.   PktFinal(Pkt);                                //Finalize packet
  1949. end;
  1950.  
  1951. {This SNAC contains a single header group as described in SRV_REPLYROSTER. Sent
  1952. when a user is added to the contact list and updates the server side contact list.}
  1953. procedure CreateCLI_UPDATEGROUP(Pkt: PRawPkt; Name: String; Tag: Word; IDs: TStringList; var Seq: Word);
  1954. var
  1955.   TLVC8: TRawPkt;
  1956.   i: Word;
  1957. begin
  1958.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1959.   PktSnac(Pkt, $13, $09, 0, 0);                 //SNAC: 0x13/0x09, Ref 0x00000000, Flags 0
  1960.   {Create temporary array with group values}
  1961.   PktInitRaw(@TLVC8);
  1962.   if IDs.Count > 0 then
  1963.     for i := 0 to IDs.Count - 1 do
  1964.       PktInt(@TLVC8, StrToInt(IDs.Strings[i]), 2);
  1965.   PktWStr(Pkt, StrToUTF8(Name));                //The name of this group.
  1966.   PktInt(Pkt, Tag, 2);                          //The tag ID of this group. All members of this group have the same ID.
  1967.   PktInt(Pkt, $0000, 2);                        //The individual ID assigned to a contact. 0 for group headers.
  1968.   PktInt(Pkt, $0001, 2);                        //The type of the group. 0x0001 - Larger grouping header.
  1969.   PktInt(Pkt, TLVC8.Len + 4, 2);                //The number of bytes in the following TLVs. May be zero.
  1970.   PktTLV(Pkt, $00c8, TLVC8.Len, @TLVC8);        //Sent only with group header, a list of all IDs in this group.
  1971.   PktFinal(Pkt);                                //Finalize packet
  1972. end;
  1973.  
  1974. {Same as CreateCLI_UPDATEGROUP modified to use only with buddies. Prototype. Can be used for UPDATEBUDDY and ADDBUDDY}
  1975. procedure __CreateCLI_UPDATEBUDDY(Pkt: PRawPkt; A: Byte; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized, IsGroup: Boolean; var Seq: Word);
  1976. var
  1977.   TLVs: TRawPkt;
  1978. begin
  1979.   PktInit(Pkt, 2, Seq);                         //Channel 2
  1980.   PktSnac(Pkt, $13, A, 0, 0);                   //SNAC: 0x13/0x08|0x09, Ref 0x00000000, Flags 0
  1981.   {Create temporary array with addition TLVs}
  1982.   PktInitRaw(@TLVs);
  1983.   if Name <> '' then
  1984.     PktTLV(@TLVs, $0131, StrToUTF8(Name));
  1985.   if NotAuthorized then
  1986.     PktTLV(@TLVs, $0066, 0, 0);
  1987.   if SMSNumber <> '' then
  1988.     PktTLV(@TLVs, $013A, StrToUTF8(SMSNumber));
  1989.   PktWStr(Pkt, UIN);                            //The name of this group/buddy's UIN
  1990.   PktInt(Pkt, Tag, 2);                          //The tag ID of this group. All members of this group have the same ID.
  1991.   PktInt(Pkt, ID, 2);                           //The individual ID assigned to a contact. 0 for group headers.
  1992.   PktInt(Pkt, BuddyType, 2);                    //The type of the buddy.
  1993.   if IsGroup or ((A = $0A) and (TLVs.Len <> 0)) or (A <> $0A) then
  1994.     PktInt(Pkt, TLVs.Len, 2);                   //The number of bytes in the following TLVs. May be zero.
  1995.   PktAddArrBuf(Pkt, @TLVs, TLVs.Len);           //Sent only with group header, a list of all IDs in this group.
  1996.   PktFinal(Pkt);                                //Finalize packet
  1997. end;
  1998.  
  1999. {Update SSL buddy.}
  2000. procedure CreateCLI_UPDATEBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized: Boolean; var Seq: Word);
  2001. begin
  2002.   __CreateCLI_UPDATEBUDDY(Pkt, $09, UIN, Name, SMSNumber, Tag, ID, BuddyType, NotAuthorized, False, Seq);
  2003. end;
  2004.  
  2005. {Add SSL buddy.}
  2006. procedure CreateCLI_ADDBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized: Boolean; var Seq: Word);
  2007. begin
  2008.   __CreateCLI_UPDATEBUDDY(Pkt, $08, UIN, Name, SMSNumber, Tag, ID, BuddyType, NotAuthorized, False, Seq);
  2009. end;
  2010.  
  2011. {Delete buddy from SSL.}
  2012. procedure CreateCLI_DELETEBUDDY(Pkt: PRawPkt; UIN, Name, SMSNumber: String; Tag, ID: Word; BuddyType: Word; NotAuthorized, IsGroup: Boolean; var Seq: Word);
  2013. begin
  2014.   __CreateCLI_UPDATEBUDDY(Pkt, $0A, UIN, Name, SMSNumber, Tag, ID, BuddyType, NotAuthorized, IsGroup, Seq);
  2015. end;
  2016.  
  2017.  
  2018. {Conver SNAC's numberic representation to string name}
  2019. function SnacToStr(Family, SubType: Word): String;
  2020. begin
  2021.   Result := 'unknown';
  2022.   {CLI}
  2023.   if (Family = 1) and (SubType = 2) then
  2024.     Result := 'CLI_READY'
  2025.   else if (Family = 1) and (SubType = 6) then
  2026.     Result := 'CLI_RATESREQUEST'
  2027.   else if (Family = 1) and (SubType = 8) then
  2028.     Result := 'CLI_ACKRATES'
  2029.   else if (Family = 1) and (SubType = $E) then
  2030.     Result := 'CLI_REQINFO'
  2031.   else if (Family = 1) and (SubType = $17) then
  2032.     Result := 'CLI_FAMILIES'
  2033.   else if (Family = 1) and (SubType = $1E) then
  2034.     Result := 'CLI_SETSTATUS'
  2035.   else if (Family = 2) and (SubType = $2) then
  2036.     Result := 'CLI_REQLOCATION'
  2037.   else if (Family = 2) and (SubType = $4) then
  2038.     Result := 'CLI_SETUSERINFO'
  2039.   else if (Family = 3) and (SubType = $2) then
  2040.     Result := 'CLI_REQBUDDY'
  2041.   else if (Family = 3) and (SubType = $4) then
  2042.     Result := 'CLI_ADDCONTACT'
  2043.   else if (Family = 3) and (SubType = $5) then
  2044.     Result := 'CLI_REMOVECONTACT'
  2045.   else if (Family = 4) and (SubType = $2) then
  2046.     Result := 'CLI_SETICBM'
  2047.   else if (Family = 4) and (SubType = $4) then
  2048.     Result := 'CLI_REQICBM'
  2049.   else if (Family = 4) and (SubType = $6) then
  2050.     Result := 'CLI_SENDMSG'
  2051.   else if (Family = 4) and (SubType = $B) then
  2052.     Result := 'CLI_ACKMSG'
  2053.   else if (Family = 9) and (SubType = $2) then
  2054.     Result := 'CLI_REQBOS'
  2055.   else if (Family = 9) and (SubType = $5) then
  2056.     Result := 'CLI_ADDVISIBLE'
  2057.   else if (Family = 9) and (SubType = $6) then
  2058.     Result := 'CLI_REMVISIBLE'
  2059.   else if (Family = 9) and (SubType = $7) then
  2060.     Result := 'CLI_ADDINVISIBLE'
  2061.   else if (Family = 9) and (SubType = $8) then
  2062.     Result := 'CLI_REMINVISIBLE'
  2063.   else if (Family = $13) and (SubType = $2) then
  2064.     Result := 'CLI_REQUNKNOWN'
  2065.   else if (Family = $13) and (SubType = $4) then
  2066.     Result := 'CLI_REQROSTER2'
  2067.   else if (Family = $13) and (SubType = $5) then
  2068.     Result := 'CLI_REQROSTER'
  2069.   else if (Family = $13) and (SubType = $7) then
  2070.     Result := 'CLI_UNKNOWN1'
  2071.   else if (Family = $13) and (SubType = $8) then
  2072.     Result := 'CLI_ADDBUDDY'
  2073.   else if (Family = $13) and (SubType = $9) then
  2074.     Result := 'CLI_UPDATEGROUP'
  2075.   else if (Family = $13) and (SubType = $A) then
  2076.     Result := 'CLI_DELETEBUDDY'
  2077.   else if (Family = $13) and (SubType = $11) then
  2078.     Result := 'CLI_ADDSTART'
  2079.   else if (Family = $13) and (SubType = $12) then
  2080.     Result := 'CLI_ADDEND'
  2081.   else if (Family = $13) and (SubType = $18) then
  2082.     Result := 'CLI_REQAUTH'
  2083.   else if (Family = $13) and (SubType = $1A) then
  2084.     Result := 'CLI_AUTHORIZE'
  2085.   else if (Family = $15) and (SubType = $2) then
  2086.     Result := 'CLI_TOICQSRV'
  2087.   else if (Family = $17) and (SubType = $4) then
  2088.     Result := 'CLI_REGISTERUSER'
  2089.   {SRV}
  2090.   else if (Family = $1) and (SubType = $3) then
  2091.     Result := 'SRV_FAMILIES'
  2092.   else if (Family = $1) and (SubType = $7) then
  2093.     Result := 'SRV_RATES'
  2094.   else if (Family = $1) and (SubType = $F) then
  2095.     Result := 'SRV_REPLYINFO'
  2096.   else if (Family = $1) and (SubType = $13) then
  2097.     Result := 'SRV_MOTD'
  2098.   else if (Family = $1) and (SubType = $18) then
  2099.     Result := 'SRV_FAMILIES2'
  2100.   else if (Family = $2) and (SubType = $3) then
  2101.     Result := 'SRV_REPLYLOCATION'
  2102.   else if (Family = $3) and (SubType = $3) then
  2103.     Result := 'SRV_REPLYBUDDY'
  2104.   else if (Family = $3) and (SubType = $B) then
  2105.     Result := 'SRV_USERONLINE'
  2106.   else if (Family = $3) and (SubType = $C) then
  2107.     Result := 'SRV_USEROFFLINE'
  2108.   else if (Family = $4) and (SubType = $5) then
  2109.     Result := 'SRV_REPLYICBM'
  2110.   else if (Family = $4) and (SubType = $7) then
  2111.     Result := 'SRV_RECVMSG'
  2112.   else if (Family = $4) and (SubType = $c) then
  2113.     Result := 'SRV_MSGACK_ADVANCED'
  2114.   else if (Family = $9) and (SubType = $3) then
  2115.     Result := 'SRV_REPLYBOS'
  2116.   else if (Family = $13) and (SubType = $3) then
  2117.     Result := 'SRV_REPLYUNKNOWN'
  2118.   else if (Family = $13) and (SubType = $6) then
  2119.     Result := 'SRV_REPLYROSTER'
  2120.   else if (Family = $13) and (SubType = $E) then
  2121.     Result := 'SRV_UPDATEACK'
  2122.   else if (Family = $13) and (SubType = $F) then
  2123.     Result := 'SRV_REPLYROSTEROK'
  2124.   else if (Family = $13) and (SubType = $19) then
  2125.     Result := 'SRV_AUTHORIZATION_REQUEST'
  2126.   else if (Family = $13) and (SubType = $1C) then
  2127.     Result := 'SRV_ADDEDYOU'
  2128.   else if (Family = $15) and (SubType = $3) then
  2129.     Result := 'SRV_FROMICQSRV'
  2130.   else if (Family = $17) and (SubType = $1) then
  2131.     Result := 'SRV_REGREFUSED'
  2132.   else if (Family = $17) and (SubType = $5) then
  2133.     Result := 'SRV_NEWUIN';
  2134. end;
  2135.  
  2136. {Convert meta command to string representation.}
  2137. function SrvMetaToStr(V1, V2: Word): String;
  2138. begin
  2139.   Result := '';
  2140.   if V1 = 2000 then
  2141.     case V2 of
  2142.       1002: Result := 'CLI_METASETGENERAL';
  2143.       1021: Result := 'CLI_METASETMORE';
  2144.       1030: Result := 'CLI_METASETABOUT';
  2145.       1060: Result := 'CLI_SETAUTH';
  2146.       1070: Result := 'CLI_METASETPASS';
  2147.       1220: Result := 'CLI_METAUNREG';      
  2148.       1232: Result := 'CLI_METAREQINFO';
  2149.       1331: Result := 'CLI_SEARCHWP';
  2150.       1375: Result := 'CLI_SEARCHBYPERSINF';
  2151.       1385: Result := 'CLI_SEARCHBYUIN';
  2152.       1395: Result := 'CLI_SEARCHBYMAIL';
  2153.       1870: Result := 'CLI_SEARCHRANDOM';
  2154.       1880: Result := 'CLI_METASETRANDOM';
  2155.       2200: Result := 'CLI_REQXML';
  2156.       5250: Result := 'CLI_SENDSMS';
  2157.     end
  2158.   else if V1 = 2010 then
  2159.     case V2 of
  2160.       1:   Result := 'SRV_SMSREFUSED';
  2161.       100: Result := 'SRV_METAGENERALDONE';
  2162.       120: Result := 'SRV_METAMOREDONE';
  2163.       130: Result := 'SRV_METAABOUTDONE';
  2164.       150: Result := 'SRV_SMSACK';
  2165.       160: Result := 'SRV_AUTHDONE';
  2166.       170: Result := 'SRV_METAPASSDONE';
  2167.       180: Result := 'SRV_METAUNREG';
  2168.       200: Result := 'SRV_METAGENERAL';
  2169.       210: Result := 'SRV_METAWORK';
  2170.       220: Result := 'SRV_METAMORE';
  2171.       230: Result := 'SRV_METAABOUT';
  2172.       235: Result := 'SRV_METAMOREEMAIL';
  2173.       240: Result := 'SRV_METAINTEREST';
  2174.       250: Result := 'SRV_METABACKGROUND';
  2175.       260: Result := 'SRV_METAINFO';
  2176.       270: Result := 'SRV_META270';
  2177.       420: Result := 'SRV_METAFOUND';
  2178.       430: Result := 'SRV_METALAST';
  2179.       870: Result := 'SRV_METARANDOM';
  2180.       880: Result := 'SRV_METARANDOMDONE';
  2181.     end
  2182.   else if V1 = 60 then
  2183.     Result := 'CLI_REQOFFLINEMSGS'
  2184.   else if V1 = 62 then
  2185.     Result := 'CLI_ACKOFFLINEMSGS'
  2186.   else if V1 = 65 then
  2187.     Result := 'SRV_OFFLINEMSG'
  2188.   else if V1 = 66 then
  2189.     Result := 'SRV_DONEOFFLINEMSGS';
  2190.   if Result = '' then
  2191.     Result := IntToStr(V1) + '/' + IntToStr(V2);
  2192. end;
  2193.  
  2194. {Convert peer command to string representation.}
  2195. function PeerCmdToStr(Cmd: Byte): String;
  2196. begin
  2197.   case Cmd of
  2198.     $01: Result := 'PEER_INIT_ACK';
  2199.     $02: Result := 'PEER_MSG';
  2200.     $03: Result := 'PEER_INIT2';
  2201.     $ff: Result := 'PEER_INIT';
  2202.   else
  2203.     Result := '';
  2204.   end;
  2205. end;
  2206.  
  2207. {Return Buffer in a string hex dump.}
  2208. function DumpPacket(Buffer: Pointer; BufLen: Word): String;
  2209. var
  2210.   S: String;
  2211.   i, n: Word;
  2212. begin
  2213.   for i := 1 to BufLen do
  2214.   begin
  2215.     S := S + IntToHex(PByte(LongWord(Buffer) + i - 1)^, 2) + ' ';
  2216.     if i mod 16 = 0 then
  2217.     begin
  2218.       S := S + '  ';
  2219.       for n := i - 15 to i do
  2220.       begin
  2221.         if (PByte(LongWord(Buffer) + n - 1)^ < $20) or (PByte(LongWord(Buffer) + n - 1)^ > $7F) then
  2222.           S := S + '.'
  2223.         else
  2224.           S := S + PChar(Buffer)[n - 1];
  2225.       end;
  2226.       S := S + #13#10;
  2227.     end;
  2228.   end;
  2229.   if BufLen mod 16 <> 0 then
  2230.   begin
  2231.     for i := 0 to 15 - (BufLen mod 16) do
  2232.       S := S + '   ';
  2233.     S := S + '  ';
  2234.     for i := BufLen mod 16 downto 1 do
  2235.     begin
  2236.       if (PByte(LongWord(Buffer) + BufLen - i)^ < $20) or (PByte(LongWord(Buffer) + BufLen - i)^ > $7F) then
  2237.         S := S + '.'
  2238.       else
  2239.         S := S + PChar(Buffer)[BufLen - i];
  2240.     end;
  2241.   end;
  2242.   Result := S;
  2243. end;
  2244.  
  2245. {Convert RTF enabled text to plain.}
  2246. function Rtf2Txt(const Value: String): String;
  2247. var
  2248.   i: Word;
  2249.   tag: Boolean;
  2250.   st: String;
  2251. begin
  2252.   Result := ''; tag := False; st := '';
  2253.   if Value = '' then Exit;
  2254.   if Copy(Value, 0, 6) <> '{\rtf1' then
  2255.   begin
  2256.     Result := Value;
  2257.     Exit;
  2258.   end;
  2259.   for i := 1 to Length(Value) do
  2260.   begin
  2261.     if Value[i] in ['\', '}', '{'] then
  2262.       tag := True;
  2263.     if Value[i + 1] in ['\', '}', '{'] then
  2264.     begin
  2265.       tag := False;
  2266.       if st <> '' then
  2267.       begin
  2268.         if st = 'par' then Result := Result + #13#10
  2269.         else if (st[1] = '''') and (Length(st) >= 3) then
  2270.         begin
  2271.           Delete(st, 1, 1);
  2272.           Result := Result + Chr(HexToInt(Copy(st, 0, 2))) + Copy(st, 3, Length(st) - 2);
  2273.         end
  2274.         else if ((Pos(' ', st) > 0) or ((Copy(st, 0, 3) = 'par') and (st <> 'pard'))) and (st[Length(st)] <> ';') then
  2275.         begin
  2276.           while (Pos(#13, st) > 0) do Delete(st, Pos(#13, st), 1);
  2277.           while (Pos(#10, st) > 0) do Delete(st, Pos(#10, st), 1);
  2278.           if Copy(st, 0, 3) = 'par' then
  2279.             Result := Result + #13#10 + Copy(st, 4, Length(st) - 3)
  2280.           else
  2281.             Result := Result + Copy(st, Pos(' ', st) + 1, Length(st) - Pos(' ', st));
  2282.         end;
  2283.       end;
  2284.       st := '';
  2285.     end;
  2286.     if tag then
  2287.       st := st + Value[i + 1];
  2288.   end;
  2289. end;
  2290.  
  2291. function StatusToStr(Value: LongWord): String;
  2292. begin
  2293.   {Remove any used flags.}
  2294.   Value := Value and not S_SHOWIP and not S_WEBAWARE and not S_ALLOWDCONN
  2295.                  and not S_ALLOWDAUTH and not S_ALLOWDLIST;
  2296.  
  2297.   if Value = S_INVISIBLE then
  2298.     Result := 'Invisible'
  2299.   else if Value = S_AWAY then
  2300.     Result := 'Away'
  2301.   else if Value = S_NA then
  2302.     Result := 'N/A'
  2303.   else if Value = S_OCCUPIED then
  2304.     Result := 'Occupied'
  2305.   else if Value = S_DND then
  2306.     Result := 'DND'
  2307.   else if Value = S_FFC then
  2308.     Result := 'FFC'
  2309.   else
  2310.     Result := 'Online';
  2311. end;
  2312.  
  2313. function CountryToStr(Value: Word): String;
  2314. var
  2315.   i: Word;
  2316. begin
  2317.   Result := '';
  2318.   for i := Low(Countries) to High(Countries) do
  2319.     if Countries[i].Ident = Value then
  2320.     begin
  2321.       Result := Countries[i].Value;
  2322.       Exit;
  2323.     end;
  2324. end;
  2325.  
  2326. function LanguageToStr(Value: Byte): String;
  2327. var
  2328.   i: Byte;
  2329. begin
  2330.   for i := Low(Languages) to High(Languages) do
  2331.     if Languages[i].Ident = Value then
  2332.     begin
  2333.       Result := Languages[i].Value;
  2334.       Exit;
  2335.     end;
  2336.   Result := '';
  2337. end;
  2338.  
  2339. function OccupationToStr(Value: Word): String;
  2340. begin
  2341.   if (Value >= Low(Occupations)) and (Value <= High(Occupations)) then
  2342.     Result := Occupations[Value].Value
  2343.   else
  2344.     Result := '';
  2345. end;
  2346.  
  2347. function InterestToStr(Value: Word): String;
  2348. begin
  2349.   if (Value >= Low(Interests)) and (Value <= High(Interests)) then
  2350.     Result := Interests[Value].Value
  2351.   else
  2352.     Result := '';
  2353. end;
  2354.  
  2355. function PastToStr(Value: Word): String;
  2356. var
  2357.   i: Word;
  2358. begin
  2359.   for i := Low(Pasts) to High(Pasts) do
  2360.     if Pasts[i].Ident = Value then
  2361.     begin
  2362.       Result := Pasts[i].Value;
  2363.       Exit;
  2364.     end;
  2365.   Result := '';
  2366. end;
  2367.  
  2368. function AffiliationToStr(Value: Word): String;
  2369. var
  2370.   i: Word;
  2371. begin
  2372.   for i := Low(Affiliations) to High(Affiliations) do
  2373.     if Affiliations[i].Ident = Value then
  2374.     begin
  2375.       Result := Affiliations[i].Value;
  2376.       Exit;
  2377.     end;
  2378.   Result := '';
  2379. end;
  2380.  
  2381. {Local raw packet from file.}
  2382. function LoadPacketRaw(Pkt: PRawPkt; const FName: String): Boolean;
  2383. function TestDigit(Digit: Char): Boolean;
  2384. begin
  2385.   Result := False;
  2386.   case Digit of
  2387.     '0'..'9': Result := True;
  2388.     'A', 'B', 'C', 'D', 'E', 'F',
  2389.     'a', 'b', 'c', 'd', 'e', 'f': Result := True;
  2390.   end;
  2391. end;
  2392. function Convert(Digit: Char): Byte;
  2393. begin
  2394.   Result := 0;
  2395.   case Digit of
  2396.     '0'..'9': Result := StrToInt(Digit);
  2397.     'A', 'a': Result := $A;
  2398.     'B', 'b': Result := $B;
  2399.     'C', 'c': Result := $C;
  2400.     'D', 'd': Result := $D;
  2401.     'E', 'e': Result := $E;
  2402.     'F', 'f': Result := $F;
  2403.   end;
  2404. end;
  2405. var
  2406.   F: TextFile;
  2407.   c, c1: Char;
  2408.   i: Integer;
  2409. begin
  2410.   PktInitRaw(Pkt);
  2411.   System.Assign(F, FName); Reset(F);
  2412.   while not Eof(F) do
  2413.   begin
  2414.     for i := 0 to 15 do
  2415.     begin
  2416.       Read(F, c);
  2417.       Read(F, c1);
  2418.       if TestDigit(c) and TestDigit(c1) then
  2419.         PktInt(Pkt, Convert(c) shl 4 + Convert(c1), 1);
  2420.       Read(F, c);
  2421.       if c = '' then Break;
  2422.     end;
  2423.     Readln(F);
  2424.   end;
  2425.   System.Close(F);
  2426.   Result := True;
  2427. end;
  2428.  
  2429. {Load low packet from file & extract snac header.}
  2430. function LoadPacket(Pkt: PRawPkt; const FName: String; var Flap: TFlapHdr; var Snac: TSnacHdr): Boolean;
  2431. begin
  2432.   Result := LoadPacketRaw(Pkt, FName);
  2433.   pkt^.Len := TFLAPSZ;
  2434.   GetSnac(Pkt, Snac);
  2435. end;
  2436.  
  2437. {Checks if the FileName is exists.}
  2438. function FileExists(const FileName: String): Boolean;
  2439. var
  2440.   Handle: THandle;
  2441.   FindData: TWin32FindData;
  2442. begin
  2443.   Handle := FindFirstFile(PChar(FileName), FindData);
  2444.   Result := (Handle <> INVALID_HANDLE_VALUE) and (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0);
  2445.   Windows.FindClose(Handle);
  2446. end;
  2447.  
  2448. {Get size of a file.}
  2449. function FileSize(const FName: String): LongWord;
  2450. var
  2451.   FileHandle: THandle;
  2452. begin
  2453.   Result := INVALID_FILE_SIZE;
  2454.   FileHandle := CreateFile(PChar(FName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_ALWAYS, 0, 0);
  2455.   if FileHandle = INVALID_HANDLE_VALUE then Exit;
  2456.   Result := GetFileSize(FileHandle, nil);
  2457.   CloseHandle(FileHandle);
  2458. end;
  2459.  
  2460. {Add some Text to FName file.}
  2461. procedure LogText(const FName, Text: String);
  2462. var
  2463.   F: TextFile;
  2464. begin
  2465.   if not FileExists(FName) then
  2466.   begin
  2467.     Assign(F, FName);
  2468.     {$I-}
  2469.     ReWrite(F);
  2470.     if IOResult <> 0 then
  2471.       Exit;
  2472.     {$I+}
  2473.     CloseFile(F);
  2474.   end;
  2475.   Assign(F, FName);
  2476.   {$I-}
  2477.   Append(F);
  2478.   if IOResult <> 0 then
  2479.     Exit;
  2480.   Writeln(F, Text);
  2481.   {$I+}
  2482.   CloseFile(F);
  2483. end;
  2484.  
  2485. procedure ShowMessage(const Value: String); overload;
  2486. begin
  2487.   MessageBox(0, PChar(Value), 'Message', 0);
  2488. end;
  2489.  
  2490. procedure ShowMessage(Value: LongWord); overload;
  2491. begin
  2492.   MessageBox(0, PChar(IntToStr(Value)), 'Message', 0);
  2493. end;
  2494.  
  2495. //Extract the name from the following string: 'AA=BB', where AA is name
  2496. function ExtractName(const Value: String): String;
  2497. var
  2498.   i: Word;
  2499. begin
  2500.   Result := '';
  2501.   i := Pos('=', Value);
  2502.   if i = 0 then
  2503.     Exit;
  2504.   Result := Copy(Value, 0, i - 1);
  2505. end;
  2506.  
  2507. //Extract the value from the following string: 'AA=BB', where BB is value
  2508. function ExtractValue(const Value: String): String;
  2509. var
  2510.   i: Word;
  2511. begin
  2512.   Result := '';
  2513.   i := Pos('=', Value);
  2514.   if i = 0 then
  2515.     Exit;
  2516.   Result := Copy(Value, i + 1, Length(Value) - i);
  2517. end;
  2518.  
  2519. {Convert string from UTF-8 format into ASCII}
  2520. function UTF8ToStr(Value: String): String;
  2521. var
  2522.   buffer: Pointer;
  2523.   BufLen: LongWord;
  2524. begin
  2525.   BufLen := Length(Value) + 4;
  2526.   GetMem(buffer, BufLen);
  2527.   FillChar(buffer^, BufLen, 0);
  2528.   MultiByteToWideChar(CP_UTF8, 0, @Value[1], BufLen - 4, buffer, BufLen);
  2529.   Result := WideCharToString(buffer);
  2530.   FreeMem(buffer, BufLen);
  2531. end;
  2532.  
  2533. {Convert string from UTF-8 format mixed with standart ASCII symbols($00..$7f)}
  2534. function UTF8ToStrSmart(Value: String): String;
  2535. var
  2536.   Digit: String;
  2537.   i: Word;
  2538.   HByte: Byte;
  2539.   Len: Byte;
  2540. begin
  2541.   Result := '';
  2542.   Len := 0;
  2543.   if Value = '' then Exit;
  2544.   for i := 1 to Length(Value) do
  2545.   begin
  2546.     if Len > 0 then
  2547.     begin
  2548.       Digit := Digit + Value[i];
  2549.       Dec(Len);
  2550.       if Len = 0 then
  2551.         Result := Result + UTF8ToStr(Digit);
  2552.     end else
  2553.     begin
  2554.       HByte := Ord(Value[i]);
  2555.       if HByte in [$00..$7f] then       //Standart ASCII chars
  2556.         Result := Result + Value[i]
  2557.       else begin
  2558.         //Get length of UTF-8 char
  2559.         if HByte and $C0 = $C0 then
  2560.           Len := 2
  2561.         else if HByte and $E0 = $E0 then
  2562.           Len := 3
  2563.         else if HByte and $F0 = $F0 then
  2564.           Len := 4
  2565.         else if HByte and $F8 = $F8 then
  2566.           Len := 5
  2567.         else if HByte and $FC = $FC then
  2568.           Len := 6
  2569.         else
  2570.           Exit;
  2571.         Dec(Len);
  2572.         Digit := Value[i];
  2573.       end;
  2574.     end;
  2575.   end;
  2576. end;
  2577.  
  2578. {Get an XML entry.}
  2579. function GetXMLEntry(const Tag, Msg: String): String;
  2580. var
  2581.   p1, p2: Word;
  2582. begin
  2583.   p1 := Pos('<' + Tag + '>', Msg);
  2584.   p2 := Pos('</' + Tag + '>', Msg);
  2585.   Result := Copy(Msg, p1 + Length(Tag) + 2, p2 - p1 - Length(Tag) - 2);
  2586. end;
  2587.  
  2588.  
  2589. {SMS functions}
  2590. {Convert string to UTF8 format}
  2591. function StrToUTF8(Value: String): String;
  2592. var
  2593.   buffer: Pointer;
  2594.   BufLen: LongWord;
  2595.   lpBuf: Pointer;
  2596. begin
  2597.   BufLen := Length(Value) * 2 + 4;
  2598.   GetMem(buffer, BufLen); FillChar(buffer^, BufLen, 0);
  2599.   GetMem(lpBuf, BufLen); FillChar(lpBuf^, BufLen, 0);
  2600.   StringToWideChar(Value, buffer, BufLen);
  2601.   WideCharToMultiByte(CP_UTF8, 0, buffer, -1, lpBuf, BufLen, nil, nil);
  2602.   FreeMem(buffer, BufLen);
  2603.   Result := PChar(lpBuf);
  2604.   FreeMem(lpBuf, BufLen);
  2605. end;
  2606.  
  2607. {Get current time in format like 'Mon, 19 Nov 2001 08:23:38 GMT'}
  2608. function GetSMSTime: String;
  2609.   function STime: String;
  2610.   var
  2611.     buf: array[0..15] of Char;
  2612.     recv_bytes: Integer;
  2613.     SysTime: TSystemTime;
  2614.   begin
  2615.     GetSystemTime(SysTime);
  2616.     recv_bytes := GetTimeFormat(LANG_ENGLISH, TIME_FORCE24HOURFORMAT,
  2617.       @SysTime, PChar('HH:mm:ss'), @buf, SizeOf(buf));
  2618.     Result := Copy(buf, 0, recv_bytes);
  2619.   end;
  2620.   function SDate: String;
  2621.   var
  2622.     buf: array[0..15] of Char;
  2623.     recv_bytes: Integer;
  2624.     SysTime: TSystemTime;
  2625.   begin
  2626.     GetSystemTime(SysTime);
  2627.     recv_bytes := GetDateFormat(LANG_ENGLISH, 0,
  2628.       @SysTime, 'dd MMM yyyy', @buf, SizeOf(buf));
  2629.     Result := Copy(buf, 0, recv_bytes);
  2630.   end;
  2631. begin
  2632.   Result := SDate + ' ' + STime + ' GMT';
  2633. end;
  2634.  
  2635. const
  2636.   client_check_data: PChar =
  2637.     'As part of this software beta version Mirabilis is ' +
  2638.     'granting a limited access to the ICQ network, ' +
  2639.     'servers, directories, listings, information and databases ("' +
  2640.     'ICQ Services and Information"). The ' +
  2641.     'ICQ Service and Information may databases ("' +
  2642.     'ICQ Services and Information"). The ' +
  2643.     'ICQ Service and Information may'#0;
  2644.  
  2645. {Decrypt peer packet.}
  2646. function DecryptPak(Pak: Pointer; Size: LongWord; Ver: Byte): Boolean;
  2647. var
  2648.   hex, key, B1, M1, check: LongWord;
  2649.   i: Word;
  2650.   X1, X2, X3: Byte;
  2651. begin
  2652.   if Ver > 6 then
  2653.   begin
  2654.     Pak := Ptr(LongWord(Pak) + 1);
  2655.     Dec(Size);
  2656.   end;
  2657.   { get checkcode }
  2658.   check := PLongWord(pak)^;
  2659.   { primary decryption }
  2660.   key := $67657268 * size + check;
  2661.   i := 4;
  2662.   while i < Integer((size + 3) shr 2) do
  2663.   begin
  2664.     hex := key + Ord(client_check_data[i and $FF]);
  2665.     PLongWord(LongWord(pak) + i)^ := PLongWord(LongWord(pak) + i)^ xor hex;
  2666.     Inc(i, 4);
  2667.   end;
  2668.   B1 := (PByte(LongWord(pak) + 4)^ shl 24) or (PByte(LongWord(pak) + 6)^ shl 16) or (PByte(LongWord(pak) + 4)^ shl 8) or (PByte(LongWord(pak) + 6)^ shl 0);
  2669.   { special decryption }
  2670.   B1 := B1 xor check;
  2671.   { validate packet }
  2672.   M1 := (B1 shr 24) and $FF;
  2673.   if (M1 < 10) or (M1 >= size) then
  2674.   begin
  2675.     Result := False;
  2676.     Exit;
  2677.   end;
  2678.   X1 := PByte(LongWord(pak) + M1)^ xor $FF;
  2679.   if (((B1 shr 16) and $FF) <> X1) then
  2680.   begin
  2681.     Result := False;
  2682.     Exit;
  2683.   end;
  2684.   X2 := ((B1 shr 8) and $FF);
  2685.   if (X2 < 220) then
  2686.   begin
  2687.     X3 := Ord(client_check_data[X2]) xor $FF;
  2688.     if (B1 and $FF) <> X3 then
  2689.     begin
  2690.       Result := False;
  2691.       Exit;
  2692.     end;
  2693.   end;
  2694.   Result := True;
  2695. end;
  2696.  
  2697. {Encrypt peer packet.}
  2698. procedure EncryptPak(Pak: Pointer; Size: LongWord; Ver: Byte);
  2699. var
  2700.   B1, M1, check, hex, key: LongWord;
  2701.   i: Word;
  2702.   X1, X2, X3, at: Byte;
  2703.   p: PByte;
  2704. begin
  2705.   p := Pak;
  2706.   size := Size;
  2707.  
  2708.   if (Ver > 6) then
  2709.   begin
  2710.     Inc(p);
  2711.     Dec(Size);
  2712.   end;
  2713.  
  2714.   { calculate verification data }
  2715.   if size < 255 then
  2716.     M1 := (Random(High(Word)) mod (Integer(size - 10))) + 10
  2717.   else
  2718.     M1 := (Random(High(Word)) mod 245) + 10;
  2719.   X1 := PByte(LongWord(p) + M1)^ xor $FF;
  2720.   X2 := Random(High(Word)) mod 220;
  2721.   X3 := Ord(client_check_data[X2]) xor $FF;
  2722.   B1 := (PByte(LongWord(p) + 4)^ shl 24) or (PByte(LongWord(p) + 6)^ shl 16) or
  2723.         (PByte(LongWord(p) + 4)^ shl 8) or (PByte(LongWord(p) + 6)^);
  2724.  
  2725.   { calculate checkcode }
  2726.   check := (M1 shl 24) or (X1 shl 16) or (X2 shl 8) or X3;
  2727.   check := check xor B1;
  2728.  
  2729.   { main XOR key }
  2730.   key := $67657268 * size + check;
  2731.  
  2732.   { XORing the actual data }
  2733.   i := 0;
  2734.   while i < ((size + 3) div 4) do
  2735.   begin
  2736.     hex := key + Ord(client_check_data[i and $FF]);
  2737.     PLongWord(LongWord(p) + i)^ := PLongWord(LongWord(p) + i)^ xor hex;
  2738.     Inc(i, 4);
  2739.   end;
  2740.  
  2741.   { storing the checkcode }
  2742.   if Ver > 6 then at := 1 else at := 0;
  2743.   PLongWord(LongWord(pak) + at)^ := check;
  2744. end;
  2745.  
  2746. {This packet is sent during direct connection initialization between two ICQ clients.
  2747. It is sent by the originator of the connection to start the handshake and by the
  2748. receiver directly after it has sent the PEER_ACK packet as a reply to the originator's
  2749. PEER_INIT.}
  2750. procedure CreatePEER_INIT(Pkt: PRawPkt; Cookie, DestUIN, SrcUIN, SrcPort, SrcIPExt, SrcIPInt: LongWord; ProxyType: TProxyType);
  2751. begin
  2752.   PktInitRaw(Pkt);
  2753.   PktInt(Pkt, $ff, 1);          //The command: connect.
  2754.   PktInt(Pkt, $0800, 2);        //The peer-to-peer version this packet uses.
  2755.   PktInt(Pkt, $2b00, 2);        //The length of the following data in bytes.
  2756.   PktLInt(Pkt, DestUIN, 4);     //The UIN this packet is sent to.
  2757.   PktInt(Pkt, $0000, 2);        //Unknown: empty.
  2758.   PktLInt(Pkt, SrcPort, 4);     //The port the sender listens on.
  2759.   PktLInt(Pkt, SrcUIN, 4);      //The UIN of the sender.
  2760.   PktLInt(Pkt, SrcIPExt, 4);    //The IP of the sender as the server sees it.
  2761.   PktLInt(Pkt, SrcIPInt, 4);    //The local IP of the sender.
  2762.   if ProxyType = P_NONE then
  2763.     PktInt(Pkt, $04, 1)         //TCP connection flags: dirrect connection
  2764.   else
  2765.     PktInt(Pkt, $02, 1);        //TCP connection flags: 02 - SOCKS4/5 proxy
  2766.   PktLInt(Pkt, SrcPort, 4);     //The sender's "other" port.
  2767.   PktInt(Pkt, Cookie, 4);       //The connection cookie the server gave for this pair of UINs
  2768.   PktInt(Pkt, $50000000, 4);    //Unknown: 0x50 = 80.
  2769.   PktInt(Pkt, $03000000, 4);    //Unknown: 0x3 = 3.
  2770.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2771. end;
  2772.  
  2773. {This is an additional packet in the peer-to-peer handshake. The purpose is still
  2774. unknown. It is sent by the originator of the connection after he has acknowledged
  2775. the peer's PEER_INIT and by the peer as a reply to the originator's PEER_INIT2.}
  2776. procedure CreatePEER_INIT2(Pkt: PRawPkt; Ack: Boolean);
  2777. begin
  2778.   PktInitRaw(Pkt);
  2779.   PktInt(Pkt, $03, 1);          //The command: the last connect package
  2780.   PktInt(Pkt, $0a000000, 4);    //Unknown: 0xa = 10.
  2781.   PktInt(Pkt, $01000000, 4);    //Unknown: 0x1 = 1.
  2782.   if Ack then                   //
  2783.     PktInt(Pkt, $01000000, 4)   //Unknown. Use 01 00 00 00 = 0x1 = 1 for incoming,
  2784.   else                          //
  2785.     PktInt(Pkt, $00000000, 4);  //0 for outgoing connections.
  2786.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2787.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2788.   if Ack then                   //
  2789.     PktInt(Pkt, $01000400, 4)   //Unknown. Use 01 00 04 00 = 0x40001 for incoming
  2790.   else                          //
  2791.     PktInt(Pkt, $00000000, 4);  //and 0 for outgoing connections.
  2792.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2793.   if Ack then                   //
  2794.     PktInt(Pkt, $00000000, 4)   //Unknown. Use 0 on incoming,
  2795.   else                          //
  2796.     PktInt(Pkt, $01000400, 4);  //but 01 00 04 00 = 0x4001 for outgoing connections.
  2797. end;
  2798.  
  2799. {Acknowledges the receipt of a PEER_INIT packet.}
  2800. procedure CreatePEER_ACK(Pkt: PRawPkt);
  2801. begin
  2802.   PktInitRaw(Pkt);
  2803.   PktInt(Pkt, $01000000, 4);    //The command: acknowlegde the PEER_INIT
  2804. end;
  2805.  
  2806. {Basic header of outgoing PEER packet.}
  2807. procedure CreatePEER_HDR(Pkt: PRawPkt; Cmd, SubCmd, Seq: Word);
  2808. begin
  2809.   PktInitRaw(Pkt);              //Init
  2810.   PktInt(Pkt, $02, 1);          //The command: send a message.
  2811.   PktInt(Pkt, $00000000, 4);    //The checksum of this packet.
  2812.   PktInt(Pkt, Cmd, 2);          //Message common type
  2813.   PktInt(Pkt, $0e00, 2);        //Unknown: 0xe = 14.
  2814.   PktLInt(Pkt, Seq, 2);         //Our sequence number.
  2815.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2816.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2817.   PktInt(Pkt, $00000000, 4);    //Unknown: empty.
  2818.   PktInt(Pkt, SubCmd, 2);       //The message type: message
  2819.   PktInt(Pkt, $0000, 2);        //Unknown: empty.
  2820. end;
  2821.  
  2822. {Send a message to peer.}
  2823. function CreatePEER_MSG(Pkt: PRawPkt; const Msg: String; RTFFormat: Boolean; var Seq: Word): Word;
  2824. const
  2825.   StrGuid: String = '{97B12751-243C-4334-AD22-D6ABF73F1492}';
  2826. begin
  2827.   CreatePEER_HDR(Pkt, $ee07, $0100, Seq);
  2828.   PktInt(Pkt, $0000, 2);        //Our status.
  2829.   PktLNTS(Pkt, Msg);            //Finally the message.
  2830.   PktInt(Pkt, $00000000, 4);    //The foreground the client is expected to use.
  2831.   PktInt(Pkt, $ffffff00, 4);    //The background color the client is expected to show the message with.
  2832.   if RTFFormat then
  2833.   begin
  2834.     PktLInt(Pkt, Length(StrGuid), 4);    //This is a little-endian string length of the following GUID. This is only present in real messages sent by the latest 2001b client build 3659.
  2835.     PktStr(Pkt, StrGuid);                //This GUID seems to indicate that the client is capable of handling Multibyte Wide Character Strings as messages. Only present in real messages sent by build 3659 2001b clients.}
  2836.   end;
  2837.   EncryptPak(Pkt, Pkt^.Len, 8); //Encrypt packet
  2838.   Result := Seq; Inc(Seq);      //Inc Seq
  2839. end;
  2840.  
  2841. {Ack}
  2842. procedure CreatePEER_MSGACK(Pkt: PRawPkt; Seq: Word);
  2843. begin
  2844.   CreatePEER_HDR(Pkt, $da07, $0100, Seq);
  2845.   PktInt(Pkt, $0000, 2);        //Our status
  2846.   PktInt(Pkt, $0100, 2);        //Msg len = 1, Value = 0
  2847.   PktInt(Pkt, $00, 1);          //Msg null terminator
  2848.   PktInt(Pkt, $00000000, 4);    //The foreground the client is expected to use.
  2849.   PktInt(Pkt, $ffffff00, 4);    //The background color the client is expected to show the message with.
  2850.   EncryptPak(Pkt, Pkt^.Len, 8); //Encrypt packet
  2851. end;
  2852.  
  2853. {Response on auto-away msg request.}
  2854. procedure CreatePEER_AUTOMSG_ACK(Pkt: PRawPkt; Answer: String; Status, Seq: Word);
  2855. begin
  2856.   CreatePEER_HDR(Pkt, $da07, Swap16(Status), Seq);
  2857.   PktInt(Pkt, $0000, 2);        //Our status
  2858.   PktLNTS(Pkt, Answer);
  2859.   EncryptPak(Pkt, Pkt^.Len, 8); //Encrypt packet
  2860. end;
  2861.  
  2862. const
  2863.   PEER_UNK: array[0..13] of Byte = ($7d, $46, $76, $76, $d4, $11, $bc, $e6,
  2864.                                     $00, $04, $ac, $96, $1e, $a6);
  2865.  
  2866. {Sends contacts to user.}
  2867. function CreatePEER_CONTACTS(Pkt: PRawPkt; Contacts: TStringList; var Seq: Word): Word;
  2868. const
  2869.   StrCmd: String = 'Contacts';
  2870. var
  2871.   S: String;
  2872.   i, count: Word;
  2873. begin
  2874.   CreatePEER_HDR(Pkt, $ee07, $1a00, Seq);
  2875.   PktInt(Pkt, $0000, 2);        //Our status.
  2876.   PktInt(Pkt, $0100, 2);        //Message
  2877.   PktInt(Pkt, $002d, 2);        //Following length
  2878.   PktInt(Pkt, $002a, 2);        //Following length
  2879.   PktInt(Pkt, $0e, 1);          //Unknown: 0x0e
  2880.   PktAddArrBuf(Pkt, @PEER_UNK, 14);     //14 unknown bytes
  2881.   PktInt(Pkt, $0000, 2);                //Possible command: send contacts
  2882.   PktLInt(Pkt, Length(StrCmd), 4);      //Length of the text command
  2883.   PktStr(Pkt, StrCmd);                  //Text command
  2884.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2885.   PktInt(Pkt, $0001, 2);        //Unknown: 0x01
  2886.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2887.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2888.   PktInt(Pkt, $00, 1);          //Unknown: empty
  2889.   count := 0;
  2890.   S := '';
  2891.   if Contacts.Count > 0 then
  2892.     for i := 0 to Contacts.Count - 1 do
  2893.     begin
  2894.       if ExtractName(Contacts.Strings[i]) <> '' then
  2895.       begin
  2896.         S := S + ExtractName(Contacts.Strings[i]) + #$fe;
  2897.         if ExtractValue(Contacts.Strings[i]) = '' then
  2898.           S := S + ExtractName(Contacts.Strings[i]) + #$fe
  2899.         else
  2900.           S := S + ExtractValue(Contacts.Strings[i]) + #$fe;
  2901.         Inc(count);
  2902.       end;
  2903.     end;
  2904.   S := IntToStr(count) + #$fe + S;
  2905.   PktLInt(Pkt, Length(S) + 4, 4);       //Length of the following data
  2906.   PktLInt(Pkt, Length(S), 4);   //Length of the following string
  2907.   PktStr(Pkt, S);               //Following string
  2908.   EncryptPak(Pkt, Pkt^.Len, 8); //Encrypt packet
  2909.   Result := Seq; Inc(Seq);      //Inc Seq
  2910. end;
  2911.  
  2912. function CreatePEER_CONTACTREQ(Pkt: PRawPkt; const Reason: String; var Seq: Word): Word;
  2913. const
  2914.   StrCmd: String = 'Request For Contacts';
  2915. begin
  2916.   CreatePEER_HDR(Pkt, $ee07, $1a00, Seq);
  2917.   PktInt(Pkt, $0000, 2);        //Our status.
  2918.   PktInt(Pkt, $0100, 2);        //Message
  2919.   PktInt(Pkt, $0039, 2);        //Following length
  2920.   PktInt(Pkt, $002a, 2);        //Following length
  2921.   PktInt(Pkt, $0e, 1);          //Unknown: 0x0e
  2922.   PktAddArrBuf(Pkt, @PEER_UNK, 14);   //16 unknown bytes
  2923.   PktInt(Pkt, $0200, 2);        //Possible command requesting contacts
  2924.   PktLInt(Pkt, Length(StrCmd), 4);    //Length of the text command
  2925.   PktStr(Pkt, StrCmd);          //Text command
  2926.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2927.   PktInt(Pkt, $0001, 2);        //Unknown: 0x01
  2928.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2929.   PktInt(Pkt, $00000000, 4);    //Unknown: empty
  2930.   PktInt(Pkt, $00, 1);          //Unknown: empty
  2931.   PktLInt(Pkt, Length(Reason) + 4, 4);  //Length of the following data
  2932.   PktLInt(Pkt, Length(Reason), 4);      //Length of the following string
  2933.   PktStr(Pkt, Reason);          //Following string
  2934.   EncryptPak(Pkt, Pkt^.Len, 8); //Encrypt packet
  2935.   Result := Seq; Inc(Seq);      //Inc Seq
  2936. end;
  2937.  
  2938.  
  2939. {Xorkeygen tabs}
  2940. const
  2941.   TAB0: array[0..63] of LongWord =
  2942.     ($00820200, $00020000, $80800000, $80820200,
  2943.      $00800000, $80020200, $80020000, $80800000,
  2944.      $80020200, $00820200, $00820000, $80000200,
  2945.      $80800200, $00800000, $00000000, $80020000,
  2946.      $00020000, $80000000, $00800200, $00020200,
  2947.      $80820200, $00820000, $80000200, $00800200,
  2948.      $80000000, $00000200, $00020200, $80820000,
  2949.      $00000200, $80800200, $80820000, $00000000,
  2950.      $00000000, $80820200, $00800200, $80020000,
  2951.      $00820200, $00020000, $80000200, $00800200,
  2952.      $80820000, $00000200, $00020200, $80800000,
  2953.      $80020200, $80000000, $80800000, $00820000,
  2954.      $80820200, $00020200, $00820000, $80800200,
  2955.      $00800000, $80000200, $80020000, $00000000,
  2956.      $00020000, $00800000, $80800200, $00820200,
  2957.      $80000000, $80820000, $00000200, $80020200);
  2958.  
  2959.   TAB1: array[0..63] of LongWord =
  2960.     ($10042004, $00000000, $00042000, $10040000,
  2961.      $10000004, $00002004, $10002000, $00042000,
  2962.      $00002000, $10040004, $00000004, $10002000,
  2963.      $00040004, $10042000, $10040000, $00000004,
  2964.      $00040000, $10002004, $10040004, $00002000,
  2965.      $00042004, $10000000, $00000000, $00040004,
  2966.      $10002004, $00042004, $10042000, $10000004,
  2967.      $10000000, $00040000, $00002004, $10042004,
  2968.      $00040004, $10042000, $10002000, $00042004,
  2969.      $10042004, $00040004, $10000004, $00000000,
  2970.      $10000000, $00002004, $00040000, $10040004,
  2971.      $00002000, $10000000, $00042004, $10002004,
  2972.      $10042000, $00002000, $00000000, $10000004,
  2973.      $00000004, $10042004, $00042000, $10040000,
  2974.      $10040004, $00040000, $00002004, $10002000,
  2975.      $10002004, $00000004, $10040000, $00042000);
  2976.  
  2977.   TAB2: array[0..63] of LongWord =
  2978.     ($41000000, $01010040, $00000040, $41000040,
  2979.      $40010000, $01000000, $41000040, $00010040,
  2980.      $01000040, $00010000, $01010000, $40000000,
  2981.      $41010040, $40000040, $40000000, $41010000,
  2982.      $00000000, $40010000, $01010040, $00000040,
  2983.      $40000040, $41010040, $00010000, $41000000,
  2984.      $41010000, $01000040, $40010040, $01010000,
  2985.      $00010040, $00000000, $01000000, $40010040,
  2986.      $01010040, $00000040, $40000000, $00010000,
  2987.      $40000040, $40010000, $01010000, $41000040,
  2988.      $00000000, $01010040, $00010040, $41010000,
  2989.      $40010000, $01000000, $41010040, $40000000,
  2990.      $40010040, $41000000, $01000000, $41010040,
  2991.      $00010000, $01000040, $41000040, $00010040,
  2992.      $01000040, $00000000, $41010000, $40000040,
  2993.      $41000000, $40010040, $00000040, $01010000);
  2994.  
  2995.   TAB3: array[0..63] of LongWord =
  2996.     ($00100402, $04000400, $00000002, $04100402,
  2997.      $00000000, $04100000, $04000402, $00100002,
  2998.      $04100400, $04000002, $04000000, $00000402,
  2999.      $04000002, $00100402, $00100000, $04000000,
  3000.      $04100002, $00100400, $00000400, $00000002,
  3001.      $00100400, $04000402, $04100000, $00000400,
  3002.      $00000402, $00000000, $00100002, $04100400,
  3003.      $04000400, $04100002, $04100402, $00100000,
  3004.      $04100002, $00000402, $00100000, $04000002,
  3005.      $00100400, $04000400, $00000002, $04100000,
  3006.      $04000402, $00000000, $00000400, $00100002,
  3007.      $00000000, $04100002, $04100400, $00000400,
  3008.      $04000000, $04100402, $00100402, $00100000,
  3009.      $04100402, $00000002, $04000400, $00100402,
  3010.      $00100002, $00100400, $04100000, $04000402,
  3011.      $00000402, $04000000, $04000002, $04100400);
  3012.  
  3013.   TAB4: array[0..63] of LongWord =
  3014.     ($02000000, $00004000, $00000100, $02004108,
  3015.      $02004008, $02000100, $00004108, $02004000,
  3016.      $00004000, $00000008, $02000008, $00004100,
  3017.      $02000108, $02004008, $02004100, $00000000,
  3018.      $00004100, $02000000, $00004008, $00000108,
  3019.      $02000100, $00004108, $00000000, $02000008,
  3020.      $00000008, $02000108, $02004108, $00004008,
  3021.      $02004000, $00000100, $00000108, $02004100,
  3022.      $02004100, $02000108, $00004008, $02004000,
  3023.      $00004000, $00000008, $02000008, $02000100,
  3024.      $02000000, $00004100, $02004108, $00000000,
  3025.      $00004108, $02000000, $00000100, $00004008,
  3026.      $02000108, $00000100, $00000000, $02004108,
  3027.      $02004008, $02004100, $00000108, $00004000,
  3028.      $00004100, $02004008, $02000100, $00000108,
  3029.      $00000008, $00004108, $02004000, $02000008);
  3030.  
  3031.   TAB5: array[0..63] of LongWord =
  3032.     ($20000010, $00080010, $00000000, $20080800,
  3033.      $00080010, $00000800, $20000810, $00080000,
  3034.      $00000810, $20080810, $00080800, $20000000,
  3035.      $20000800, $20000010, $20080000, $00080810,
  3036.      $00080000, $20000810, $20080010, $00000000,
  3037.      $00000800, $00000010, $20080800, $20080010,
  3038.      $20080810, $20080000, $20000000, $00000810,
  3039.      $00000010, $00080800, $00080810, $20000800,
  3040.      $00000810, $20000000, $20000800, $00080810,
  3041.      $20080800, $00080010, $00000000, $20000800,
  3042.      $20000000, $00000800, $20080010, $00080000,
  3043.      $00080010, $20080810, $00080800, $00000010,
  3044.      $20080810, $00080800, $00080000, $20000810,
  3045.      $20000010, $20080000, $00080810, $00000000,
  3046.      $00000800, $20000010, $20000810, $20080800,
  3047.      $20080000, $00000810, $00000010, $20080010);
  3048.  
  3049.   TAB6: array[0..63] of LongWord =
  3050.     ($00001000, $00000080, $00400080, $00400001,
  3051.      $00401081, $00001001, $00001080, $00000000,
  3052.      $00400000, $00400081, $00000081, $00401000,
  3053.      $00000001, $00401080, $00401000, $00000081,
  3054.      $00400081, $00001000, $00001001, $00401081,
  3055.      $00000000, $00400080, $00400001, $00001080,
  3056.      $00401001, $00001081, $00401080, $00000001,
  3057.      $00001081, $00401001, $00000080, $00400000,
  3058.      $00001081, $00401000, $00401001, $00000081,
  3059.      $00001000, $00000080, $00400000, $00401001,
  3060.      $00400081, $00001081, $00001080, $00000000,
  3061.      $00000080, $00400001, $00000001, $00400080,
  3062.      $00000000, $00400081, $00400080, $00001080,
  3063.      $00000081, $00001000, $00401081, $00400000,
  3064.      $00401080, $00000001, $00001001, $00401081,
  3065.      $00400001, $00401080, $00401000, $00001001);
  3066.  
  3067.   TAB7: array[0..63] of LongWord =
  3068.     ($08200020, $08208000, $00008020, $00000000,
  3069.      $08008000, $00200020, $08200000, $08208020,
  3070.      $00000020, $08000000, $00208000, $00008020,
  3071.      $00208020, $08008020, $08000020, $08200000,
  3072.      $00008000, $00208020, $00200020, $08008000,
  3073.      $08208020, $08000020, $00000000, $00208000,
  3074.      $08000000, $00200000, $08008020, $08200020,
  3075.      $00200000, $00008000, $08208000, $00000020,
  3076.      $00200000, $00008000, $08000020, $08208020,
  3077.      $00008020, $08000000, $00000000, $00208000,
  3078.      $08200020, $08008020, $08008000, $00200020,
  3079.      $08208000, $00000020, $00200020, $08008000,
  3080.      $08208020, $00200000, $08200000, $08000020,
  3081.      $00208000, $00008020, $08008020, $08200000,
  3082.      $00000020, $08208000, $00208020, $00000000,
  3083.      $08000000, $08200020, $00008000, $00208020);
  3084.  
  3085.   TAB8: array[0..63] of LongWord =
  3086.     ($00000000, $00000010, $20000000, $20000010,
  3087.      $00010000, $00010010, $20010000, $20010010,
  3088.      $00000800, $00000810, $20000800, $20000810,
  3089.      $00010800, $00010810, $20010800, $20010810,
  3090.      $00000020, $00000030, $20000020, $20000030,
  3091.      $00010020, $00010030, $20010020, $20010030,
  3092.      $00000820, $00000830, $20000820, $20000830,
  3093.      $00010820, $00010830, $20010820, $20010830,
  3094.      $00080000, $00080010, $20080000, $20080010,
  3095.      $00090000, $00090010, $20090000, $20090010,
  3096.      $00080800, $00080810, $20080800, $20080810,
  3097.      $00090800, $00090810, $20090800, $20090810,
  3098.      $00080020, $00080030, $20080020, $20080030,
  3099.      $00090020, $00090030, $20090020, $20090030,
  3100.      $00080820, $00080830, $20080820, $20080830,
  3101.      $00090820, $00090830, $20090820, $20090830);
  3102.  
  3103.   TAB9: array[0..63] of LongWord =
  3104.     ($00000000, $02000000, $00002000, $02002000,
  3105.      $00200000, $02200000, $00202000, $02202000,
  3106.      $00000004, $02000004, $00002004, $02002004,
  3107.      $00200004, $02200004, $00202004, $02202004,
  3108.      $00000400, $02000400, $00002400, $02002400,
  3109.      $00200400, $02200400, $00202400, $02202400,
  3110.      $00000404, $02000404, $00002404, $02002404,
  3111.      $00200404, $02200404, $00202404, $02202404,
  3112.      $10000000, $12000000, $10002000, $12002000,
  3113.      $10200000, $12200000, $10202000, $12202000,
  3114.      $10000004, $12000004, $10002004, $12002004,
  3115.      $10200004, $12200004, $10202004, $12202004,
  3116.      $10000400, $12000400, $10002400, $12002400,
  3117.      $10200400, $12200400, $10202400, $12202400,
  3118.      $10000404, $12000404, $10002404, $12002404,
  3119.      $10200404, $12200404, $10202404, $12202404);
  3120.  
  3121.   TABA: array[0..63] of LongWord =
  3122.     ($00000000, $00000001, $00040000, $00040001,
  3123.      $01000000, $01000001, $01040000, $01040001,
  3124.      $00000002, $00000003, $00040002, $00040003,
  3125.      $01000002, $01000003, $01040002, $01040003,
  3126.      $00000200, $00000201, $00040200, $00040201,
  3127.      $01000200, $01000201, $01040200, $01040201,
  3128.      $00000202, $00000203, $00040202, $00040203,
  3129.      $01000202, $01000203, $01040202, $01040203,
  3130.      $08000000, $08000001, $08040000, $08040001,
  3131.      $09000000, $09000001, $09040000, $09040001,
  3132.      $08000002, $08000003, $08040002, $08040003,
  3133.      $09000002, $09000003, $09040002, $09040003,
  3134.      $08000200, $08000201, $08040200, $08040201,
  3135.      $09000200, $09000201, $09040200, $09040201,
  3136.      $08000202, $08000203, $08040202, $08040203,
  3137.      $09000202, $09000203, $09040202, $09040203);
  3138.  
  3139.   TABB: array[0..63] of LongWord =
  3140.     ($00000000, $00100000, $00000100, $00100100,
  3141.      $00000008, $00100008, $00000108, $00100108,
  3142.      $00001000, $00101000, $00001100, $00101100,
  3143.      $00001008, $00101008, $00001108, $00101108,
  3144.      $04000000, $04100000, $04000100, $04100100,
  3145.      $04000008, $04100008, $04000108, $04100108,
  3146.      $04001000, $04101000, $04001100, $04101100,
  3147.      $04001008, $04101008, $04001108, $04101108,
  3148.      $00020000, $00120000, $00020100, $00120100,
  3149.      $00020008, $00120008, $00020108, $00120108,
  3150.      $00021000, $00121000, $00021100, $00121100,
  3151.      $00021008, $00121008, $00021108, $00121108,
  3152.      $04020000, $04120000, $04020100, $04120100,
  3153.      $04020008, $04120008, $04020108, $04120108,
  3154.      $04021000, $04121000, $04021100, $04121100,
  3155.      $04021008, $04121008, $04021108, $04121108);
  3156.  
  3157.   TABC: array[0..63] of LongWord =
  3158.     ($00000000, $10000000, $00010000, $10010000,
  3159.      $00000004, $10000004, $00010004, $10010004,
  3160.      $20000000, $30000000, $20010000, $30010000,
  3161.      $20000004, $30000004, $20010004, $30010004,
  3162.      $00100000, $10100000, $00110000, $10110000,
  3163.      $00100004, $10100004, $00110004, $10110004,
  3164.      $20100000, $30100000, $20110000, $30110000,
  3165.      $20100004, $30100004, $20110004, $30110004,
  3166.      $00001000, $10001000, $00011000, $10011000,
  3167.      $00001004, $10001004, $00011004, $10011004,
  3168.      $20001000, $30001000, $20011000, $30011000,
  3169.      $20001004, $30001004, $20011004, $30011004,
  3170.      $00101000, $10101000, $00111000, $10111000,
  3171.      $00101004, $10101004, $00111004, $10111004,
  3172.      $20101000, $30101000, $20111000, $30111000,
  3173.      $20101004, $30101004, $20111004, $30111004);
  3174.  
  3175.   TABD: array[0..63] of LongWord =
  3176.     ($00000000, $08000000, $00000008, $08000008,
  3177.      $00000400, $08000400, $00000408, $08000408,
  3178.      $00020000, $08020000, $00020008, $08020008,
  3179.      $00020400, $08020400, $00020408, $08020408,
  3180.      $00000001, $08000001, $00000009, $08000009,
  3181.      $00000401, $08000401, $00000409, $08000409,
  3182.      $00020001, $08020001, $00020009, $08020009,
  3183.      $00020401, $08020401, $00020409, $08020409,
  3184.      $02000000, $0A000000, $02000008, $0A000008,
  3185.      $02000400, $0A000400, $02000408, $0A000408,
  3186.      $02020000, $0A020000, $02020008, $0A020008,
  3187.      $02020400, $0A020400, $02020408, $0A020408,
  3188.      $02000001, $0A000001, $02000009, $0A000009,
  3189.      $02000401, $0A000401, $02000409, $0A000409,
  3190.      $02020001, $0A020001, $02020009, $0A020009,
  3191.      $02020401, $0A020401, $02020409, $0A020409);
  3192.  
  3193.   TABE: array[0..63] of LongWord =
  3194.     ($00000000, $00000100, $00080000, $00080100,
  3195.      $01000000, $01000100, $01080000, $01080100,
  3196.      $00000010, $00000110, $00080010, $00080110,
  3197.      $01000010, $01000110, $01080010, $01080110,
  3198.      $00200000, $00200100, $00280000, $00280100,
  3199.      $01200000, $01200100, $01280000, $01280100,
  3200.      $00200010, $00200110, $00280010, $00280110,
  3201.      $01200010, $01200110, $01280010, $01280110,
  3202.      $00000200, $00000300, $00080200, $00080300,
  3203.      $01000200, $01000300, $01080200, $01080300,
  3204.      $00000210, $00000310, $00080210, $00080310,
  3205.      $01000210, $01000310, $01080210, $01080310,
  3206.      $00200200, $00200300, $00280200, $00280300,
  3207.      $01200200, $01200300, $01280200, $01280300,
  3208.      $00200210, $00200310, $00280210, $00280310,
  3209.      $01200210, $01200310, $01280210, $01280310);
  3210.  
  3211.   TABF: array[0..63] of LongWord =
  3212.     ($00000000, $04000000, $00040000, $04040000,
  3213.      $00000002, $04000002, $00040002, $04040002,
  3214.      $00002000, $04002000, $00042000, $04042000,
  3215.      $00002002, $04002002, $00042002, $04042002,
  3216.      $00000020, $04000020, $00040020, $04040020,
  3217.      $00000022, $04000022, $00040022, $04040022,
  3218.      $00002020, $04002020, $00042020, $04042020,
  3219.      $00002022, $04002022, $00042022, $04042022,
  3220.      $00000800, $04000800, $00040800, $04040800,
  3221.      $00000802, $04000802, $00040802, $04040802,
  3222.      $00002800, $04002800, $00042800, $04042800,
  3223.      $00002802, $04002802, $00042802, $04042802,
  3224.      $00000820, $04000820, $00040820, $04040820,
  3225.      $00000822, $04000822, $00040822, $04040822,
  3226.      $00002820, $04002820, $00042820, $04042820,
  3227.      $00002822, $04002822, $00042822, $04042822);
  3228.  
  3229.   TABQ: array[0..15] of boolean =
  3230.     (FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
  3231.      FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE);
  3232.  
  3233.  
  3234. type
  3235.   RTTabArray = array[0..31] of LongInt;
  3236.  
  3237. procedure TableGen(var t: RTTabArray; UIN: LongInt);
  3238. var u:     array[0..7] of Byte;
  3239.     ul:    array[0..1] of LongWord absolute u;
  3240.     v:     Byte;
  3241.     x:     Byte;
  3242.     l,h:   LongWord;
  3243.     a,b,c: LongWord;
  3244. begin
  3245.      {---- create UIN "hash" ----}
  3246.      v := ((UIN+9) shr 6) and 1;
  3247.      u[0] := ( ((trunc(sqrt(UIN*3+2)) and 1) or
  3248.                (((UIN shr 17) and 1) shl 1))  shl 2 ) or v;
  3249.      u[1] := ( (((trunc(sin(UIN)) shr 14) and 1) or
  3250.                 (((UIN shr 12) and 1) shl 1))  shl 2 ) or v;
  3251.      u[4] := ( (( (((UIN shr 7) and 1) or
  3252.                    (((UIN shr 12) and 1) shl 1))  shl 1 ) or
  3253.                 ((UIN shr 12) and 1))  shl 1 ) or
  3254.              ((UIN shr (UIN and 1)) and 1);
  3255.      u[6] := ( (( (((trunc(cos(UIN)) shr 8) and 1) or
  3256.                   (((UIN shr 5) and 1) shl 1))  shl 1 ) or
  3257.                 ((UIN shr 19) and 1))  shl 1 ) or
  3258.              ((UIN shr 18) and 1);
  3259.      u[3] := (( ((((UIN shr 9) and 1) shl 1) or
  3260.                  ((UIN shr 6) and 1))  shl 1 ) or
  3261.               (((UIN*5) shr 11) and 1))  shl 1;
  3262.      u[5] := ( (((trunc(sin(UIN)/cos(UIN){=tan(UIN)}) shr 4) and 1) or
  3263.                 (((UIN shr 11) and 1) shl 1))  shl 2 ) or
  3264.              ((UIN shr 2) and 1);
  3265.      u[2] := ( (((trunc(sqrt(UIN*3+2)) shr 13) and 1) or
  3266.                 (((UIN shr 10) and 1) shl 1))  shl 2 ) or v;
  3267.      u[7] := 0;
  3268.  
  3269.      {---- generate run-time encryption table ----}
  3270.      l := ul[0];
  3271.      h := ul[1];
  3272.  
  3273.      a := (l and $0F0F0F0F) xor ((h shr 4) and $0F0F0F0F);
  3274.      l := l xor a;
  3275.      h := h xor (a shl 4);
  3276.  
  3277.      a := (l and $CCCC0000) xor ((l and $FFFFF333) shl 18);
  3278.      l := l xor (a xor (a shr 18));
  3279.      a := (h and $CCCC0000) xor ((h and $FFFFF333) shl 18);
  3280.      h := h xor (a xor (a shr 18));
  3281.  
  3282.      a := (l and $55555555) xor ((h shr 1) and $55555555);
  3283.      l := l xor a;
  3284.      h := h xor (a shl 1);
  3285.  
  3286.      a := (h and $00FF00FF) xor ((l shr 8) and $00FF00FF);
  3287.      l := l xor (a shl 8);
  3288.      h := h xor a;
  3289.  
  3290.      a := (l and $55555555) xor ((h shr 1) and $55555555);
  3291.      l := l xor a;
  3292.      h := h xor (a shl 1);
  3293.  
  3294.      a := l and $0FFFFFFF;
  3295.      b := ( ((l and $F000000F) or ((h shr 12) and $00000FF0))  shr 4 ) or
  3296.           (h and $0000FF00) or ((h and $FF) shl 16);
  3297.  
  3298.      for x := 0 to 15 do
  3299.      begin
  3300.           if TABQ[x] then
  3301.           begin
  3302.                a := ((a and $3F) shl 26) or (a shr 2);
  3303.                b := ((b and $3F) shl 26) or (b shr 2);
  3304.           end
  3305.           else begin
  3306.                     a := ((a and $1F) shl 27) or (a shr 1);
  3307.                     b := ((b and $1F) shl 27) or (b shr 1);
  3308.                end;
  3309.  
  3310.           a := a and $0FFFFFFF;
  3311.           b := b and $0FFFFFFF;
  3312.  
  3313.           l := TABB[(( ((a and $00C00000) or
  3314.                        ((a shr 1) and $07000000))  shr 1 ) or
  3315.                      (a and $00100000))  shr 20] or
  3316.                TABA[((a and $0001E000) or
  3317.                      ((a shr 1) and $00060000))  shr 13] or
  3318.                TAB9[((a and $C0) or (l shr 1))  shr 6] or
  3319.                TAB8[a and 63];
  3320.  
  3321.           h := TABD[((b and $00000180) or
  3322.                      ((b shr 1) and $00001E00))  shr 7] or
  3323.                TABF[((b and $01E00000) or
  3324.                      ((b shr 1) and $06000000))  shr 21] or
  3325.                TABE[(b shr 15) and 63] or
  3326.                TABC[b and 63];
  3327.  
  3328.           c := (h and $FFFF0000) or (l shr 16);
  3329.           t[x*2+0] := (l and $0000FFFF) or (h shl 16);
  3330.           t[x*2+1] := (c shl 4) or (c shr 28);          { = ROL(c,4)}
  3331.      end;
  3332. end;
  3333.  
  3334. procedure XORKeyGen(var t: RTTabArray; var KeyLow, KeyHigh: LongInt);
  3335. var l, h,
  3336.     a, b: LongInt;
  3337.     x: Byte;
  3338. begin
  3339.   l := KeyLow;
  3340.   h := KeyHigh;
  3341.  
  3342.   a := (l and $0F0F0F0F) xor ((h shr 4) and $0F0F0F0F);
  3343.   l := l xor a;
  3344.   h := h xor (a shl 4);
  3345.  
  3346.   a := (h and $0000FFFF) xor (l shr 16);
  3347.   l := l xor (a shl 16);
  3348.   h := h xor a;
  3349.  
  3350.   a := (l and $33333333) xor ((h shr 2) and $33333333);
  3351.   l := l xor a;
  3352.   h := h xor (a shl 2);
  3353.  
  3354.   a := (h and $00FF00FF) xor ((l shr 8) and $00FF00FF);
  3355.   l := l xor (a shl 8);
  3356.   h := h xor a;
  3357.  
  3358.   a := (l and $55555555) xor ((h shr 1) and $55555555);
  3359.   l := l xor a;
  3360.   h := h xor (a shl 1);
  3361.  
  3362.   l := (l shl 1) or (l shr 31);                      {l = ROL(l,1)}
  3363.   h := (h shl 1) or (h shr 31);                      {h = ROL(h,1)}
  3364.  
  3365.   for x := 0 to 7 do
  3366.   begin
  3367.     a := t[x*4+0] xor l;
  3368.     b := t[x*4+1] xor l;
  3369.     b := (b shr 4) or (b shl 28);                 {b = ROR(b,4)}
  3370.     h := (h xor LongInt((TAB2[(a shr  8) and 63] or
  3371.     TAB3[(b shr  8) and 63] or
  3372.     TAB4[(a shr 16) and 63] or
  3373.     TAB5[(b shr 16) and 63] or
  3374.     TAB6[(a shr 24) and 63] or
  3375.     TAB7[(b shr 24) and 63] or
  3376.     TAB1[ b         and 63] or
  3377.     TAB0[ a         and 63])));
  3378.  
  3379.     a := t[x*4+2] xor h;
  3380.     b := t[x*4+3] xor h;
  3381.     b := (b shr 4) or (b shl 28);                 {b = ROR(b,4)}
  3382.     l := l xor LongInt((TAB2[(a shr  8) and 63] or
  3383.       TAB3[(b shr  8) and 63] or
  3384.       TAB4[(a shr 16) and 63] or
  3385.       TAB5[(b shr 16) and 63] or
  3386.       TAB6[(a shr 24) and 63] or
  3387.       TAB7[(b shr 24) and 63] or
  3388.       TAB1[ b         and 63] or
  3389.       TAB0[ a         and 63]));
  3390.   end;
  3391.  
  3392.   h := (h shr 1) or (h shl 31);                      {h = ROR(h,1)}
  3393.   l := (l shr 1) or (l shl 31);                      {l = ROR(l,1)}
  3394.   a := (h and $55555555) xor ((l shr 1) and $55555555);
  3395.   h := h xor a;
  3396.   l := l xor (a shl 1);
  3397.   a := (l and $00FF00FF) xor ((h shr 8) and $00FF00FF);
  3398.   h := h xor (a shl 8);
  3399.   l := l xor a;
  3400.   a := (h and $33333333) xor ((l shr 2) and $33333333);
  3401.   h := h xor a;
  3402.   l := l xor (a shl 2);
  3403.   a := (l and $0000FFFF) xor (h shr 16);
  3404.   l := l xor a;
  3405.   h := h xor (a shl 16);
  3406.   a := (h and $0F0F0F0F) xor ((l shr 4) and $0F0F0F0F);
  3407.   KeyLow  := h xor a;
  3408.   KeyHigh := l xor (a shl 4);
  3409. end;
  3410.  
  3411. {Xorkeygen by CoverD}
  3412. procedure GetXorKey(FUIN: LongWord; FCryptIV: LongWord; var XorKey: array of Byte);
  3413. var
  3414.   UIN:      LongInt;
  3415.   CryptIV:  LongInt;
  3416.   RTTab:    RTTabArray;
  3417.   l:        LongInt;
  3418.   h:        LongInt;
  3419.   key:      array[0..15] of Byte;
  3420.   keyl:     array[0..3] of LongInt absolute key;
  3421.   x:        byte;
  3422. begin
  3423.   UIN      := FUIN;
  3424.   CryptIV  := FCryptIV;
  3425.  
  3426.   TableGen(RTTab, UIN);      {create UIN-based run-time encryption table}
  3427.  
  3428.   l := CryptIV;
  3429.   h := 0;
  3430.   XORKeyGen(RTTab, l,h);     {generate first 8 bytes of XOR key}
  3431.   keyl[0] := l;
  3432.   keyl[1] := h;
  3433.   XORKeyGen(RTTab, l,h);     {generate next 8 bytes (first 3 are used)}
  3434.   keyl[2] := l;
  3435.   keyl[3] := h;
  3436.  
  3437.   for x := 0 to 10 do
  3438.     XorKey[x] := key[x];
  3439. end;
  3440.  
  3441. function Decrypt99bPassword(UIN, CryptIV: LongWord; const HexPass: String): String;
  3442. var
  3443.   XorKey,
  3444.   FBytePassw: array[0..15] of Byte;
  3445.   i, n: Word;
  3446. begin
  3447.   Result := '';
  3448.   if (UIN = 0) or (CryptIV = 0) or (Length(HexPass) = 0) then Exit;
  3449.   GetXorKey(UIN, CryptIV, XorKey);
  3450.   i := 0;
  3451.   for n := 1 to Length(HexPass) do
  3452.     if n mod 2 = 0 then
  3453.     begin
  3454.       FBytePassw[i] := HexToInt(Copy(HexPass, n - 1, 2));
  3455.       Inc(i);
  3456.     end;
  3457.   {First 2-bytes -- Length}
  3458.   for n := 2 to i - 2 do
  3459.     Result := Result + Chr(FBytePassw[n] xor XorKey[n]);
  3460. end;
  3461.  
  3462. function DecryptMirandaPassword(const Value: String): String;
  3463. var
  3464.   i: Word;
  3465. begin
  3466.   Result := '';
  3467.   if Length(Value) < 1 then Exit;
  3468.   for i := 1 to Length(Value) do
  3469.   begin
  3470.     Result := Result + Chr(Ord(Value[i]) - 5);
  3471.   end;
  3472. end;
  3473.  
  3474.  
  3475. end.
  3476.