download ICQv9.pas Language: Delphi License: GPL Copyright: (C) 2002-2004 Massimo Melina (www.rejetto.com) LOC: 3419 Project Info R&Q(rnq) Server: Spider_20090529_inc Type: filesystem

...n.RnQ.20070719.rar\RnQ.005\    aboutDlg.pas    addContactDlg.pas    antispam_fr.pas    authreqDlg.pas    autoaway_fr.pas    automsgDlg.pas    BalloonsLib.pas    changepwddlg.pas    chat_fr.pas    chatDlg.pas    connection_fr.pas    contacts.pas    converthistoriesDlg.pas    design_fr.pas    disable_fr.pas    events.pas    events_fr.pas    filetransferDlg.pas    globalLib.pas    groupsLib.pas    hashlib.pas    history.pas    historyVCL.pas    hook.pas    hotkeys_fr.pas    icq_fr.pas    ICQConsts.pas    ICQv9.pas    ignore_fr.pas    importDlg.pas    importnotesDlg.pas    iniLib.pas    langLib.pas    lazpng.pas    lockDlg.pas    log_fr.pas    mainDlg.pas    menusUnit.pas    newaccountDlg.pas    other_fr.pas    outboxDlg.pas    outboxLib.pas    pluginLib.pas    plugins_fr.pas    prefDlg.pas    pwdDlg.pas    removeDlg.pas    RnQ_Avatars.pas    RnQdbDlg.pas    RnQProtocol.pas    roasterLib.pas    RQ_ICQ.pas    RQCodes.pas    RusClipboard.pas    security_fr.pas    selectcontactsDlg.pas    sendfileDlg.pas    smsDlg.pas    snippets.pas    start_fr.pas    tcpclient.pas    themedit_fr.pas    themes_fr.pas    ThemesLib.pas    tipDlg.pas    traylib.pas    uinlistlib.pas    update_fr.pas    usersDlg.pas    uSimplePlayer.pas    utilLib.pas    viewinfoDlg.pas    visibilityDlg.pas    wpDlg.pas { Copyright (C) 2002-2004 Massimo Melina (www.rejetto.com) This file is part of &RQ. &RQ is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. &RQ is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with &RQ; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA } unit ICQv9; {$MODE Delphi} {$include Compilers.inc} {$I RnQConfig.inc} {$DEFINE usesVCL} { $DEFINE usesDC} interface uses LCLProc, sysutils, classes, LCLIntf, extctrls, flap, contacts, strutils, tcpclient, {$IFDEF usesVCL} // Forms,// Dialogs, {$ENDIF} {$IFDEF RNQ_AVATARS} LazJpg, {$ENDIF RNQ_AVATARS} dateUtils, IcsMD5, ICQConsts; type TicqError=( EC_rateExceeded, EC_cantConnect, EC_socket, EC_other, EC_badUIN, // at login-time, referred to my own uin EC_missingLogin, EC_anotherLogin, EC_serverDisconnected, EC_badPwd, EC_cantChangePwd, EC_loginDelay, EC_cantCreateUIN, EC_invalidFlap, EC_badContact, EC_cantConnect_dc, EC_proxy_error, EC_proxy_badPwd, EC_proxy_unk // unknown reply ); TwpResult=record uin:integer; nick,first,last,email:string; authRequired:boolean; // status:byte; // 0=offline 1=online 2=don't know status:word; // 0=offline 1=online 2=don't know gender : byte; age : word; end; // TwpResult TwpSearch=record uin:integer; nick,first,last,email,city,state, keyword:string; gender, lang:byte; country:word; age:integer; onlineOnly:boolean; wInterest : Word; end; // TwpSearch TmsgID = int64; TicqEvent=( IE_error, IE_online, IE_offline, IE_oncoming, IE_offgoing, IE_userinfo, IE_msg, IE_email, IE_webpager, IE_fromMirabilis, IE_contacts, IE_numOfContactsChanged, IE_wpEnd, IE_statusChanged, IE_authReq, IE_auth, IE_authDenied, IE_url, IE_gcard, IE_wpResult, IE_addedYou, IE_visibilityChanged, IE_toofast, IE_connecting, IE_connected, IE_loggin, IE_redirecting, IE_redirected, IE_almostOnline, IE_serverConnected, IE_serverDisconnected, IE_serverSent, IE_serverGot, IE_dcConnected, IE_dcDisconnected, IE_dcSent, IE_dcGot, IE_dcError, IE_creatingUIN, IE_newUin, //s@x IE_ackImage, IE_getImage, //\\ IE_uinDeleted, IE_myinfoACK, IE_pwdChanged, IE_pause, IE_ack, IE_automsgreq, IE_sendingAutomsg, IE_endOfOfflineMsgs, IE_serverAck, IE_msgError, IE_ackXStatus, IE_fileReq, IE_fileOk, IE_fileDenied, IE_fileack, IE_fileabort, IE_contactupdate, IE_typing, IE_getAvtr ); TicqPhase=( null_, // offline connecting_, // trying to reach the login server login_, // performing login on login server reconnecting_, // trying to reach the service server relogin_, // performing login on service server settingup_, // setting up things online_, creating_uin_ // asking for a new uin ); TicqAccept=( AC_OK, AC_DENIED, AC_AWAY ); TicqSession=class; TicqNotify=procedure (Sender:TicqSession; event:TicqEvent) of object; TicqDCmode=(DC_NONE, DC_UPONAUTH, DC_ROASTER, DC_EVERYONE ); TrefKind=( REF_null, REF_wp, REF_query, REF_simplequery, REF_savemyinfo, REF_file, REF_status, REF_msg, REF_contacts, REF_auth, REF_sms ); {$IFDEF usesDC} Tdirect=class; Tdirects=class(Tlist) icq :TicqSession; constructor create(icq_:TicqSession); destructor destroy; override; function newFor(c:Tcontact):Tdirect; end; // Tdirects Tdirect=class private P_host, P_port:string; public sock :TIsocket; contact :Tcontact; imserver :boolean; directs :Tdirects; kind :(DK_none, DK_file); fileName :string; fileReceived, fileTotal :integer; fileData :string; buf :string; myspeed :integer; hisVer :integer; data :pointer; constructor create; destructor destroy; override; procedure connected(Sender: TObject; Error: Word); procedure received(Sender: TObject; Error: Word); procedure disconnected(Sender: TObject; Error: Word); property host:string read P_host; property port:string read P_port; function myPort:integer; function myinfo:Tcontact; procedure connect; procedure listen; procedure close; procedure sendPkt(s:string); procedure sendACK1; procedure sendACK2; procedure sendACK3; procedure sendVcard; procedure sendSpeed; procedure parseVcard(s:string); end; // Tdirect {$ENDIF usesDC} TicqSession=class private startingStatus :Tstatus; startingInvisible :boolean; phase :TicqPhase; Q :TflapQueue; cookie :string; FLAPseq :word; SNACref :integer; waitingNewPwd :string; P_DCmode :TicqDCmode; refs :array [1..maxRefs] of record kind:TrefKind; uin:integer; end; wasUINwp :boolean; // trigger a last result at first result savingMyInfo :record running:boolean; ACKcount:integer; c:Tcontact; end; creatingUIN :boolean; // this is a special session, to create uin previousInvisible :boolean; serviceServerAddr :string; serviceServerPort :string; roaster :TcontactList; visibleList :TcontactList; invisibleList :TcontactList; tempVisibleList :TcontactList; P_webaware :boolean; P_authneeded :boolean; P_pwd :string; procedure setWebaware(value:boolean); procedure setAuthNeeded(value:boolean); procedure setPwd(value:string); procedure setDCmode(v:TicqDCmode); procedure proxy_connected; public listener :TicqNotify; sock :TISocket; // server :Twsocket; {$IFDEF usesDC} directs :Tdirects; {$ENDIF usesDC} loginServerAddr :string; loginServerPort :string; myInfo :Tcontact; publicEmail :boolean; birthdayFlag :boolean; { $IFDEF RNQ_FULL} LoginMD5 :boolean; { $ENDIF} http :record enabled:boolean; addr, port, user, pwd:string; end; // used to pass valors to listeners eventError :TicqError; eventContact :Tcontact; eventContacts :TcontactList; eventMsg :string; eventWP :TwpResult; eventAddress :string; eventInt :integer; // multi-purpose eventTime :TdateTime; // in local time eventName :string; eventFlags :dword; eventOldStatus :Tstatus; eventOldInvisible :boolean; eventData :string; eventUrgent :boolean; eventAccept :TicqAccept; eventFilename :string; eventFileSize :LongWord; {$IFDEF usesDC} eventDirect :Tdirect; {$ENDIF usesDC} eventMsgID :TmsgID; acceptKey: string; imageStream: TMemoryStream; property webaware:boolean read P_webaware write setWebaware; property authNeeded:boolean read P_authNeeded write setAuthNeeded; property pwd:string read P_pwd write setPwd; property DCmode:TicqDCmode read P_dcmode write setDCmode; constructor create; destructor destroy; override; procedure connect; overload; procedure connect(createUIN:boolean); overload; procedure disconnect; procedure setStatus(s:Tstatus; inv:boolean); function getStatus:Tstatus; function isOnline:boolean; function isOffline:boolean; function isReady:boolean; // we can send commands function isConnecting:boolean; function imVisibleTo(c:Tcontact):boolean; function maxCharsFor(c:Tcontact):integer; procedure notificationForMsg(msgtype:byte; flags:byte; urgent:boolean; msg:string; offline:boolean); function getLocalIPstr:string; function getLocalIP:integer; {$IFDEF usesDC} function directTo(c:Tcontact):Tdirect; {$ENDIF usesDC} function serverPort:word; function serverStart:word; // manage contact lists function readInvisible:TcontactList; function readRoaster:TcontactList; function readVisible:TcontactList; function readTemporaryVisible:TcontactList; // manage contacts procedure clearTemporaryVisible; function addTemporaryVisible(c:Tcontact):boolean; overload; function addTemporaryVisible(cl:Tcontactlist):boolean; overload; function removeTemporaryVisible(c:Tcontact):boolean; overload; function removeTemporaryVisible(cl:TcontactList):boolean; overload; function add2visible(c:Tcontact):boolean; overload; procedure add2visible(cl:TcontactList); overload; function removeFromVisible(c:Tcontact):boolean; overload; procedure removeFromVisible(cl:tcontactlist); overload; function add2invisible(c:Tcontact):boolean; overload; procedure add2invisible(cl:TcontactList); overload; function removeFromInvisible(c:Tcontact):boolean; overload; procedure removeFromInvisible(cl:TcontactList); overload; function addContact(c:Tcontact):boolean; overload; procedure addContact(cl:TcontactList); overload; function removeContact(c:Tcontact):boolean; procedure setVisibleList(cl:TcontactList); procedure setInvisibleList(cl:TcontactList); // event managing procedure notifyListeners(ev:TicqEvent); // send packets function sendFLAP(ch:word; data:string):boolean; function sendSNAC(fam,sub:word; data:string):boolean; procedure sendKeepalive; procedure sendMSGsnac(uin : dword; sn : String); function sendMsg(uin,flags:dword; msg:string; var requiredACK:boolean):integer; // returns handle procedure sendSMS(dest, msg:string; ack:boolean); function sendAutoMsgReq(uin:integer):integer; procedure sendContacts(uin,flags:dword; cl:TcontactList); procedure sendQueryInfo(uin:integer); procedure sendSimpleQueryInfo(uin:integer); procedure sendAddedYou(uin:integer); {$IFDEF usesDC} function sendFileReq(uin:integer; msg,fn:string; size:integer):integer; // returns handle procedure sendFileOk(msgID:TmsgID; c:Tcontact); procedure sendFileAbort(msgID:TmsgID); {$ENDIF usesDC} procedure sendFileAck(msgID:TmsgID); procedure sendPermissions; procedure sendAddContact(cl:Tcontactlist); overload; procedure sendRemoveContact(cl:Tcontactlist); overload; procedure sendAddVisible(cl:Tcontactlist); overload; procedure sendRemoveVisible(cl:Tcontactlist); overload; procedure sendAddInvisible(cl:Tcontactlist); overload; procedure sendRemoveInvisible(cl:Tcontactlist); overload; procedure sendAddContact(buinlist:string); overload; procedure sendRemoveContact(buinlist:string); overload; procedure sendAddVisible(buinlist:string); overload; procedure sendRemoveVisible(buinlist:string); overload; procedure sendAddInvisible(buinlist:string); overload; procedure sendRemoveInvisible(buinlist:string); overload; procedure sendACK(status:integer; msg, snac:string); procedure sendWPsearch(wp:TwpSearch; idx : Integer); procedure sendAuthReq(uin:integer; msg:string); procedure sendAuth(uin:integer); procedure sendAuthDenied(uin:integer; msg:string=''); procedure sendStatusCode; procedure sendCreateUIN; procedure sendDeleteUIN; procedure sendsaveMyInfoNew(c:Tcontact); procedure sendSaveMyInfoAs(c:Tcontact); procedure sendReqOfflineMsgs; procedure sendDeleteOfflineMsgs; procedure saveMyInfo1(c:Tcontact); procedure saveMyInfo2(c:Tcontact); procedure saveMyInfo3(c:Tcontact); procedure saveMyInfo4(c:Tcontact); // By Rapid D procedure saveMyInfoInter(c:Tcontact); // Interests function getDCModeStr : String; function CheckInvisibility( uin : dword ) : Integer; // procedure CheckInvisibility( uin : dword ); procedure SendTYPING(uin : Integer; notif_type : Word); procedure RemoveMeFromHisCL(uin : Integer); procedure AuthGrant(uin : Integer); procedure sendCapabilities; {$IFDEF RNQ_FULL} procedure parseTYPING_NOTIFICATION(pkt : String); {$ENDIF} {$IFDEF RNQ_AVATARS} procedure RequestIcon(uin : Integer; hash : String); procedure parseIcon(pkt: string); {$ENDIF RNQ_AVATARS} procedure RequestXStatus(uin : Integer); procedure sendACK10(cont : Tcontact; msg:string; msgID : Int64); procedure send170c; procedure parse170d(snac:string); private function useMsgType2for(c:Tcontact):boolean; procedure sendChangePwd(newPwd:string); procedure parseGCdata(snac:string; offline:boolean=FALSE); // procedure parseStatus(snac:string; ofs:integer); procedure parseOnlineInfo(snac: String; pOfs: Integer; cont : Tcontact; isSt : Boolean); procedure parseStatus(snac:string; ofs:integer; isInvis : Boolean = false); procedure parseNewUIN(snac:string); procedure parseCookie(flap:string); procedure parseOncomingUser(snac:string); procedure parseOffgoingUser(snac:string); procedure parseMsgError(snac:string; ref:integer); procedure parseServerAck(snac:string; ref:integer); procedure parseSRV_LOCATION_ERROR(snac:string; ref:integer); procedure parseSRV_LOGIN_REPLY(snac:string); procedure parseAuthKey(snac:string); procedure parse1503(snac:string; ref:integer); procedure parse040A(snac:string); procedure parse040B(snac:string); procedure parse010F(snac:string); procedure parse0206(snac : String); procedure parseIncomingMsg(snac:string); procedure goneOffline; // called going offline {$IFDEF usesDC} procedure dc_connected(Sender: TObject; Error: Word); {$ENDIF usesDC} procedure connected(Sender: TObject; Error: Word); procedure received(Sender: TObject; Error: Word); procedure disconnected(Sender: TObject; Error: Word); procedure parseContactsString(s:string); procedure parseAuthString(s:string); procedure parsePagerString(s:string); procedure parseAuthReq(pkt : String); procedure newLogin; procedure sendSSIReady; procedure SSIstart(); procedure SSIstop(); procedure SSInewGroup(gID:integer; gName:string; iID : integer = 0); procedure SSInewContact(gID,cID:integer; nUIN,cName:string); procedure SSInewContactauth(gID,cID:integer; nUIN,cName:string); procedure SSIdeleteContact(gID,cID:integer; nUIN,cName:string); procedure SSIdeleteGroup(gID:integer; gName:string); procedure sendLogin; procedure sendImICQ; procedure sendCookie; procedure sendIMparameter(chn : char); procedure sendClientReady; procedure sendAckTo107; function addRef(k:TrefKind; uin:integer):integer; function dontBotherStatus:boolean; function myUINle:string; function getFullStatusCode:dword; end; // TicqSession var GMToffset:TdateTime; // add it to a GMT time, subtract it from your local time GMToffset0:TdateTime; // For OfflineMsg-s & ViewInfo contactsDB:TcontactList; saveMD5Pwd, // sendInterests : Boolean; SupportUTF : Boolean; SendingUTF : Boolean; SupportTyping : Boolean; {$IFDEF RNQ_FULL} // SendedFlaps : LongWord; // ICQMaxFlaps : LongWord = 70; {$ENDIF} function BUIN(uin:integer):string; function base64encode(s:string):string; IMPLEMENTATION uses utilLib, RQ_ICQ, RQUtil;//, globalLib, outboxLib; type TsplitProc=procedure(s:string) of object; const DT2100miliseconds=1/(SecsPerDay*10); var lastSendedFlap : TDateTime; function base64encode(s:string):string; const TABLE='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; type Ttriple=array [0..2] of byte; var p:^Ttriple; i:integer; begin result:=''; p:=@s[1]; for i:=1 to length(s) div 3 do begin result:=result+TABLE[1+p[0] shr 2] +TABLE[1+(p[0] and 3) shl 4+p[1] shr 4] +TABLE[1+(p[1] and 15) shl 2+p[2] shr 6] +TABLE[1+(p[2] and 63)]; inc(p); end; if length(s) mod 3 > 0 then result:=result+TABLE[1+p[0] shr 2]+TABLE[1+(p[0] and 3) shl 4+p[1] shr 4]; case length(s) mod 3 of 1:result:=result+'=='; 2:result:=result+TABLE[1+(p[1] and 15) shl 2+p[2] shr 6]+'='; end; end; // base64encode procedure splitCL(proc:TsplitProc; cl:TcontactList); var i,cnt:integer; s:string; begin if cl.count=0 then begin proc(''); exit; end; i:=0; while (i<cl.count) do begin if i > 0 then sleep(1000); cnt:=5000; s:=''; while (i<cl.count) and (cnt>0) do begin s:=s+cl.getAt(i).buin; inc(i); dec(cnt); end; proc(s); end; end; function BUIN(uin:integer):string; begin result:=SysUtils.intToStr(uin); result:=char(length(result))+result; end; { function chop(ss:string; var s:string):string; overload; var i:integer; begin i:=pos(ss,s); if i=0 then i:=length(s)+1; result:=copy(s,1,i-1); delete(s,1,i-1+length(ss)); end; // chop } function code2status(code:dword):Tstatus; begin code:=code and ($FFFF-8-flag_invisible); case code of $10: begin result:=SC_OCCUPIED; exit end; 4: begin result:=SC_NA; exit end; 2: begin result:=SC_DND; exit end; end; for result:=low(result) to high(result) do if status2code[result] = code then exit; result:=SC_ONLINE; end; // code2status function sameMethods(a,b:TicqNotify):boolean; begin result:= double((@a)^) = double((@b)^) end; function encrypted(s:string):string; const cryptData:array [1..16] of byte=($F3,$26,$81,$C4,$39,$86,$DB,$92,$71,$A3,$B9,$E6,$53,$7A,$95,$7C); var i:integer; begin i:=length(s); setLength(result,i); while i > 0 do begin byte(result[i]):=byte(s[i]) xor cryptData[i]; dec(i); end; end; // encrypted function str2url(s:string):string; var i:integer; ss:string; begin result:=''; for i:=1 to length(s) do begin case s[i] of ' ':ss:='%20'; 'A'..'Z','a'..'z','0'..'9':ss:=s[i]; else ss:='%'+intToHex(ord(s[i]),2); end; result:=result+ss; end; end; // str2html function str2html(s:string):string; var i:integer; ss:string; begin result:=''; for i:=1 to length(s) do begin case s[i] of '�':ss:='&egrave;'; '�':ss:='&egrave;'; '�':ss:='&eacute;'; '�':ss:='&igrave;'; '�':ss:='&ograve;'; '�':ss:='&ugrave;'; '�':ss:='&Eacute;'; '"':ss:='&quot;'; '&':ss:='&amp;'; else ss:=s[i]; end; result:=result+ss; end; end; // str2html function xml_sms(me:Tcontact; dest,msg:string; ack:boolean):string; const yesno:array [boolean] of string=('No','Yes'); begin result:= '<icq_sms_message>'+ '<destination>'+dest+'</destination>'+ '<text>'+str2html(msg)+'</text>'+ '<codepage>1251</codepage>'+ '<senders_UIN>'+SysUtils.intTostr(me.uin)+'</senders_UIN>'+ '<senders_name>'+me.displayed+'</senders_name>'+ '<delivery_receipt>'+yesno[ack]+'</delivery_receipt>'+ '<time>'+formatDatetime('ddd, dd mmm yyyy hh:nn:ss GMT',now-gmtoffset)+'</time>'+ '</icq_sms_message>'; end; // xml_sms ///////////////////////////////////////////////////////// {$IFDEF usesDC} constructor Tdirect.create; begin sock:=TISocket.create(NIL); sock.tag:=integer(@self); sock.OnDataAvailable:=received; sock.OnSessionClosed:=disconnected; imserver:=TRUE; kind:=DK_none; myspeed:=100; end; // create destructor Tdirect.destroy; begin sock.free; directs.remove(self); end; // destroy procedure Tdirect.listen; begin sock.OnSessionAvailable:=connected; imserver:=TRUE; sock.addr:='0.0.0.0'; sock.port:='0'; sock.listen; end; // listen procedure Tdirect.sendPkt(s:string); begin s:=word_LEasStr(length(s))+s; sock.sendStr(s); with directs.icq do begin eventData:=s; eventDirect:=self; notifyListeners(IE_dcSent); end; end; // sendPkt procedure Tdirect.connect; begin sock.OnSessionConnected:=connected; imserver:=FALSE; sock.addr:=dword_LE2ip(contact.ip); sock.port:=intToStr(contact.ft_port); sock.connect; end; // connect procedure Tdirect.close; begin sock.close end; procedure Tdirect.connected(Sender: TObject; Error: Word); var icq:TicqSession; begin icq:=directs.icq; icq.eventDirect:=self; if error<>0 then begin if WSocket_WSAGetLastError <> 0 then error:=WSocket_WSAGetLastError; icq.eventInt:=error; icq.eventError:=EC_cantconnect_dc; icq.notifyListeners(IE_error); exit; end; if imserver then sock.dup(sock.accept); P_host:=sock.GetPeerAddr; P_port:=sock.GetPeerPort; icq.notifyListeners(IE_dcConnected); if not imserver and (kind = DK_file) then sendVcard; end; // connected procedure Tdirect.disconnected(Sender: TObject; Error: Word); begin with directs.icq do begin eventDirect:=self; notifyListeners(IE_dcDisconnected); end; end; // disconnected procedure Tdirect.received(Sender: TObject; Error: Word); const Z=#0#0#0#0; var s:string; l:integer; begin // queue in buf buf:=buf+sock.receiveStr; // extract the packet from buf if length(buf) < 2 then exit; l:=word_LEat(@buf[1]); if length(buf) < l+2 then exit; s:=copy(buf,1,l+2); delete(buf,1,l+2); // log with directs.icq do begin eventData:=s; eventDirect:=self; notifyListeners(IE_dcGot); end; delete(s,1,2); // reply if imserver then case s[1] of #$FF: begin parseVcard(s); sendACK1; sendVcard; end; #3: sendPkt(#3#10#0#0#0#1#0#0#0#1#0#0#0+Z+Z+#1#0#4#0+Z+Z); #0: begin sendSpeed; sendACK2; end; #2: begin sendPkt( #2+Z+#$DA#7#14#0+dword_LEasStr(contact.dc_cookie)+ Z+Z+Z+#1#0#0+#0#0+WNTS('')+Z+Z ); end; #6: begin fileData:=fileData+copy(s,2,length(s)); if fileReceived = fileTotal then close; end; end; if not imserver then case s[1] of #$FF:sendACK1; end; s:=''; end; // received procedure Tdirect.parseVcard(s:string); begin hisVer:=ord(s[2]); if contact=NIL then begin contact:=contactsDB.get(dword_LEat(@s[16])); contact.port:=word_LEat(@s[29]); end; end; // parseVcard function Tdirect.myPort:integer; begin tryStrToInt(sock.getxPort, result) end; function Tdirect.myinfo:Tcontact; begin result:=directs.icq.myinfo end; procedure Tdirect.sendACK1; begin sendPkt(#1#0#0#0) end; procedure Tdirect.sendACK2; begin sendPkt(#1+dword_LEasStr(myspeed)+WNTS(myinfo.displayed)) end; procedure Tdirect.sendACK3; begin sendPkt(#3+Z+Z+dword_LEasStr(myspeed)+#1#0#0) end; procedure Tdirect.sendVcard; begin sendPkt( #$FF+char(6)+#0#$2B#0+dword_LEasStr(contact.uin)+#0#0+ dword_LEasStr(directs.icq.serverPort)+directs.icq.myUINle+ dword_LEasStr(directs.icq.getLocalIP)+#127#0#0#1+#4+ dword_LEasStr(directs.icq.serverPort)+dword_LEasStr(contact.dc_cookie)+ #$50#0#0#0#3#0#0#0#0#0#0#0 ); end; procedure Tdirect.sendSpeed; begin sendPkt(#5+dword_LEasStr(myspeed)) end; /////////////////////////////////////////////////////////////////////// constructor Tdirects.create(icq_:TicqSession); begin icq:=icq_; end; // create destructor Tdirects.destroy; var i:Integer; begin for i:=count-1 downto 0 do Tdirect(items[i]).free; inherited; end; // destroy function Tdirects.newFor(c:Tcontact):Tdirect; begin result:=Tdirect.create; result.contact:=c; result.directs:=self; add(result); end; // newFor {$ENDIF usesDC} /////////////////////////////////////////////////////////////////////// constructor TicqSession.create; begin inherited create; phase:=null_; listener:=NIL; myinfo:=NIL; P_pwd:=''; SNACref:=1; FLAPseq:=$6700+random($100); startingStatus:=SC_ONLINE; {$IFDEF usesDC} directs:=Tdirects.create(self); {$ENDIF usesDC} DCmode:=DC_none; http.enabled:=FALSE; loginServerAddr:='login.icq.com'; loginServerPort:='5190'; Q:=TflapQueue.create; roaster:=TcontactList.create; visibleList:=TcontactList.create; invisibleList:=TcontactList.create; tempVisibleList:=TcontactList.create; savingmyinfo.running:=FALSE; sock:=TISocket.create(NIL); sock.OnSessionConnected:=connected; sock.OnDataAvailable:=received; sock.OnSessionClosed:=disconnected; //sock.FlushTimeout //server:=Twsocket.create(NIL); {$IFDEF usesDC} server.OnSessionAvailable:=dc_connected; {$ENDIF usesDC} imageStream:= TMemoryStream.Create; end; // create destructor TicqSession.destroy; begin {$IFDEF usesDC} directs.free; {$ENDIF usesDC} Q.free; sock.free; roaster.free; visibleList.free; invisibleList.free; tempvisibleList.free; imageStream.Free; inherited destroy; end; // destroy function TicqSession.myUINle:string; begin result:=dword_LEasStr(myinfo.uin) end; procedure TicqSession.setPwd(value:string); begin if (value<>pwd) and (length(value) <= maxPwdLength) then if isOnline then sendChangePwd(value) else P_pwd:=value; end; // setPwd function TicqSession.sendFLAP(ch:word; data:string):boolean; var s:string; begin result:=FALSE; if sock.State <> wsConnected then exit; s:='*' +char(ch) +word_BEasStr(FLAPseq) +word_BEasStr(length(data)) +data; try while abs(now - lastSendedFlap) < DT2100miliseconds do // Application.ProcessMessages ; sock.sendStr(s); lastSendedFlap := now; { if phase=online_ then begin inc(SendedFlaps); if (SendedFlaps > ICQMaxFlaps)and (phase=online_) then sock.Pause; end;} eventData:=s; notifyListeners(IE_serverGot); inc(FLAPseq); if FLAPseq = $8000 then FLAPseq:=0; except end; s:=''; result:=TRUE; end; // sendFLAP function TicqSession.sendSNAC(fam,sub:word; data:string):boolean; begin result:=sendFLAP(SNAC_CHANNEL, SNAC(fam,sub, SNACref)+data) end; procedure TicqSession.sendKeepalive; begin sendFLAP(KEEPALIVE_CHANNEL,'') end; procedure TicqSession.notifyListeners(ev:TicqEvent); begin if assigned(listener) then try listener(self,ev); except on e: exception do begin DebugLn('error listener - ' + eventmsg); end; end; end; // notifyListeners function TicqSession.isOffline:boolean; begin result:= phase=null_ end; function TicqSession.isOnline:boolean; begin result:= phase=online_ end; function TicqSession.isConnecting:boolean; begin result:=not (isOffline or isOnline) end; {$IFDEF usesDC} procedure TicqSession.dc_connected(Sender: TObject; Error: Word); begin if error<>0 then begin if WSocket_WSAGetLastError <> 0 then error:=WSocket_WSAGetLastError; eventInt:=error; eventError:=EC_cantconnect_dc; notifyListeners(IE_error); exit; end; eventDirect:=directs.newFor(NIL); eventDirect.sock.dup(server.accept); notifyListeners(IE_dcConnected); end; // dc_connected {$ENDIF usesDC} procedure TicqSession.goneOffline; var i:integer; begin if phase=null_ then exit; phase:=null_; tempvisibleList.clear; //if DCmode <> DC_none then // server.close; if assigned(myinfo) then begin myinfo.status:=SC_OFFLINE; myinfo.invisible:=FALSE; end; with roaster do for i:=0 to count-1 do with getAt(i) do begin status:=SC_UNK; invisible:=FALSE; {$IFDEF RNQ_FULL} typing.bIsTyping := FALSE; {$IFDEF CHECK_INVIS} invisibleState := 0; {$ENDIF} {$ENDIF} end; notifyListeners(IE_offline); end; // goneOffline procedure TicqSession.disconnect; begin q.reset; sock.close; goneOffline; end; procedure TicqSession.connected(Sender: TObject; Error: Word); var s:string; begin if error <> 0 then begin goneOffline; eventInt:=WSocket_WSAGetLastError; if eventInt=0 then eventInt:=error; eventError:=EC_cantconnect; notifyListeners(IE_error); exit; end; eventAddress:=sock.Addr; notifyListeners(IE_serverConnected); if http.enabled then begin if phase = CONNECTING_ then eventData:=loginServerAddr+':'+loginServerPort else eventData:=serviceServerAddr+':'+serviceServerPort; if http.user > '' then begin s:=base64encode(http.user+':'+http.pwd); s:= 'Authorization: Basic '+s+CRLF+ 'Proxy-authorization: Basic '+s+CRLF; end; eventData:= 'CONNECT '+eventData+' HTTP/1.0'+CRLF+ 'User-agent: ICQ/2000b (Mozilla 1.24b; Windows; I; 32-bit)'+CRLF+ s+ // eventually empty CRLF; sock.sendStr(eventData); notifyListeners(IE_serverGot); end else proxy_connected; end; // connected procedure TicqSession.proxy_connected; begin if creatingUIN then begin phase:=creating_uin_; notifyListeners(IE_connected); end else case phase of connecting_: begin phase:=login_; notifyListeners(IE_connected); end; reconnecting_: begin phase:=relogin_; notifyListeners(IE_redirected); end; end end; // proxy_connected procedure TicqSession.disconnected(Sender: TObject; Error: Word); begin q.reset; eventAddress:=sock.addr; notifyListeners(IE_serverDisconnected); if error <> 0 then begin goneOffline; eventInt:=WSocket_WSAGetLastError; if eventInt=0 then eventInt:=error; eventError:=EC_socket; notifyListeners(IE_error); exit; end; if phase<>login_ then goneOffline; end; // disconnected function TicqSession.isReady:boolean; begin result:=phase in [SETTINGUP_,ONLINE_] end; procedure TicqSession.sendStatusCode; var dc:string; const cookies =#1#2#3#4; begin if not isReady then exit; if DCmode = DC_none then dc:=Z+dword_BEasStr(0) else dc:=dword_LEasStr(getLocalIP) + // server.GetXAddr + //#127#0#0#1+ dword_BEasStr(serverPort); if http.enabled then dc := dc+#1#0 else if sock.SocksServer <> '' then dc := dc+#2#0 else dc := dc+#4#0; dc:=dc + char(ICQ_TCP_VERSION)+cookies+dword_BEasStr($50) + #0#0#0#3+dword_BEasStr(myinfo.lastUpdate_dw)+dword_BEasStr(myinfo.lastInfoUpdate_dw)+Z+#0#0; if previousInvisible<>myinfo.invisible then sendAddVisible(visibleList); sendSNAC(1,$1E, TLV(6, getFullStatusCode) // +TLV(8, #0#0) +TLV($C, dc) // +TLV($11, #1#$2C#$35#$FB#$3B) // +TLV($12, #0#0) ); {pkt.createSNAC(1,$11,0); pkt.addDword_BE(0); pkt.send(sock); addRef(REF_null,0);} if previousInvisible<>myinfo.invisible then begin if not myinfo.invisible then sendAddInvisible(invisibleList); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; previousInvisible:=myinfo.invisible; end; // sendStatusCode procedure TicqSession.sendAddVisible(buinlist:string); begin if not isReady or not myinfo.invisible then exit; sendSNAC(9,5, buinlist); end; // sendAddVisible procedure TicqSession.sendRemoveVisible(buinlist:string); begin if not isReady or not myinfo.invisible then exit; sendSNAC(9,6, buinlist); end; // sendRemoveVisible procedure TicqSession.sendAddInvisible(buinlist:string); begin if not isReady or myinfo.invisible then exit; sendSNAC(9,7, buinlist); end; // sendAddInvisible procedure TicqSession.sendRemoveInvisible(buinlist:string); begin if not isReady or myinfo.invisible then exit; sendSNAC(9,8, buinlist); end; // sendRemoveInvisible procedure TicqSession.sendAddContact(cl:Tcontactlist); begin splitCL(sendAddContact,cl) end; procedure TicqSession.sendRemoveContact(cl:Tcontactlist); begin splitCL(sendRemoveContact,cl) end; procedure TicqSession.sendAddInvisible(cl:Tcontactlist); begin splitCL(sendAddInvisible,cl) end; procedure TicqSession.sendRemoveInvisible(cl:Tcontactlist); begin splitCL(sendRemoveInvisible,cl) end; procedure TicqSession.sendAddVisible(cl:Tcontactlist); begin splitCL(sendAddVisible,cl) end; procedure TicqSession.sendRemoveVisible(cl:Tcontactlist); begin splitCL(sendRemoveVisible,cl) end; procedure TicqSession.sendAddContact(buinlist:string); begin if (buinlist='') or not isReady then exit; sendSNAC(3,4, buinlist); end; // sendAddContact procedure TicqSession.sendRemoveContact(buinlist:string); begin if (buinlist='') or not isReady then exit; sendSNAC(3,5, buinlist); end; // sendRemoveContact {$IFDEF usesDC} function TicqSession.sendFileReq(uin:integer; msg,fn:string; size:integer):integer; var c:Tcontact; begin result:=-1; if not isReady then exit; c:=contactsDB.get(uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) +TLV(5, #0#0 +qword_LEasStr(SNACref)+capability[1]+TLV($A,#0#1) +TLV($F,'')+TLV(3,word_BEasStr(getLocalIP))+TLV(5,word_BEasStr(serverPort)) +TLV($2711, header2711+char(MTYPE_FILEREQ)+#0 +word_LEasStr(word(status2code[myinfo.status]))+#1#0+WNTS(msg) +Z+WNTS(fn)+dword_LEasStr(size)+Z ) ) +TLV(3,'') ); result:=addRef(REF_file,uin); end; // sendFileReq procedure TicqSession.sendFileOk(msgID:TmsgID; c:Tcontact); begin if not isReady then exit; if not imVisibleTo(c) then addTemporaryVisible(c); eventDirect:=directTo(c); eventDirect.listen; sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(msgID)+#0#2 +BUIN(c.uin) +TLV(5, #0#0+qword_LEasStr(msgID)+capability[1]+TLV($A,#0#2) +TLV($F,'')+TLV(3,word_BEasStr(getLocalIP))+TLV(5,word_BEasStr(serverPort)) +TLV($2711, header2711+char(MTYPE_FILEREQ)+#0 +word_LEasStr(word(status2code[myinfo.status]))+#0#0+WNTS('') +Z+WNTS('')+dword_LEasStr(0)+Z +word_BEasStr(eventDirect.myPort)+#0#0+WNTS('')+dword_LEasStr(0) +word_LEasStr(eventDirect.myPort)+#0#0 ) ) +TLV(3,'') ); end; // sendFileOK procedure TicqSession.sendFileAbort(msgID:TmsgID); var c:Tcontact; begin if not isReady then exit; c:=contactsDB.get(refs[msgID].uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(msgID)+#0#2 +BUIN(refs[msgID].uin) +TLV(5, #0#0+qword_LEasStr(msgID)+capability[1]+TLV($B,#0#1) ) ); end; // sendFileAbort {$ENDIF usesDC} procedure TicqSession.sendFileAck(msgID:TmsgID); var c:Tcontact; begin if not isReady then exit; c:=contactsDB.get(refs[msgID].uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(msgID)+#0#2 +BUIN(refs[msgID].uin) +TLV(5, #0#2+qword_LEasStr(msgID) + CAPS_sm2big(CAPS_sm_ICQSERVERRELAY )) ); end; // sendFileAck procedure TicqSession.sendAuthReq(uin:integer; msg:string); var c:Tcontact; begin c:=contactsDB.get(uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#4 +BUIN(uin) +TLV(5, myUINle+char(MTYPE_AUTHREQ)+#0 +WNTS(myinfo.nick+#$FE+myinfo.first+#$FE+myinfo.last+#$FE+myinfo.email+#$FE#0#$FE+msg) ) ); end; // sendAuthReq procedure TicqSession.sendMSGsnac(uin : dword; sn : String); begin sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) +TLV(5, #0#0+qword_LEasStr(SNACref)+ CAPS_sm2big(CAPS_sm_ICQSERVERRELAY) +TLV($A,#0#1) +TLV($F,'') +TLV($2711, header2711 + sn ) ) // +TLV(3,'') ); end; function TicqSession.sendMsg(uin,flags:dword; msg:string; var requiredACK:boolean):integer; var flagChar,priorityChar:char; c:Tcontact; begin result:=-1; if not isReady then exit; c:=contactsDB.get(uin); if c.SendTransl then if pos('<RnQImage>', msg) <= 0 then msg := Translit(msg); if not imVisibleTo(c) then addTemporaryVisible(c); if SendingUTF then msg := AnsiToUtf8(msg); flagChar:=#0; if IF_multiple and flags>0 then flagChar:=#$80; priorityChar:=#1; if IF_urgent and flags>0 then priorityChar:=#2; if IF_noblink and flags>0 then priorityChar:=#4; if useMsgType2For(c) then begin requiredACK:=TRUE; { sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) +TLV(5, #0#0+qword_LEasStr(SNACref)+ CAPS_sm2big(CAPS_sm_ICQSERVERRELAY) +TLV($A,#0#1) +TLV($F,'') +TLV($2711, header2711+} sendMSGsnac(uin, char(MTYPE_PLAIN)+flagChar+ word_LEasStr(getFullStatusCode) +priorityChar+#0 +WNTS(msg) +dword_LEasStr(0)+dword_LEasStr($FFFFFF) // ) // ) // +TLV(3,'') ); end else begin requiredACK:=FALSE; sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#1 +BUIN(uin) +TLV(2, TLV($0501, #1)+TLV($0101, Z+msg) ) // msg-data-1 // +TLV(5, myUINle+char(MSG_MSG)+flagChar+WNTS(msg) ) // msg-data-4 +TLV(6, '') ); end; result:=addRef(REF_msg,uin); end; // sendMsg function TicqSession.sendAutoMsgReq(uin:integer):integer; var c:Tcontact; msgtype:byte; s:Tstatus; begin result:=-1; c:=contactsDB.get(uin); if c.status <> SC_ONLINE then s:=c.status else s:=c.prevStatus; case s of SC_OCCUPIED: msgtype:=MTYPE_AUTOBUSY; SC_NA: msgtype:=MTYPE_AUTONA; SC_DND: msgtype:=MTYPE_AUTODND; SC_F4C: msgtype:=MTYPE_AUTOFFC; else msgtype:=MTYPE_AUTOAWAY; end; if not isReady then exit; sendMSGsnac(uin,char(msgtype)+#3+Z+WNTS('') ); result:=addRef(REF_msg,uin); end; // sendAutoMsgReq procedure TicqSession.sendAddedYou(uin:integer); var c:Tcontact; begin if not isReady then exit; c:=contactsDB.get(uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#4 +BUIN(uin) +TLV(5, myUINle+char(MTYPE_ADDED)+#$00+WNTS('') ) +TLV(6,'') ); end; // sendAddedYou procedure TicqSession.sendContacts(uin,flags:dword; cl:TcontactList); var s:string; c:Tcontact; begin if not isReady then exit; if cl.empty then exit; c:=contactsDB.get(uin); if not imVisibleTo(c) then addTemporaryVisible(c); s:=SysUtils.intToStr(cl.count)+#$FE; cl.resetEnumeration; while cl.hasMore do with cl.getNext do s:=s+SysUtils.intToStr(uin)+#$FE+nick+#$FE; sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#4 +BUIN(uin) +TLV(5, myUINle+char(MTYPE_CONTACTS)+#00+WNTS(s)) +TLV(6,'') ); addRef(REF_contacts,uin); end; // sendContacts procedure TicqSession.sendAuth(uin:integer); var c:Tcontact; begin if not isReady then exit; c:=contactsDB.get(uin); if not imVisibleTo(c) then addTemporaryVisible(c); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#4 +BUIN(uin) +TLV(5, myUINle+char(MTYPE_AUTHOK)+#0+WNTS('')) +TLV(6, '') ); addRef(REF_auth,uin); end; // sendAuth procedure TicqSession.sendAuthDenied(uin:integer; msg:string); begin if not isReady then exit; sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#4 +BUIN(uin) +TLV(5, myUINle+char(MTYPE_AUTHDENY)+#0+WNTS(msg)) +TLV(6, '') ); end; // sendAuth procedure TicqSession.sendSimpleQueryInfo(uin:integer); begin if not isReady then exit; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#0#$1F#5 +dword_LEasStr(uin) ))); addRef(REF_simplequery, uin); end; // sendSimpleQueryInfo procedure TicqSession.sendQueryInfo(uin:integer); var wp : TwpSearch; begin wp.uin := uin; sendWPsearch(wp, 0); end; // sendQueryInfo procedure TicqSession.sendWPsearch(wp:TwpSearch; idx : Integer); function TLVIfNotNull(t : word; s : String) : String; begin if s > '' then result := TLV_LE(t, WNTS(s)); end; function TLVIfbNotNull(t : word; b : byte) : String; begin if b > 0 then result := TLV_LE(t, char(b)); end; function TLVIfWNotNull(t : word; w : word) : String; begin if w > 0 then result := TLV_LE(t, word_LEasStr(w)); end; function TLVIfDWNotNull(t : word; d : dword) : String; begin if d > 0 then result := TLV_LE(t, dword_BEasStr(d)); end; function TLVIfINotNull(t : word; w : word; s : String) : String; begin if (w > 0) or (s > '') then result := TLV_LE(t, word_LEasStr(w) + WNTS(s)); end; const TAB:array [boolean] of char=(#$B2,#$D0); var s : String; begin if not isReady then exit; wasUINwp:=wp.uin > 0; if wasUINwp then begin s := TAB[myinfo.uin=wp.uin]+#4+dword_LEasStr(wp.uin); end else { if wp.email > '' then begin s := word_LEasStr(META_SEARCH_EMAIL) + TLV_LE(User_email, WNTS(wp.email)); end else} begin s := word_LEasStr(META_SEARCH_GENERIC) + TLVIfNotNull(User_First, wp.first) + TLVIfNotNull(User_Last, wp.last) + TLVIfNotNull(User_Nick, wp.nick) + TLVIfNotNull(User_email, wp.email) + TLVIfNotNull(User_City, wp.city) + TLVIfNotNull(User_State, wp.state) + TLVIfINotNull(User_Inter, wp.wInterest, wp.keyword) + TLVIfbNotNull(User_Gender, wp.gender) + TLVIfWNotNull(User_Lang, wp.lang) + TLVIfDWNotNull(User_Age, wp.age) + TLVIfbNotNull(User_OnOf, Byte(wp.onlineOnly)) // + TLVIfNotNull(User_, wp.) // + TLVIfNotNull(User_, wp.) end; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle + word_LEasStr(CLI_META_INFO_REQ) + word_LEasStr(idx) + s))); if wasUINwp then addRef(REF_wp,wp.uin) else addRef(REF_wp,0); end; // sendWPsearch procedure TicqSession.sendReqOfflineMsgs; begin sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$3C#0#0#0))) end; procedure TicqSession.sendDeleteOfflineMsgs; begin sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$3E#0#0#0))) end; procedure TicqSession.sendDeleteUIN; begin sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#1#0#$C4#4 +myUINle +WNTS(pwd) ))); end; // sendDeleteUIN procedure TicqSession.sendPermissions; const tab1:array [boolean] of char=(#1,#0); tab2:array [boolean] of char=(#0,#1); begin if not isReady then exit; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#0#$24#4 +tab1[authNeeded]+tab2[webaware]+#1#0 ))); end; // sendPermissions procedure TicqSession.sendSMS(dest, msg:string; ack:boolean); begin if not isReady then exit; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#0#$82#14+#0#1#0#$16+StringOfChar(#0,18) +Length_BE( xml_sms(myinfo, dest,msg,ack) ) ))); addRef(REF_sms,0); end; // sendSMS procedure TicqSession.sendSaveMyInfoAs(c:Tcontact); begin if not isReady then exit; savingMyInfo.running:=TRUE; savingMyInfo.ACKcount:=0; savingMyInfo.c:=c; saveMyInfo1(c); saveMyInfo2(c); saveMyInfo3(c); saveMyInfo4(c); //if sendInterests then saveMyInfoInter(c); end; // sendSaveMyInfoAs procedure TicqSession.saveMyInfo1(c:Tcontact); // main-home begin if not isReady then exit; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#1#$EA#3 +WNTS(c.nick) +WNTS(c.first) +WNTS(c.last) +WNTS(c.email) +WNTS(c.city) +WNTS(c.state) +#0#0 +#0#0 +#0#0 +WNTS(c.cellular) +WNTS(c.zip) +Word_LEasStr(c.country) +char(c.GMThalfs) +char(publicEmailTab[publicEmail]) ))); addRef(REF_savemyinfo,1); end; // saveMyInfo1 procedure TicqSession.saveMyInfo2(c:Tcontact); // homepage-more var s:string; begin if c.birth > 1 then c.age:=trunc((now-c.birth)/365); if c.birth > 1 then s:=Word_LEasStr(yearOf(c.birth)) +char(monthOf(c.birth)) +char(dayOf(c.birth)) else s:=Z; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#2#$FD#3 +Word_LEasStr(c.age) // +char(c.age) // +#0 +char(c.gender) +WNTS(c.homepage) +s +char(c.lang[1]) +char(c.lang[2]) +char(c.lang[3]) ))); addRef(REF_savemyinfo,2); end; // savemyinfo2 procedure TicqSession.saveMyInfo3(c:Tcontact); // about begin sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#3#6#4 +WNTS(c.about) ))); addRef(REF_savemyinfo,3); end; // savemyinfo3 procedure TicqSession.saveMyInfo4(c:Tcontact); // more emails begin sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle +#$D0#7#0#4#$B#4#0 ))); addRef(REF_savemyinfo,4); end; // savemyinfo4 procedure TicqSession.saveMyInfoInter(c:Tcontact); // Interests var s : String; begin s := TLV(1, Length_LE( myUINle +#$D0#7#2#0#$10#04 +#$04 + Word_LEasStr(c.interests.InterestBlock[0].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[0].Names)) + Word_LEasStr(c.interests.InterestBlock[1].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[1].Names)) + Word_LEasStr(c.interests.InterestBlock[2].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[2].Names)) + Word_LEasStr(c.interests.InterestBlock[3].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[3].Names)) )); sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, s); addRef(REF_savemyinfo,5); end; // savemyinfo5 procedure TicqSession.sendsaveMyInfoNew(c:Tcontact); const tab1:array [boolean] of char=(#1,#0); tab2:array [boolean] of char=(#0,#1); var sb : String; zi : Integer; begin if c.birth > 1 then c.age:=trunc((now-c.birth)/365); if c.birth > 1 then sb:=Word_LEasStr(yearOf(c.birth)) +char(monthOf(c.birth)) +char(dayOf(c.birth)) else sb:=Z; if not tryStrToInt(c.zip, zi) then zi := 0; sendSnac(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle + #$D0#07#02#00#$3A#$0C + TLV_LE(User_First, WNTS(c.first)) + TLV_LE(User_Last, WNTS(c.last)) + TLV_LE(User_Nick, WNTS(c.nick)) + TLV_LE(User_email, WNTS(c.email) + char(publicEmailTab[publicEmail]) + TLV_LE(User_Age, Word_LEasStr(c.age))) + TLV_LE(User_Gender, char(c.gender)) + TLV_LE(User_Lang, Word_LEasStr(c.lang[1])) + TLV_LE(User_Lang, Word_LEasStr(c.lang[2])) + TLV_LE(User_Lang, Word_LEasStr(c.lang[3])) + TLV_LE(User_City, WNTS(c.city)) + TLV_LE(User_State, WNTS(c.state)) + TLV_LE(User_Cntry, Word_LEasStr(c.country)) + TLV_LE(User_Inter, Word_LEasStr(c.interests.InterestBlock[0].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[0].Names))) + TLV_LE(User_Inter, Word_LEasStr(c.interests.InterestBlock[1].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[1].Names))) + TLV_LE(User_Inter, Word_LEasStr(c.interests.InterestBlock[2].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[2].Names))) + TLV_LE(User_Inter, Word_LEasStr(c.interests.InterestBlock[3].Code) + WNTS(strings2Str(',', c.interests.InterestBlock[3].Names))) + TLV_LE(User_URL, #00#00+WNTS(c.homepage)) + TLV_LE(User_Birth, WNTS(sb)) + TLV_LE(User_Notes, WNTS(c.about)) + TLV_LE(User_HmZip, dword_LEasStr(zi)) + TLV_LE(User_HmCel, WNTS(c.cellular)) + TLV_LE(User_GMTos, char(c.GMThalfs)) + TLV_LE(User_WebSt, tab2[webaware]) + TLV_LE(User_Auth, tab1[authNeeded]) // + TLV(User_, WNTS(c.)) ))); end; procedure TicqSession.sendChangePwd(newPwd:string); begin if not isReady then exit; waitingNewPwd:=newPwd; sendSNAC(ICQ_EXTENSIONS_FAMILY, CLI_META_REQ, TLV(1, Length_LE( myUINle+#$D0#7#0#0#$2E#4+WNTS(newpwd) ) ) ); end; // sendChangePwd procedure TicqSession.parseAuthKey(snac:string); var I : Integer; MD5Digest : TMD5Digest; MD5Context : TMD5Context; key : String; sendKey : String; begin i := 1; key := getWNTS(snac, i); FillChar(MD5Digest, sizeOf(TMD5Digest), 0); // for I := 0 to 15 do // Byte(MD5Digest[I]) := 0; MD5Init(MD5Context); MD5UpdateBuffer(MD5Context, PChar(key), length(key)); MD5UpdateBuffer(MD5Context, PChar(pwd), length(pwd)); MD5UpdateBuffer(MD5Context, PChar(AIM_MD5_STRING), length(AIM_MD5_STRING)); MD5Final(MD5Digest, MD5Context); sendKey := ''; for I := 0 to 15 do sendKey := sendKey + MD5Digest[I]; // sendFLAP( LOGIN_CHANNEL, #0#0#0#1 if saveMD5Pwd then key := TLV($4C, '') else key := ''; sendSNAC( $17, $02, TLV(1, myinfo.uinAsStr) +TLV($25, sendKey) // By Rapid D +TLV(3, 'ICQ Inc. - Product of ICQ (TM).2003b.5.56.1.3916.85') +TLV($16, word($010A)) +TLV($17, word($0002)) +TLV($18, word($0038)) +TLV($19, word($0001)) +TLV($1A, word($0f4c)) +TLV($14, integer($55)) +TLV($E,'us') +TLV($F,'en') +key ); notifyListeners(IE_loggin); end; procedure TicqSession.parseSRV_LOGIN_REPLY(snac:string); begin end; procedure TicqSession.parseCookie(flap:string); var add:string; i:integer; begin i:=findTLV(8, flap); if i > 0 then begin case getTLVwordBE(@flap[i]) of $1D:eventError:=EC_loginDelay; $18:eventError:=EC_rateExceeded; $01:eventError:=EC_badUIN; $05:eventError:=EC_badPwd; $04:eventError:=EC_badPwd; else eventError:=EC_other; end; notifyListeners(IE_error); disconnect; exit; end; add:=getTLV(5, flap); serviceServerAddr:=copy(add,1,pos(':',add)-1); serviceServerPort:=copy(add,pos(':',add)+1,10); cookie:=getTLV(6, flap); sock.close; sock.WaitForClose; // prevent to change properties while the socket is open if http.enabled then begin sock.addr:=http.addr; sock.port:=http.port; end else begin sock.addr:=serviceServerAddr; sock.port:=serviceServerPort; end; phase:=RECONNECTING_; notifyListeners(IE_redirecting); sock.Connect; end; // parseCookie procedure TicqSession.parseOncomingUser(snac:string); var s, cap:string; ofs, i:integer; found:boolean; begin eventFlags:=0; eventTime:=now; ofs:=1; eventContact:=contactsDB.get(getBUIN(snac,ofs)); inc(ofs, 4); if existsTLV(5, snac,ofs) then eventContact.memberSince:=UnixToDateTime(getTLVdwordBE(5, snac,ofs)); {$IFDEF RNQ_FULL} if existsTLV($b, snac,ofs) then eventContact.typing.bSupport := True else eventContact.typing.bSupport := false; {$ENDIF} {$IFDEF RNQ_FULL} if existsTLV($1D, snac,ofs) then begin s:=getTLV($1D, snac,ofs); if s > '' then begin // with eventContact do eventContact.Icon_ID := word_BEat(@s[1]); eventContact.Icon_Flags := Byte(s[3]); eventContact.Icon_HL := Byte(s[4]); eventContact.Icon_hash := copy(s,5, eventContact.Icon_HL); end; end; {$ENDIF} //parseStatus(snac,ofs); {with eventContact do if status = SC_OFFLINE then // there could be no status specified, then SC_ONLINE begin prevStatus:=status; status:=SC_ONLINE; notifyListeners(IE_oncoming); lastTimeSeenOnline:=eventTime; end; } parseOnlineInfo(snac,ofs, eventContact, true); end; // parseOncomingUser procedure TicqSession.parseOnlineInfo(snac: String; pOfs: Integer; cont : Tcontact; isSt : Boolean); var ofs : Integer; s : String; cap : String[16]; found : Boolean; i : Integer; t : Byte; begin ofs := pOfs; cont.ip:=getTLVdwordBE($A, snac,ofs); if existsTLV(2, snac,ofs) then cont.createTime:=UnixToDateTime(getTLVdwordBE(2, snac,ofs)); if existsTLV(3, snac,ofs) then cont.onlineSince:=UnixToDateTime(getTLVdwordBE(3, snac,ofs))+GMToffset else cont.onlineSince:=0; if isSt then t := $D else t := $05; if existsTLV(t, snac,ofs) then with cont do begin s:=getTLV(t, snac,ofs); capabilitiesBig:=[]; capabilitiesSm:=[]; extracapabilities:=''; {$IFDEF RNQ_FULL} xStatus := 0; {$ENDIF} while s > '' do begin cap:=copy(s,1,16); delete(s,1,16); found:=FALSE; for i:=1 to length(BigCapability) do if cap = BigCapability[i].v then begin include(capabilitiesBig,i); found:=TRUE; break; end; if copy(cap, 1, 2) = CapsMakeBig1 then if copy(cap, 5, 12) = CapsMakeBig2 then begin cap := copy(cap, 3, 2); for i:=1 to length(CapsSmall) do if cap = CapsSmall[i].v then begin include(capabilitiesSm,i); found:=TRUE; break; end; end; {$IFDEF RNQ_FULL} if not found then begin for i:= 1 to High(XStatus) do if cap = aXStatus[i].pid then begin xStatus := i; found := TRUE; break; end; end; {$ENDIF} if not found then extracapabilities:=extracapabilities+cap; end; // temporary fix for icq2go, this prevents from using type-2 messages icq2go:=(CAPS_sm_UTF8 in capabilitiesSm) and not (CAPS_sm_ICQSERVERRELAY in capabilitiesSm); if CAPS_big_Tril in capabilitiesBig then icq2go := true; {$IFDEF RNQ_FULL} if CAPS_big_MTN in capabilitiesBig then cont.typing.bSupport := True; {$ENDIF} end; s:=getTLV($C, snac,ofs); if s > '' then begin cont.internal_ip:=dword_BEat(@s[1]); cont.port:=dword_BEat(@s[5]); cont.proto:=word_BEat(@s[10]); cont.dc_cookie:=dword_BEat(@s[12]); cont.lastupdate_dw:=dword_BEat(@s[24]); cont.lastinfoupdate_dw:=dword_BEat(@s[28]); cont.lastStatusUpdate_dw:=dword_BEat(@s[32]); cont.lastUpdate:=UnixToDateTime(cont.lastupdate_dw)+GMToffset; cont.lastInfoUpdate:=UnixToDateTime(cont.lastinfoupdate_dw)+GMToffset; cont.lastStatusUpdate:=UnixToDateTime(cont.laststatusupdate_dw)+GMToffset; end else begin cont.port:=0; cont.dc_cookie:=0; cont.proto:=0; cont.lastupdate_dw:=0; cont.lastinfoupdate_dw:=0; cont.laststatusupdate_dw:=0; end; parseStatus(snac, ofs, not isSt); end; procedure TicqSession.parseStatus(snac:string; ofs:integer; isInvis : Boolean = false); var newStatus:Tstatus; newInvis:boolean; code:integer; begin if not existsTLV(6, snac,ofs) then exit; eventContact.prevStatus:=eventContact.status; eventOldStatus:=eventContact.status; eventOldInvisible:=eventContact.invisible; code:=getTLVdwordBE(6, snac,ofs); newStatus:=code2status(code); newInvis:=code and flag_invisible>0; if (eventContact.status = SC_OFFLINE) or (eventContact.invisibleState = 2) then begin eventContact.status:=newStatus; eventContact.invisible:=newInvis; if isInvis then begin if (newStatus <> eventOldStatus) or (newInvis<> eventOldInvisible) then begin // eventContact.status:=newStatus; eventContact.invisibleState := 2; notifyListeners(IE_statuschanged); end; end else begin eventContact.invisibleState := 0; notifyListeners(IE_oncoming); end; eventContact.lastTimeSeenOnline:=eventTime; end else if (newStatus <> eventOldStatus) or (newInvis<> eventOldInvisible) then begin eventContact.status:=newStatus; eventContact.invisible:=newInvis; notifyListeners(IE_statuschanged); end else notifyListeners(IE_contactupdate); end; // parseStatus procedure TicqSession.parseOffgoingUser(snac:String); var ofs:integer; begin eventFlags:=0; eventTime:=now; ofs:=1; eventContact:=contactsDB.get(getBUIN(snac,ofs)); eventContact.prevStatus:=eventContact.status; eventOldStatus:=eventContact.status; eventOldInvisible:=eventContact.invisible; eventContact.status:=SC_OFFLINE; eventContact.invisible:=FALSE; eventContact.lastTimeSeenOnline:=eventTime; notifyListeners(IE_offgoing); end; // parseoffgoingUser procedure TicqSession.parseContactsString(s:string); var c:Tcontact; begin eventContacts:=TcontactList.create; chop(#$FE,s); // skippo il numero dei contatti while s > '' do try c:=contactsDB.get(strToInt(chop(#$FE,s))); c.nick:=chop(#$FE,s); eventContacts.add(c); except end; end; // parseContactsString procedure TicqSession.parseAuthString(s:string); begin with eventContact do begin nick:= StrUtils.ifThen( nick='', chop(#$FE,s), nick); first:=StrUtils.ifThen( first='', chop(#$FE,s), first); last:=StrUtils.ifThen( last='', chop(#$FE,s), last); email:=StrUtils.ifThen( email='', chop(#$FE,s), email); end; //chop(#$FE,s); // skip unknown char //s := UTF8ToStrSmart(s); eventMsg:=s; end; // parseAuthString procedure TicqSession.notificationForMsg(msgtype:byte; flags:byte; urgent:boolean; msg:string; offline:boolean); begin if msgtype in MTYPE_AUTOMSGS then begin notifyListeners(IE_automsgreq); exit; end; if msg='' then exit; eventFlags:=0; if flags and $80 > 0 then inc(eventFlags, IF_multiple); if urgent then inc(eventFlags, IF_urgent); if offline then inc(eventFlags, IF_offline); case msgtype of MTYPE_PLAIN: begin eventMsg:=msg; notifyListeners(IE_msg); end; MTYPE_URL: begin eventMsg:=chop(#$FE,msg); eventAddress:=msg; notifyListeners(IE_url); end; MTYPE_CONTACTS: begin parseContactsString(msg); notifyListeners(IE_contacts); end; MTYPE_ADDED: begin parseAuthString(msg); notifyListeners(IE_addedYou); end; MTYPE_AUTHREQ: begin parseAuthString(msg); notifyListeners(IE_authReq); end; MTYPE_EEXPRESS: begin parsePagerString(msg); notifyListeners(IE_email); end; MTYPE_SERVER: begin parsePagerString(msg); notifyListeners(IE_fromMirabilis); end; MTYPE_WWP: begin parsePagerString(msg); notifyListeners(IE_webpager); end; end; end; // notificationForMsg procedure TicqSession.parseGCdata(snac:string; offline:boolean=FALSE); var ofs,v:integer; s:string; begin ofs:=1; inc(ofs, 20); if pos('Greeting Card', getDLS(snac, ofs))=0 then exit; inc(ofs,3); v:=ord(snac[ofs]) shl 8+ord(snac[ofs+2]); // get version inc(ofs,4); case v of $0100, // 1.0 not tested $0101: inc(ofs,4); else inc(ofs,12); // for version 1.2+ end; getDLS(snac,ofs); // version getDLS(snac,ofs); // theme s:='http://www.icq.americangreetings.com/icqorder.pd?mode=send'; s:=s+'&pre_title='+str2url(getDLS(snac,ofs)); s:=s+'&design='+str2url(getDLS(snac,ofs)); s:=s+'&title='+str2url(getDLS(snac,ofs)); s:=s+'&recipient='+str2url(getDLS(snac,ofs)); s:=s+'&text='+str2url(getDLS(snac,ofs)); s:=s+'&sender='+str2url(getDLS(snac,ofs)); inc(ofs,4); // skip version if v>=$0102 then eventAddress:=getDLS(snac,ofs) else eventAddress:=s; notifyListeners(IE_gcard); end; // parseGCdata procedure TicqSession.parseSRV_LOCATION_ERROR(snac:string; ref:integer); var i : Integer; begin { i:=acks.findID(ref); if i>=0 then begin with acks.getAt(i) do begin sendSNAC(4,6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) + word_BEasStr(5)+word_BEasStr($60) // +TLV(5, #0#0+//qword_LEasStr(SNACref)//+capability[1] + #0#0 + qword_LEasStr(0) + z+z+z+z +TLV($A,#0#1) +TLV($F,'') // +TLV($2711, + word_BEasStr($2711)+word_BEasStr($38)+ header2711_2+//char(MTYPE_PLAIN)+flagChar+ #$E8 + #03+ word_LEasStr(getFullStatusCode)// +priorityChar+#0 +#00+#$21 +#3+#0 + #0 + #01 + #00 +#00 +#06 +#00+#00 // +WNTS('') // +dword_LEasStr(0)+dword_LEasStr($FFFFFF) // ) // ) ); acks.add(OE_msg, uin, 0, 'InvAll').ID := addRef(REF_msg,uin); end; acks.Delete(i); end; } eventMsgID:=ref; eventInt:=word_BEat(@snac[1]); notifyListeners(IE_msgError); end; // parseMsgError procedure TicqSession.parseMsgError(snac:string; ref:integer); begin eventMsgID:=ref; eventInt:=word_BEat(@snac[1]); notifyListeners(IE_msgError); end; // parseMsgError procedure TicqSession.parseServerAck(snac:string; ref:integer); var ofs:integer; begin eventMsgID:=qword_LEat(@snac[1]); ofs:=11; eventContact:=contactsDB.get(getBUIN(snac,ofs)); notifyListeners(IE_serverAck); end; // parseServerAck procedure TicqSession.parseIncomingMsg(snac:string); var msg :string; msgLen : dword; ofs, l :integer; priority, msgtype, msgflags :byte; TypeId : Byte; CharsetNumber, CharsetSubset : Word; Cap : String[16]; Plugin : String[16]; PlugNameLen : longWord; PlugName : String; i, k : Integer; begin eventMsgID:=qword_LEat(@snac[1]); ofs:=11; eventContact:=contactsDB.get(getBUIN(snac,ofs)); inc(ofs, 4); eventTime:=now; if existsTLV(2, snac,ofs) then myinfo.CreateTime:=UnixToDateTime(getTLVdwordBE(2, snac,ofs)); if existsTLV(3, snac,ofs) then myinfo.memberSince:= UnixToDateTime(getTLVdwordBE(3, snac,ofs)); if existsTLV(4, snac,ofs) then myinfo.IdleTime:= getTLVwordBE(4, snac,ofs); if existsTLV($0F, snac,ofs) then myinfo.OnlineTime:= getTLVdwordBE($0F, snac,ofs); parseStatus(snac,ofs, true); case ord(snac[10]) of // msg format 1:begin // Simply(old-type) message ofs:=findTLV(2, snac,ofs)+4+3; inc(ofs, 3+ord(snac[ofs])); l:=word_BEat(snac,ofs)-4; inc(ofs, 2); CharsetNumber:=word_BEat(snac, ofs); //The encoding used for the message. //0x0000: US-ASCII //0x0002: UCS-2BE (or UTF-16?) //0x0003: local 8bit encoding, eg iso-8859-1, cp-1257, cp-1251. //Beware that UCS-2BE will contain zero-bytes for characters in the US-ASCII range. inc(ofs, 2); CharsetSubset:=word_BEat(snac, ofs); //Unknown; seen: 0x0000 = 0, 0xffff = -1. inc(ofs, 2); msg:=copy(snac,ofs,l); DebugLn(msg); // if CharsetNumber = 2 then // msg := UnWideStr(msg); notificationForMsg(MTYPE_PLAIN,0,TRUE,msg,FALSE); end; 2:begin //Advanced(new-type) ofs := findTLV(5, snac,ofs); inc(ofs, 2); if word_BEat(@snac[ofs]) < 10 then inc(ofs, word_BEat(@snac[ofs])+2); ofs := findTLV(5, snac,ofs); inc(ofs, 4); case ord(snac[ofs+1]) of 1:begin notifyListeners(IE_fileabort); exit; end; 2:begin notifyListeners(IE_fileack); exit; end; end; inc(ofs, 2+8); Cap := copy(Snac, ofs, 16); inc(ofs, 16); if existsTLV(4, snac,ofs) then eventContact.ip:=getTLVdwordBE(4, snac,ofs); if existsTLV(5, snac,ofs) then eventContact.port:=getTLVwordBE(5, snac,ofs); ofs:=findTLV($2711, snac,ofs)+4; inc(ofs, ord(snac[ofs])+2); inc(ofs, ord(snac[ofs])+2); msgtype:=ord(snac[ofs]); msgflags:=ord(snac[ofs+1]); priority:=ord(snac[ofs+4]); inc(ofs,6); msg:=getWNTS(snac, ofs); // for now we are not able to manage filetransfers // if msgtype = MTYPE_FILEREQ then // begin // sendACK(ACK_FILEDENY, 'sorry, i''m not able to receive file at the moment', snac); // exit; // end; if dontBotherStatus and ((priority = 1) or (msgtype in MTYPE_AUTOMSGS)) then begin case getStatus of SC_dnd: sendACK(ACK_DND,'',snac); SC_occupied: sendACK(ACK_OCCUPIED,'', snac); end; exit; end; // here we can be bothered :P if msgtype=MTYPE_FILEREQ then begin eventcontact.ft_port:=word_BEat(@snac[ofs]); inc(ofs, 4); eventFilename:=getWNTS(snac, ofs); eventInt:=dword_LEat(@snac[ofs]); // if eventFilename > '' then // notifyListeners(IE_filereq) // else if refs[eventMsgID].kind = REF_file then notifyListeners(IE_fileok); exit; end; if msgtype=MTYPE_PLUGIN then begin // debug_Snac(snac, 'FileSend.snac'); inc(ofs, 2); Plugin := copy(snac, ofs, 16); inc(ofs, 16); inc(ofs, 2); PlugNameLen := dword_LEat(@snac[ofs]); inc(ofs, 4); PlugName := copy(snac, ofs, PlugNameLen); inc(ofs, PlugNameLen); TypeId := TypeStringToTypeId(PlugName); if TypeId = MTYPE_FILEREQ then begin inc(ofs, 19); // eventport:=word_BEat(@snac[ofs]); inc(ofs, 2); // FFSeq2 := word_BEat(@snac[ofs]); inc(ofs, 2); inc(ofs, 4); eventFilename := getWNTS(snac, ofs); eventFileSize := dword_LEat(@snac[ofs]); inc(ofs, 4); if eventFilename > '' then notifyListeners(IE_filereq) else if refs[eventMsgID].kind = REF_file then notifyListeners(IE_fileok); end else if TypeId in [MTYPE_PLAIN, MTYPE_AUTOAWAY] then begin inc(ofs, 6); inc(ofs, 9); // len := dword_LEat(@snac[ofs]); inc(ofs, 4); msglen := dword_LEat(@snac[ofs]); inc(ofs, 4); msg := copy(snac,ofs,msglen); notificationForMsg(TypeId, msgflags, priority=2, msg, FALSE); end else if TypeId = MTYPE_XSTATUS then begin { inc(ofs, 15); inc(ofs, 4); msglen := dword_LEat(@snac[ofs]); inc(ofs, 4); eventFilename := copy(snac,ofs,msglen); i := Pos('title&gt;', eventFilename); if i > 0 then begin k := Pos('&lt;/title', eventFilename); if (k-i) > 0 then eventMsg := copy(eventFilename, i, k-i); notifyListeners(IE_ackXStatus); end;} // sendACK10(eventContact, AnsiToUtf8(curXStatusStr), eventMsgID); exit; end; // else if TypeId = { Inc(Pkt^.Len, 19); fDesc := GetDWStr(Pkt); aPort := GetInt(Pkt, 2); FFSeq2:= GetInt(Pkt, 2); fName := GetWStr(Pkt); fSize := GetInt(Pkt, 4); } //(cap = MsgCapabilities[1])) // Capabs := copy(msg, MsgOfs, 4); // parseGCdata( copy(snac, ofs, length(snac)) ) end else begin DebugLn(msg); notificationForMsg(msgtype, msgflags, priority=2, msg, FALSE); end; case getStatus of SC_away: sendACK(ACK_AWAY,'', snac); SC_na: sendACK(ACK_NA,'', snac); SC_dnd, SC_occupied: if priority=2 then sendACK(ACK_OK, '', snac) else sendACK(ACK_NOBLINK,'', snac) else sendACK(ACK_OK, '', snac) end; end; 4:begin ofs:=findTLV(5, snac,ofs); msg:=ptrWNTS(@snac[ofs+10]); msgtype:=ord(snac[ofs+8]); DebugLn(msg); if msgtype=MTYPE_PLUGIN then parseGCdata( copy(snac, ofs+4+6+3+length(msg), length(snac)) ) else notificationForMsg(msgtype, ord(snac[ofs+9]), not dontBotherStatus, msg, FALSE); end; end; // case end; // parseincomingMsg procedure TicqSession.parsePagerString(s:string); begin eventName:=chop(#$FE,s); chop(#$FE,s); chop(#$FE,s); eventAddress:=chop(#$FE,s); chop(#$FE,s); eventMsg:=s; end; // parsePagerString procedure TicqSession.parseAuthReq(pkt : String); var ofs : Integer; uin : Integer; Some : String; begin ofs := 1; Some := getBEWNTS(pkt, ofs); UIN := getBUIN(pkt, ofs); eventContact := contactsDB.get(UIN); // contactsDB.get(UIN). eventMsg := getBEWNTS(pkt, ofs); // icq.eventFlags notifyListeners(IE_authReq); end; procedure TicqSession.parse1503(snac:string; ref:integer); var ofs:integer; procedure extractWP; var next:integer; begin next:=readWORD(snac, ofs); inc(next,ofs); eventwp.uin := readINT(snac, ofs); eventwp.nick := getWNTS(snac, ofs); eventwp.first := getWNTS(snac, ofs); eventwp.last := getWNTS(snac, ofs); eventwp.email := getWNTS(snac, ofs); eventwp.authRequired:=readBYTE(snac, ofs)=0; eventwp.status := readWORD(snac, ofs); eventWP.gender := readBYTE(snac, ofs); eventWP.age := readWORD(snac, ofs); ofs:=next; // request issued from white pages if wasUINwp or (refs[ref].kind = REF_wp) then begin notifyListeners(IE_wpResult); exit; end; // request issued for internal use eventContact:=contactsDB.get(eventWP.uin); with eventContact do begin nick:=eventwp.nick; first:=eventwp.first; last:=eventwp.last; email:=eventwp.email; notifyListeners(IE_userinfo); end; end; // extractWP var y:word; d,m:byte; msgtype,msgflags:byte; msg:string; i, n : byte; s : String; rf: integer; begin if ABS(ref) > High(refs) then exit; rf:=refs[ref].uin; eventContact:=contactsDB.get(rf); ofs:=11; case ord(snac[ofs]) of $42: notifyListeners(IE_endOfOfflineMsgs); $41: // offline messages begin inc(ofs,4); eventContact:=contactsDB.get(readINT(snac, ofs)); y:=readWORD(snac, ofs); m:=readBYTE(snac, ofs); d:=readBYTE(snac, ofs); eventTime:=EncodeDate(y,m,d); d:=readBYTE(snac, ofs); // hours m:=readBYTE(snac, ofs); eventTime:=eventTime+EncodeTime(d,m,0,0)+GMToffset0; msgtype:=readBYTE(snac, ofs); msgflags:=readBYTE(snac, ofs); msg:=getWNTS(snac, ofs); if msgtype=MTYPE_PLUGIN then parseGCdata(copy(snac,ofs,length(snac)), TRUE) else notificationForMsg(msgtype, msgflags, not dontBotherStatus, msg, TRUE); end; $DA: case ord(snac[ofs+4]) of $9A, $A4: // simple query and wp result begin eventContact.nodb:=FALSE; eventContact.infoUpdatedTo:=now; if ord(snac[ofs+6])=$A then begin inc(ofs,7); extractWP; eventInt:=0; if wasUINwp then notifyListeners(IE_wpEnd); end else if refs[ref].kind = REF_wp then begin eventInt:=-1; notifyListeners(IE_wpEnd); end else begin eventContact.nodb:=TRUE; eventError:=EC_badContact; notifyListeners(IE_error); end; end; $AE: // last wp result begin eventContact.infoUpdatedTo:=now; if ord(snac[ofs+6])=$A then begin inc(ofs,7); extractWP; eventInt:=readINT(snac, ofs); end else eventInt:=-1; if refs[ref].kind = REF_wp then notifyListeners(IE_wpEnd); end; $E6: // query result (about) begin eventContact.infoUpdatedTo:=now; inc(ofs,7); eventContact.about:=getWNTS(snac, ofs); notifyListeners(IE_userinfo); end; $FA: begin eventContact.infoUpdatedTo:=now; if snac[ofs+6]=#$14 then eventContact.nodb:=TRUE; notifyListeners(IE_userinfo); end; $C8: // query result (main, home) begin inc(ofs,7); with eventContact do begin noDB:=FALSE; infoUpdatedTo:=now; nick:=getWNTS(snac, ofs); first:=getWNTS(snac, ofs); last:=getWNTS(snac, ofs); email:=getWNTS(snac, ofs); city:=getWNTS(snac, ofs); state:=getWNTS(snac, ofs); // skip 3 getWNTS(snac, ofs); // home phone getWNTS(snac, ofs); // home fax getWNTS(snac, ofs); // home address cellular:=getWNTS(snac, ofs); SMSable:=pos(' SMS',cellular)>0; if SMSable then delete(cellular,length(cellular)-3,4); zip:=getWNTS(snac, ofs); country:=readWORD(snac, ofs); GMThalfs:=readBYTE(snac, ofs); readBYTE(snac, ofs); // authorization flag readBYTE(snac, ofs); // webaware flag readBYTE(snac, ofs); // direct connection permissions publicEmail:=not boolean(readBYTE(snac, ofs)); end; notifyListeners(IE_userinfo); end; $DC: // query result (homepage/more) begin inc(ofs,7); with eventContact do begin infoUpdatedTo:=now; age:=readWORD(snac, ofs); gender:=readBYTE(snac, ofs); homepage:=getWNTS(snac, ofs); y:=readWORD(snac, ofs); m:=readBYTE(snac, ofs); d:=readBYTE(snac, ofs); if y > 0 then birth:=encodeDate(y,m,d) else birth:=0; lang[1]:=readBYTE(snac, ofs); lang[2]:=readBYTE(snac, ofs); lang[3]:=readBYTE(snac, ofs); end; notifyListeners(IE_userinfo); end; $F0: // Interests begin if ord(snac[ofs+6])=$A then with eventContact do begin inc(ofs,7); infoUpdatedTo:=now; Interests.Count := readBYTE(snac, ofs); // ���-�� ��������� // SetLength(Interests.InterestBlock, Interests.Count); // if Interests.Count > 0 then for i := 0 to 3 do begin Interests.InterestBlock[i].Code := readWORD(snac, ofs); // Interests.InterestBlock[i].Str := getWNTS(snac, ofs) if i < Interests.Count then s := getWNTS(snac, ofs) else s := ''; if (Interests.InterestBlock[i].Names <> NIL) AND Assigned(Interests.InterestBlock[i].Names) then Interests.InterestBlock[i].Names.Clear else Interests.InterestBlock[i].Names:=TStringList.Create; while s<>'' do Interests.InterestBlock[i].Names.Add(chop(',',s)); // Interests.InterestBlock[i].Count:=int.Count+1; end; // Interests[i].code := readWORD(snac, ofs); // Interests[i].Str := getWNTS(snac, ofs); end else eventInt:=-1; end; $B4: notifyListeners(IE_uinDeleted); $AA: if ord(snac[ofs+6])=$A then begin P_pwd:=waitingNewPwd; notifyListeners(IE_pwdChanged); end else begin eventError:=EC_cantchangePwd; notifyListeners(IE_error); end; $64,$78,$82,$87: // acks to save-my-info begin inc(savingMyinfo.ACKcount); if savingMyinfo.ACKcount = 4 then begin savingMyinfo.running:=FALSE; sendStatusCode; // needed(?) for the server to save publicemail notifyListeners(IE_myinfoACK); end; end; end;//case end;//case end; // parse1503 procedure TicqSession.parseNewUIN(snac:string); begin eventContact:=contactsDB.get(dword_LEat(@snac[47])); notifyListeners(IE_newUIN); end; // parseNewUIN var myBeautifulSocketBuffer:string; procedure TicqSession.received(Sender: TObject; Error: Word); var pkt:string; channel,ref:integer; service:TsnacService; begin try pkt:=sock.receiveStr; if (phase in [CONNECTING_,RECONNECTING_]) and http.enabled then begin myBeautifulSocketBuffer:=myBeautifulSocketBuffer+pkt; if pos(CRLFCRLF, myBeautifulSocketBuffer) = 0 then exit; pkt:=chop(CRLFCRLF, myBeautifulSocketBuffer); eventData:=pkt+CRLFCRLF; notifyListeners(IE_serverSent); eventError:=EC_other; if AnsiStartsStr('HTTPS/1.0 200', pkt) or AnsiStartsStr('HTTPS/1.1 200', pkt) or AnsiStartsStr('HTTP/1.0 200', pkt) or AnsiStartsStr('HTTP/1.1 200', pkt) then case phase of CONNECTING_: begin phase:=LOGIN_; notifyListeners(IE_connected); end; RECONNECTING_: begin phase:=RELOGIN_; notifyListeners(IE_redirected); end; end else if ansiStartsStr('HTTP/1.0 407', pkt) then eventError:=EC_proxy_badPwd else begin eventError:=EC_proxy_unk; eventMsg:=pkt; end; // pass what follows to the snac cruncher pkt:=myBeautifulSocketBuffer; myBeautifulSocketBuffer:=''; if eventError <> EC_other then begin notifyListeners(IE_error); disconnect; exit; end; end; Q.add(pkt); if Q.error then begin eventData:=q.popError; eventError:=EC_invalidFlap; notifyListeners(IE_error); disconnect; end; while Q.available do begin pkt:=Q.pop; eventData:=pkt; notifyListeners(IE_serverSent); channel:=getFlapChannel(pkt); if channel = SNAC_CHANNEL then begin service:=getSnacService(pkt); ref:=getSnacRef(pkt); delete(pkt,1,16); // remove header end else begin service:=0; ref:=0; delete(pkt,1,6); // remove header end; case phase of CREATING_UIN_: case channel of LOGIN_CHANNEL: begin sendFLAP(LOGIN_CHANNEL, #0#0#0#1); //sendCreateUIN; send170c; notifyListeners(IE_creatingUIN); notifyListeners(IE_ackImage); end; SNAC_CHANNEL: if service = $170d then begin //ShowMessage('image complete'); parse170d(pkt); notifyListeners(IE_getImage); //disconnect; end else if service = $1705 then begin parseNewUIN(pkt); disconnect; end else begin eventError:=EC_cantCreateUin; notifyListeners(IE_error); end; end; LOGIN_: case channel of LOGIN_CHANNEL: if LoginMD5 then newLogin else if pkt=#0#0#0#1 then sendLogin; SNAC_CHANNEL: case service of $1703: parseCookie(pkt); //SRV_LOGIN_REPLY(pkt); $1707: parseAuthKey(pkt); end; LOGOUT_CHANNEL: parseCookie(pkt); end; RELOGIN_: begin case channel of LOGIN_CHANNEL: if pkt=#0#0#0#1 then sendCookie; SNAC_CHANNEL: if service=$0103 then // server is ready begin // parse0103(pkt); sendImICQ; phase:=SETTINGUP_; end; end; end; SETTINGUP_: case service of $0118: begin // ack to I'm ICQ sendSNAC(1,6, ''); sendSNAC(1,$E, ''); sendSNAC(2,2, ''); sendSNAC(3,2, ''); sendSNAC(4,4, ''); sendSNAC(9,2, ''); notifyListeners(IE_almostonline); end; $0107: sendAckTo107; $010F: parse010F(pkt); $0903: begin serverStart; sendCapabilities; sendIMparameter(#01); sendIMparameter(#02); sendIMparameter(#04); // sendIMparameter(#00); roaster.setStatus(SC_OFFLINE); with roaster do begin resetEnumeration; while hasMore do with getNext do invisible:=FALSE; end; myinfo.proto:=My_proto_ver; // By Rapid D myinfo.status:=startingStatus; myinfo.invisible:=startingInvisible; sendSimpleQueryInfo(myinfo.uin); sendSimpleQueryInfo(uinToUpdate); sendAddContact(roaster); previousInvisible:=not myinfo.invisible; sendStatusCode; sendPermissions; // sendSSIReady; sendClientReady; phase:=ONLINE_; notifyListeners(IE_online); end; end; ONLINE_: if channel <> SNAC_CHANNEL then begin eventError:=EC_serverDisconnected; if existsTLV(9,pkt) then case getTLVwordBE(9, pkt) of 1: eventError:=EC_anotherLogin end; notifyListeners(IE_error); disconnect; end else case service of $010A: notifyListeners(IE_toofast); $010B: notifyListeners(IE_pause); $010F: parse010F(pkt); $0201: parseSRV_LOCATION_ERROR(pkt, ref); $0206: parse0206(pkt); // $0206: debug_Snac(pkt, 'InvisCheckNNN.txt'); $030B: parseOncomingUser(pkt); $030C: parseOffgoingUser(pkt); $0401: parseMsgError(pkt,ref); $0407: parseIncomingMsg(pkt); $040A: parse040A(pkt); // SRV_MISSED_MESSAGE $040B: parse040B(pkt); // auto-messages $040C: parseServerAck(pkt,ref); {$IFDEF RNQ_FULL} $0414: parseTYPING_NOTIFICATION(pkt); {$ENDIF} {$IFDEF RNQ_AVATARS} $1006: parseIcon(pkt); {$ENDIF RNQ_AVATARS} $1306: parse1306(pkt, ref);{SRV_REPLYROSTER} // By Rapid D $1319: parseAuthReq(pkt); $130E: parse130e(pkt);{SRV_REPLYROSTER} // By Rapid D $1503: parse1503(pkt, ref); end; end;//case if Q.error then begin eventData:=q.popError; eventError:=EC_invalidFlap; notifyListeners(IE_error); end; end; except end; eventData:=''; end; // received procedure TicqSession.sendIMparameter(chn : char); var i : byte; begin i := 3; { $IFDEF RNQ_FULL} if SupportTyping then i := i or 8; { $ENDIF} sendSNAC(4,2, #$00 + chn + #$00#$00#$00 + Chr(i) + #$1F#$40+ #$03#$E7+#$03#$E7+Z) end; procedure TicqSession.sendClientReady; begin sendSNAC(1,2, #$00#$01#$00#$04 + #$00#$10#$08#$E4 + // #$00#$10#$00#$01 + #$00#$10#$08#$E4); // #$00#$01#$00#$03 + #$01#$10#$04#$7B + #$00#$13#$00#$02 + #$01#$10#$04#$7B + #$00#$02#$00#$01 + #$01#$01#$04#$7B + #$00#$03#$00#$01 + #$01#$10#$04#$7B + #$00#$15#$00#$01 + #$01#$10#$04#$7B + #$00#$04#$00#$01 + #$01#$10#$04#$7B + #$00#$06#$00#$01 + #$01#$10#$04#$7B + #$00#$09#$00#$01 + #$01#$10#$04#$7B + #$00#$10#$00#$01 + #$01#$10#$08#$E4 + #$00#$0A#$00#$01 + #$01#$10#$04#$7B + #$00#$0B#$00#$01 + #$01#$10#$04#$7B) end; procedure TicqSession.sendCapabilities; var s : String; begin s := CAPS_sm2big(CAPS_sm_ICQSERVERRELAY) + CAPS_sm2big(CAPS_sm_ICQ); if SupportTyping then s := s + BigCapability[CAPS_big_MTN].v; {$IFDEF RNQ_FULL} s:= s+ aXStatus[curXStatus].pid; {$ENDIF} if SupportUTF then s := s + CAPS_sm2big(CAPS_sm_UTF8); {$IFDEF RQDEBUG} s := s + CAPS_sm2big[CAPS_sm_Avatar]; {$ENDIF} sendSNAC(2,4, TLV(5, s+myInfo.extracapabilities) ) end; procedure TicqSession.sendImICQ; //begin sendSNAC(1,$17, #$00#$01#$00#$03#$00#$02#$00#$01#$00#$03#$00#$01#$00#$15#$00#$01#$00#$04#$00#$01#$00#$06#$00#$01#$00#$09#$00#$01#$00#$0A#$00#$01) end; begin sendSNAC(1,$17, #$00#$01#$00#$04+ #$00#$02#$00#$01+ #$00#$03#$00#$01+ #$00#$04#$00#$01+ #$00#$06#$00#$01+ #$00#$09#$00#$01+ #$00#$0B#$00#$01+ #$00#$10#$00#$01+ #$00#$13#$00#$04+ #$00#$15#$00#$01+ #$00#$0A#$00#$01) end; procedure TicqSession.sendCookie; begin sendFLAP(LOGIN_CHANNEL, #0#0#0#1+TLV(6,cookie)); cookie:=''; // free mem end; // sendCookie procedure TicqSession.sendAckTo107; begin sendSNAC(1,8, #$00#$01#$00#$02#$00#$03#$00#$04#$00#$05) end; procedure TicqSession.newLogin; begin sendFLAP( LOGIN_CHANNEL, #0#0#0#1); sendSNAC($17, $06, TLV($01, myinfo.uinAsStr)+TLV($4B, '') + TLV($5A, '')); end; procedure TicqSession.sendLogin; begin sendFLAP( LOGIN_CHANNEL, #0#0#0#1 +TLV(1, myinfo.uinAsStr) +TLV(2, encrypted(pwd)) // By Rapid D +TLV(3, 'ICQ Inc. - Product of ICQ (TM).2003b.5.56.1.3916.85') +TLV($16, word($010A)) +TLV($17, word($0002)) +TLV($18, word($0038)) +TLV($19, word($0001)) +TLV($1A, word($0f4c)) +TLV($14, integer($55)) +TLV($E,'us') +TLV($F,'en') ); notifyListeners(IE_loggin); end; // sendLogin function TicqSession.removeContact(c:Tcontact):boolean; begin result:=roaster.remove(c); if result then begin removeFromVisible(c); sendRemoveContact(c.buin); c.status:=SC_UNK; eventInt:=roaster.count; notifyListeners(IE_numOfContactsChanged); end end; // removeContact procedure TicqSession.setStatus(s:Tstatus; inv:boolean); begin if s = SC_OFFLINE then begin disconnect; exit; end; if (s = myinfo.status) and (inv = myinfo.invisible) then exit; startingStatus:=s; startingInvisible:=inv; if isReady then begin if inv <> myinfo.invisible then clearTemporaryVisible; myinfo.status:=s; myinfo.invisible:=inv; sendStatusCode; eventContact:=myinfo; notifyListeners(IE_statuschanged); end else connect; end; // setStatus function TicqSession.getStatus:Tstatus; begin if myinfo=NIL then result:=SC_UNK else result:=myinfo.status end; procedure TicqSession.addContact(cl:TcontactList); begin if cl=NIL then exit; cl:=cl.clone.remove(roaster); if isReady then cl.setStatus(SC_OFFLINE) else cl.setStatus(SC_UNK); roaster.add(cl); if isReady then sendAddContact(cl); eventInt:=roaster.count; notifyListeners(IE_numOfContactsChanged); cl.free; end; // addContact function TicqSession.addContact(c:Tcontact):boolean; begin result:=FALSE; if c=NIL then exit; result:=roaster.add(c); if result then begin if isReady then begin c.status:=SC_OFFLINE; c.invisible:=FALSE; sendAddContact(c.buin); end; eventInt:=roaster.count; notifyListeners(IE_numOfContactsChanged); end; end; // addContact function TicqSession.readInvisible:TcontactList; begin result:=invisibleList end; function TicqSession.readRoaster:TcontactList; begin result:=roaster end; function TicqSession.readVisible:TcontactList; begin result:=visibleList end; function TicqSession.readTemporaryVisible:TcontactList; begin result:=tempvisibleList end; function TicqSession.add2visible(c:Tcontact):boolean; begin result:=FALSE; if c=NIL then exit; tempVisibleList.remove(c); result:=not visibleList.exists(c); if result then begin removeFromInvisible(c); addContact(c); visibleList.add(c); if isReady and myinfo.invisible then begin sendAddVisible(c.buin); eventContact:=c; notifyListeners(IE_visibilityChanged); end; end; end; // add2visible procedure TicqSession.add2visible(cl:TcontactList); begin if cl=NIL then exit; tempVisibleList.remove(cl); cl:=cl.clone.remove(visibleList); removeFromInvisible(cl); addContact(cl); visibleList.add(cl); if isReady and myinfo.invisible then begin sendAddVisible(cl); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; cl.free; end; // add2visible procedure TicqSession.setVisibleList(cl:TcontactList); var tmp:TcontactList; begin removeFromInvisible(cl); tempVisibleList.remove(cl); tmp:=TcontactList.create; // remove visible-cl tmp.add(visibleList).remove(cl); if not tmp.empty then sendRemoveVisible(tmp); // add cl-visible tmp.clear; tmp.add(cl).remove(visibleList); if not tmp.empty then sendAddVisible(tmp); visibleList.assign(cl); if isReady and myinfo.invisible then begin eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; tmp.free; end; // setVisibleList procedure TicqSession.setInvisibleList(cl:TcontactList); var tmp:TcontactList; begin removeFromVisible(cl); tempVisibleList.remove(cl); tmp:=TcontactList.create; // remove invisible-cl tmp.add(invisibleList).remove(cl); if not tmp.empty then sendRemoveInvisible(tmp); // add cl-invisible // add cl-invisible tmp.clear; tmp.add(cl).remove(invisibleList); if not tmp.empty then sendAddInvisible(tmp); tmp.free; invisibleList.assign(cl); if isReady and not myinfo.invisible then begin eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; end; // setInvisibleList function TicqSession.removeFromVisible(c:Tcontact):boolean; begin result:=FALSE; if c=NIL then exit; removeTemporaryVisible(c); result:=visibleList.remove(c); if result then if isReady and myinfo.invisible then begin sendRemoveVisible(c.buin); eventCOntact:=c; notifyListeners(IE_visibilityChanged); end; end; // removeFromVisible procedure TicqSession.removeFromVisible(cl:tcontactlist); begin if cl=NIL then exit; removeTemporaryVisible(cl); cl:=cl.clone.intersect(visibleList); visibleList.remove(cl); if isReady and myinfo.invisible and not cl.empty then begin sendRemoveVisible(cl); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; cl.free; end; // removeFromVisible function TicqSession.add2invisible(c:Tcontact):boolean; begin result:=FALSE; if c=NIL then exit; removeTemporaryVisible(c); result:=invisibleList.add(c); if result then begin removeFromVisible(c); if isReady and not myinfo.invisible then begin sendAddInvisible(c.buin); eventContact:=c; notifyListeners(IE_visibilityChanged); end; end; end; // add2invisible procedure TicqSession.add2invisible(cl:TcontactList); begin if cl=NIL then exit; removeTemporaryVisible(cl); cl:=cl.clone.remove(invisibleList); invisibleList.add(cl); removeFromVisible(cl); if isReady and not myinfo.invisible then begin sendAddInvisible(cl); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; cl.free; end; // add2invisible function TicqSession.removeFromInvisible(c:Tcontact):boolean; begin result:=FALSE; if c=NIL then exit; removeTemporaryVisible(c); result:=invisibleList.remove(c); if result then if isReady and not myinfo.invisible then begin sendRemoveInvisible(c.buin); eventContact:=c; notifyListeners(IE_visibilityChanged); end; end; // removeFromInvisible procedure TicqSession.removeFromInvisible(cl:TcontactList); begin if cl=NIL then exit; removeTemporaryVisible(cl); cl:=cl.clone.intersect(invisibleList); invisibleList.remove(cl); if isReady and not myinfo.invisible and not cl.empty then begin sendRemoveInvisible(cl); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; cl.free; end; // removeFromInvisible function TicqSession.addTemporaryVisible(c:Tcontact):boolean; begin result:=FALSE; if not isReady then exit; result:=TRUE; tempvisibleList.add(c); if myinfo.invisible then sendAddVisible(c.buin) else sendRemoveInvisible(c.buin); eventContact:=c; notifyListeners(IE_visibilityChanged); end; // addTemporaryVisible function TicqSession.addTemporaryVisible(cl:Tcontactlist):boolean; begin result:=FALSE; if CL=NIL then exit; if not isReady then exit; result:=TRUE; tempvisibleList.add(cl); cl.resetEnumeration(); { cos� non va bene, troppi SNAC inviati. bisogna suddividere CL tra visibleTo e not visibleTo, e inviare solo 2 SNAC. } while cl.hasMore do with cl.getNext() do if myinfo.invisible then sendAddVisible(buin) else sendRemoveInvisible(buin); eventContact:=NIL; notifyListeners(IE_visibilityChanged); cl.free; end; // addTemporaryVisible function TicqSession.removeTemporaryVisible(c:Tcontact):boolean; begin result:=tempvisibleList.remove(c); if not result or not isReady then exit; if myinfo.invisible then sendRemoveVisible(c.buin) else sendAddInvisible(c.buin); eventContact:=c; notifyListeners(IE_visibilityChanged); end; // removeTemporaryVisible function TicqSession.removeTemporaryVisible(cl:TcontactList):boolean; begin result:=TRUE; cl:=cl.clone.intersect(tempVisibleList); if isReady and not cl.empty then begin tempvisibleList.remove(cl); if myinfo.invisible then sendRemoveVisible(cl) else sendAddInvisible(cl); eventContact:=NIL; notifyListeners(IE_visibilityChanged); end; cl.free; end; // removeTemporaryVisible procedure TicqSession.clearTemporaryVisible; begin removeTemporaryVisible(tempVisibleList) end; function TicqSession.useMsgType2for(c:Tcontact):boolean; begin result:=not (c.status in [SC_OFFLINE,SC_UNK]) and not c.invisible and not c.icq2go and (c.proto>=7) and (CAPS_sm_ICQSERVERRELAY in c.capabilitiesSm) end; procedure TicqSession.sendCreateUIN; const s=#3#$46#0#0; unk = #0#0#0#0; cook = #0#0#0#0; begin //sendSNAC($17,4, //#0#1#0#$3B // TLV(1, Z+#$28#0#3#0+Z+Z+s+s+Z+Z+Z+Z+WNTS(pwd)+s+#0#0#$CF#1)); sendSNAC($17,4, word_BEasStr(1)+word_BEasStr(50+length(pwd))+ unk+ #$28#0#0#0+ unk+ unk+ cook+ cook+ unk+ unk+ unk+ unk+ char(length(pwd))+#0+pwd+ cook+ unk+ #0#9+Word_BEasStr(length(acceptKey))+acceptKey); end; // sendCreateUIN function TicqSession.maxCharsFor(c:Tcontact):integer; begin if c.status in [SC_OFFLINE,SC_UNK] then result:=450 else if useMsgType2for(c) then result:=7000 else result:=2540; end; // maxCharsFor function TicqSession.imVisibleTo(c:Tcontact):boolean; begin result:=isOnline and ( tempvisibleList.exists(c) or (not myinfo.invisible and not invisibleList.exists(c)) or (myinfo.invisible and visibleList.exists(c)) ); end; // imVisibleTo function TicqSession.getLocalIPstr:string; begin Result:=sock.GetXaddr; if compareText(result,'error')=0 then result:=''; end; // getLocalIPstr function TicqSession.getLocalIP:integer; begin try result:=WSocketResolveHost(getLocalIPstr).S_addr; except result:=0; end; end; procedure TicqSession.sendACK(status:integer; msg, snac:string); var s,tlv:string; ofs:integer; begin ofs:=11; eventContact:=contactsDB.get(getBUIN(snac,ofs)); if not imVisibleTo(eventContact) then exit; case status of ACK_OCCUPIED, ACK_DND, ACK_AWAY, ACK_NA: begin eventMsg:=msg; notifyListeners(IE_sendingAutomsg); msg:=eventMsg; if eventContact.SendTransl then msg := Translit(msg); end; end; inc(ofs, 4); tlv:=getTLV(5, snac,ofs); tlv:=getTLV($2711, tlv,1+2+8+16); s:=copy(tlv,1,47); // chunk1+chunk2+msgtype+msgflags s[27]:=#0; // zeroes firewall details s:=s+Dword_LEasStr(status)+WNTS(msg); case ord(tlv[46]) of MTYPE_PLAIN: s:=s+ Z+#$FF#$FF#$FF#$FF; MTYPE_PLUGIN: begin ofs:=pos('Greeting Card',tlv)-4-20; s:=s+ copy(tlv, ofs, 4+20+length('Greeting Card')+7) +Z; end; MTYPE_FILEREQ: s:=s+ Z+#$01#$00#$00#$C8#$06#$C9#$00+Z; end; sendSNAC(4,$B, copy(snac, 1, 11+ord(snac[11]))+#0#3+s); end; // sendACK procedure TicqSession.sendACK10(cont : Tcontact; msg:string; msgID : Int64); const ch = '19'; var s:string; // ofs:integer; begin //ofs:=11; //eventContact := cont; if msg = '' then exit; if not imVisibleTo(eventContact) then exit; s := #0#2 +BUIN(cont.uin) + #00#03 + header2711_1+ char(MTYPE_PLUGIN)+#00+ word_LEasStr(getFullStatusCode) +#00#00 +WNTS('') + Length_LE(MsgCapabilities[1] + #$08#$00 + Length_DLE(Plugin_Script) + #$00#$00#$01 + z+z+z) + Length_DLE(Length_DLE( '<NR><RES>&lt;ret event=''OnRemoteNotification''&gt;&lt;srv&gt;'+ '&lt;id&gt;cAwaySrv&lt;/id&gt;&lt;val srv_id=''cAwaySrv''&gt;' + '&lt;Root&gt;&lt;CASXtraSetAwayMessage&gt;' + '&lt;/CASXtraSetAwayMessage&gt;&lt;uin&gt;' + cont.uinAsStr + '&lt;/uin&gt;&lt;index&gt;' + ch + '&lt;/index&gt;' + '&lt;title&gt;' + msg + '&lt;/title&gt;&lt;desc&gt;&lt;/desc&gt;' + '&lt;/Root&gt;..&lt;/val&gt;&lt;/srv&gt;&lt;srv&gt;&lt;id&gt;'+ 'cRandomizerSrv&lt;/id&gt;&lt;val srv_id=''cRandomizerSrv''&gt;' + 'undefined&lt;/val&gt;&lt;/srv&gt;&lt;/ret&gt;</RES></NR>'+CRLF)) ; // sendMSGsnac(cont.uin, s); sendSNAC(ICQ_MSG_FAMILY, $0B, qword_LEasStr(msgID) + s); // +TLV(3,'') // ); end; // sendACK10 procedure TicqSession.setWebaware(value:boolean); begin P_webaware:=value; //sendStatusCode; end; // setWebaware procedure TicqSession.setAuthNeeded(value:boolean); begin P_authNeeded:=value; sendPermissions; end; // setAuthNeeded function TicqSession.addRef(k:TrefKind; uin:integer):integer; begin result:=SNACref; refs[SNACref].kind:=k; refs[SNACref].uin:=uin; inc(SNACref); if SNACref > maxRefs then SNACref:=1; end; // addRef function TicqSession.dontBotherStatus:boolean; begin result:=getStatus in [SC_occupied,SC_dnd] end; procedure TicqSession.parse010F(snac:string); var ofs:integer; begin ofs:=ord(snac[1])+5; if existsTLV(3, snac,ofs) then myinfo.onlineSince:=UnixToDateTime(getTLVdwordBE(3, snac,ofs))+GMToffset else myinfo.onlineSince:=0; if existsTLV(2, snac,ofs) then myinfo.memberSince:=UnixToDateTime(getTLVdwordBE(2, snac,ofs)); end; // parse010F procedure TicqSession.parse0206(snac : String); var uin : Integer; ofs : Integer; ctt : Tcontact; begin eventFlags:=0; eventTime:=now; ofs:=1; eventContact:=contactsDB.get(getBUIN(snac,ofs)); inc(ofs, 4); parseOnlineInfo(snac, Ofs, eventContact, false); // getTLV() end; procedure TicqSession.parse040A(snac:string); var ofs:integer; // accept:byte; MissedType : Word; begin ofs:=1; MissedType := dword_LEat(@snac[ofs]); { eventInt:=dword_LEat(@snac[ofs]); inc(ofs, 10+1+ord(snac[11])+2+47); accept:=ord(snac[ofs]); inc(ofs,4); eventMsg:=getWNTS(snac,ofs); eventContact:=contactsDB.get(refs[eventInt].uin); eventOldStatus:=eventContact.status; eventOldInvisible:=eventContact.invisible;} end; // auto-messages procedure TicqSession.parse040B(snac:string); var ofs, k:integer; accept:byte; uin : String; begin ofs:=1; eventInt:=dword_LEat(@snac[ofs]); uin := Copy(snac, 12, ord(snac[11])); inc(ofs, 10+1+ord(snac[11])+2+47); accept:=ord(snac[ofs]); inc(ofs,4); eventMsg:=getWNTS(snac,ofs); eventContact:=contactsDB.get(refs[eventInt].uin); eventOldStatus:=eventContact.status; eventOldInvisible:=eventContact.invisible; case accept of $0,$C: eventAccept:=AC_ok; $9: begin eventContact.status:=SC_occupied; eventAccept:=AC_denied; end; $A: begin eventContact.status:=SC_dnd; eventAccept:=AC_denied; end; $4: begin eventContact.status:=SC_away; eventAccept:=AC_away; end; $E: begin eventContact.status:=SC_na; eventAccept:=AC_away; end; end; if eventOldStatus<>eventContact.status then eventContact.prevStatus:=eventContact.status; if (eventOldStatus<>eventContact.status) or (eventOldInvisible<>eventContact.invisible) then begin eventFlags:=0; eventTime:=now; notifyListeners(IE_statuschanged); end; case refs[eventInt].kind of REF_file: begin notifyListeners(IE_fileDenied); exit; end; REF_msg, REF_contacts: begin refs[eventInt].kind:=REF_null; notifyListeners(IE_ack); end; end; snac := copy(snac, ofs, length(snac)-ofs); ofs := Pos('title&gt;', snac) + length('title&gt;'); if ofs > 0 then begin k := Pos('&lt;/title', snac); if (k-ofs) > 0 then eventMsg := copy(snac, ofs, k-ofs); eventContact := contactsDB.get(StrToInt(uin)); notifyListeners(IE_ackXStatus); exit; end; // ofs := pos(MsgCapabilities[1], snac); // if ofs > 0 then // begin // ofs := ofs +1+ dword_LEat(@snac[ofs-2]); // end; end; // parse040B {$IFDEF usesDC} function TicqSession.directTo(c:Tcontact):Tdirect; begin result:=directs.newFor(c) end; {$ENDIF usesDC} function TicqSession.serverPort:word; var s : String; p : Integer; begin try // s := server.getxport; if (s <> '') and (TryStrToInt(s, p)) then result:=p else result:=0; except result:=0 end end; function TicqSession.serverStart:word; begin if DCmode = DC_none then begin result:=0; exit; end; //server.port:='0'; //server.addr:='0.0.0.0'; //server.listen; result:=serverPort; end; // serverStart {function TicqSession.getIPasDword_BE:string; var saddr:TSockAddrIn; l:integer; begin l:=sizeOf(saddr); if sock.GetSockName(saddr,l)=0 then with saddr.sin_addr.s_un_b do result:=s_b1+s_b2+s_b3+s_b4 else result:='' end; // getIPasDword_BE } procedure TicqSession.connect; begin connect(FALSE) end; procedure TicqSession.connect(createUIN:boolean); begin if not isOffline then exit; if (pwd = '') or not createUIN and (myInfo=NIL) then begin eventError:=EC_missingLogin; notifyListeners(IE_error); exit; end; creatingUIN:=createUIN; sock.proto:='tcp'; if http.enabled then begin sock.Addr:=http.addr; sock.Port:=http.port; end else begin sock.addr:=loginServerAddr; sock.port:=loginServerPort; end; phase:=CONNECTING_; notifyListeners(IE_connecting); try sock.Connect except eventError:=EC_cantconnect; eventInt:=WSocket_WSAGetLastError; notifyListeners(IE_error); goneOffline; end; end; // connect procedure TicqSession.setDCmode(v:TicqDCmode); begin P_dcmode:=v; serverStart; //sendStatusCode; end; // setDCmode function Ticqsession.getFullStatusCode:dword; begin result:=0; case DCmode of DC_roaster: inc(result, flag_dcForRoaster); DC_uponauth, DC_none : inc(result, flag_dcByRequest); // DC_none: inc(result, flag_dcForNone); end; if webaware then inc(result, flag_webaware); if birthdayFlag then inc(result, flag_birthday); if myinfo.invisible then inc(result, flag_invisible); inc(result, status2code[myinfo.status]); end; // getFullStatusCode function Ticqsession.getDCModeStr : String; begin case DCmode of DC_NONE : result := '0'; DC_UPONAUTH : result := '1'; DC_ROASTER : result := '2'; DC_EVERYONE : result := '3'; end; end; function TicqSession.CheckInvisibility( uin : dword ) : Integer; //var // id : integer; begin { sendSNAC(4,6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) + word_BEasStr(5)+word_BEasStr($60) // +TLV(5, #0#0+//qword_LEasStr(SNACref)//+capability[1] + #0#0 + qword_LEasStr(0) + z+z+Chr(Random(200))+#0+Chr(Random(200))+#0+z // + #0#0 + qword_LEasStr(0) + z+z+z+z +TLV($A,#0#1) +TLV($F,'') // +TLV($2711, + word_BEasStr($2711)+word_BEasStr($38)+ header2711_2+//char(MTYPE_PLAIN)+flagChar+ #$E8 + #03+ word_LEasStr(getFullStatusCode)// +priorityChar+#0 +#00+#$21 +#3+#0 + #0 + #01 + #00 +#00 +#06 +#00+#00 // +WNTS('') // +dword_LEasStr(0)+dword_LEasStr($FFFFFF) // ) // ) ); sendSNAC(2,$15, //qword_LEasStr(SNACref) + #0#0#0#5 +BUIN(uin) ); sendSNAC(4,6, qword_LEasStr(SNACref)+#0#2 +BUIN(uin) +TLV(6, '') ); } sendSnac($02, $05, word_BEasStr(04)+ BUIN(uin)); // sendSnac($02, $05, word_LEasStr(05)+ BUIN(uin)); result := addRef(REF_msg,uin); // acks.add(OE_msg, uin, 0, 'Inv').ID := id; // result := 0; end; procedure TicqSession.SendTYPING(uin : Integer; notif_type : Word); begin if not isOnline then exit; sendSNAC($04, $14, qword_LEasStr(0) + #00#01 + BUIN(uin) + word_BEasStr(notif_type)) end; procedure TicqSession.RemoveMeFromHisCL(uin : Integer); begin sendSNAC($13, $16, BUIN(uin)); end; procedure TicqSession.AuthGrant(uin : Integer); begin sendSNAC($13, $14, BUIN(uin) + Length_BE('Hi') + #00#00); end; {$IFDEF RNQ_FULL} procedure TicqSession.parseTYPING_NOTIFICATION(pkt : String); var ofs : Integer; begin try ofs := 1; eventMsgID := readQWORD(pkt, ofs); readWORD(pkt, ofs); eventContact := contactsDB.get(getBUIN(pkt,ofs)); eventInt := readBEWORD(pkt, ofs); case eventInt of MTN_FINISHED, MTN_TYPED : eventContact.typing.bIsTyping := false; MTN_BEGUN : eventContact.typing.bIsTyping := True; end; redrawUIN(eventContact.uin); notifyListeners(IE_typing); except end; end; {$ENDIF} procedure TicqSession.parse170d(snac: string); const JPEG_HDR = #$FF#$D8#$FF#$E0; var tmpStr: string; begin tmpStr:= Copy(snac, pos(JPEG_HDR, snac), length(snac)); imageStream:= TMemoryStream.Create; imageStream.Clear; imageStream.Write(tmpStr[1], Length(tmpStr)); imageStream.Seek(0,0); //saveFile('img.jpg', tmpStr); tmpStr:= ''; snac:=''; end; procedure TicqSession.send170C; begin sendSNAC($17, $0c, #00#00); end; {$IFDEF RNQ_AVATARS} procedure TicqSession.RequestIcon(uin : Integer; hash : String); begin sendSNAC($10, $06, BUIN(uin) + #01 + #00#01+#01+#$10 + hash); end; procedure TicqSession.parseIcon(pkt: string); const JPEG_HDR = #$FF#$D8#$FF#$E0; var tmpStr: string; ofs : Integer; i : Integer; begin ofs := 1; eventContact := contactsDB.get(getBUIN(pkt,ofs)); readWORD(pkt, ofs); readByte(pkt, ofs); i:=byte(pkt[ofs]); // result:=copy(s,ofs+2,i-1); inc(ofs, 1+i); inc(ofs, 21); tmpStr :=getWNTS(pkt, ofs); // tmpStr:= Copy(snac, pos(JPEG_HDR, snac), length(snac)); imageStream:= TMemoryStream.Create; imageStream.Clear; imageStream.Write(tmpStr[1], Length(tmpStr)); imageStream.Seek(0,0); // eventContact.icon := TJpegImage.Create; // eventContact.icon.LoadFromStream(imageStream); imageStream.Clear; imageStream.free; //saveFile('img.jpg', tmpStr); tmpStr:= ''; end; {$ENDIF RNQ_AVATARS} procedure TicqSession.sendSSIReady; begin sendSNAC($13, $07, ''); end; procedure TICQSession.SSIstart(); begin // sendFLAP(SNAC_CHANNEL, SNAC($13, $11, 0, $00000011)); sendSNAC($13, $11, '') end; procedure TICQSession.SSIstop(); begin // sendFLAP(SNAC_CHANNEL, SNAC($13, $12, 0, $00000012)); sendSNAC($13, $12, '') end; procedure TICQSession.SSInewGroup(gID:integer; gName:string; iID : integer = 0); begin //showmessage(inttostr(gid)); // sendSNAC($13,$8, Length_BE(gName)+word_LEasStr(gID)+#$00#$00+ // #$00#$01#$00#$00); sendFLAP(SNAC_CHANNEL, SNAC($13, $8, $9, $00000003)+Length_BE(gName)+word_LEasStr(gID)+ word_LEasStr(iID)+ word_LEasStr(BUDDY_GROUP)+ #$00#$00); end; procedure TICQSession.SSInewContact(gID,cID:integer; nUIN,cName:string); var asd:integer; begin //sendSNAC($13,$8, Length_BE(nUIN)+word_LEasStr(gID)+ // word_LEasStr(random(65025))+#$00#$00+ // Length_BE(TLV($0131, cName)+TLV($0066,''))); //asd:=random(65025); sendFLAP(SNAC_CHANNEL, SNAC($13, $8, $9, $00000003)+Length_BE(nUIN)+word_LEasStr(gID)+ word_LEasStr(cID)+#$00#$00+ Length_BE(TLV($0131, cName))); end; procedure TICQSession.SSInewContactauth (gID,cID:integer; nUIN,cName:string); var asd:integer; begin //sendSNAC($13,$8, Length_BE(nUIN)+word_LEasStr(gID)+ // word_LEasStr(random(65025))+#$00#$00+ // Length_BE(TLV($0131, cName)+TLV($0066,''))); //asd:=random(65025); sendFLAP(SNAC_CHANNEL, SNAC($13, $8, $9, $00000003)+Length_BE(nUIN)+word_LEasStr(gID)+ word_LEasStr(cID)+#$00#$00+ Length_BE(TLV($0131, cName)+TLV($0066,''))); end; procedure TICQSession.SSIdeleteContact(gID,cID:integer; nUIN,cName:string); var asd:integer; begin //sendSNAC($13,$8, Length_BE(nUIN)+word_LEasStr(gID)+ // word_LEasStr(random(65025))+#$00#$00+ // Length_BE(TLV($0131, cName)+TLV($0066,''))); //asd:=random(65025); sendFLAP(SNAC_CHANNEL, SNAC($13, $0a, $9, $00000003)+Length_BE(nUIN)+word_LEasStr(gID)+ word_LEasStr(cID)+#$00#$00+ Length_BE(TLV($0131, cName))); end; procedure TICQSession.SSIdeleteGroup(gID:integer; gName:string); begin //showmessage(inttostr(gid)); // sendSNAC($13,$8, Length_BE(gName)+word_LEasStr(gID)+#$00#$00+ // #$00#$01#$00#$00); sendFLAP(SNAC_CHANNEL, SNAC($13, $0a, $9, $00000003)+Length_BE(gName)+word_LEasStr(gID)+#$00#$00+ #$00#$01#$00#$00); end; procedure TICQSession.RequestXStatus(uin : Integer); const i = 2; var s : String; begin s := BUIN(uin) +TLV(5, #0#0+qword_LEasStr(SNACref)+ CAPS_sm2big(CAPS_sm_ICQSERVERRELAY) +TLV($A,#0#1) +TLV($F,'') +TLV($2711, header2711+char(MTYPE_PLUGIN)+#00+ word_LEasStr(getFullStatusCode) +#01+#0 +WNTS('') + Length_LE(MsgCapabilities[1] + #$08#$00 + Length_DLE(Plugin_Script) + #$00#$00#$01 + z+z+z) + Length_DLE(Length_DLE( '<N><QUERY>&lt;Q&gt;&lt;PluginID&gt;srvMng&lt;/PluginID&gt;&lt;/Q&gt;'+ '</QUERY><NOTIFY>&lt;srv&gt;&lt;id&gt;cAwaySrv&lt;/id&gt;'+ '&lt;req&gt;&lt;id&gt;AwayStat&lt;/id&gt;&lt;trans&gt;' + SysUtils.IntToStr(i)+ '&lt;/trans&gt;&lt;senderId&gt;' + myInfo.uinAsStr + '&lt;/senderId&gt;&lt;/req&gt;&lt;/srv&gt;</NOTIFY></N>'+CRLF)) ) ); sendSNAC(ICQ_MSG_FAMILY, 6, qword_LEasStr(SNACref)+#0#2 + s // +TLV(3,'') ); end; { procedure TicqSession.getAvatar(UIN:integer); begin if not isOffline then exit; if (pwd = '') or not createUIN and (myInfo=NIL) then begin eventError:=EC_missingLogin; notifyListeners(IE_error); exit; end; creatingUIN:=createUIN; sock.proto:='tcp'; if http.enabled then begin sock.Addr:=http.addr; sock.Port:=http.port; end else begin sock.addr:=loginServerAddr; sock.port:=loginServerPort; end; phase:=CONNECTING_; notifyListeners(IE_connecting); try sock.Connect except eventError:=EC_cantconnect; eventInt:=WSocket_WSAGetLastError; notifyListeners(IE_error); goneOffline; end; end; // connect } {var TZinfo:TTimeZoneInformation;} INITIALIZATION contactsDB:=TcontactList.create; {GetTimeZoneInformation(TZinfo); case GetTimeZoneInformation(TZInfo) of TIME_ZONE_ID_STANDARD: GMToffset:=TZInfo.StandardBias; TIME_ZONE_ID_DAYLIGHT: GMToffset:=TZInfo.DaylightBias; else GMToffset := 0; end; GMToffset:=-(TZinfo.bias+GMToffset)/(24*60); GMToffset0 :=-(TZinfo.bias)/(24*60);} FINALIZATION contactsDB.free; end.