Маленькая аська :) https://rnq.ru
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

5034 lines
149 KiB

{
This file is part of R&Q.
Under same license
}
unit utilLib;
{$I RnQConfig.inc}
{$I NoRTTI.inc}
{$IFDEF RNQ_FULL}
// {$ELSE}
// {$UNDEF CHECK_INVIS}
{$ENDIF}
interface
uses
windows, sysutils, graphics, classes, extctrls,
forms, stdctrls, controls, menus,
comctrls, messages, types,
VirtualTrees,
strutils,
// GDIPAPI, GDIPOBJ,
outboxLib,
RnQNet, RnQProtocol, RDGlobal,
roasterLib,
RnQZip,
globalLib, events, ICQConsts,
dateutils, ActiveX, Vcl.Imaging.PNGImage, Vcl.Imaging.GIFImg;
type
TPageControl = class(comctrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TImageEx = class(TImage)
public
ImageStream: TMemoryStream;
destructor Destroy; override;
end;
function OnlFeature(const pr: TRnQProtocol; check: Boolean = True): Boolean;
// True if online
procedure processOevent(oe: Toevent);
function getShiftState(): integer;
function exitFromAutoaway(): Boolean;
procedure addTempVisibleFor(time: integer; c: TRnQContact);
function infoToStatus(const info: RawByteString): byte;
function infoToXStatus(const info: RawByteString): byte;
procedure drawHint(cnv: Tcanvas; kind: integer; groupid: integer; c: TRnQContact; var r: Trect; calcOnly: Boolean = False);
// procedure drawNodeHint(cnv:Tcanvas; node:Pvirtualnode; var r:Trect);
function unexistant(const uin: TUID): Boolean;
function fileIncomePath(cnt: TRnQContact): String;
function isAbort(const pluginReply: AnsiString): Boolean;
function findInAvailableUsers(const uin: TUID): integer;
procedure setupChatButtons;
procedure reloadCurrentLang();
{
procedure assignImgIco(img:Timage; ico:Ticon);
procedure assignImgBmp(img:Timage; bmp:Tbitmap);
}
// procedure assignImgPic(img:Timage; picName : String);
function showUsers(var pass: String): TUID;
function CheckAccPas(const uid: TUID; const db: String; var pPass: String): Boolean;
procedure clearAvailableUsers;
procedure refreshAvailableUsers;
function getLeadingInMsg(const s: string; ofs: integer = 1): string;
procedure applyCommonSettings(c: Tcomponent);
procedure applyUserCharset(f: Tfont);
{$IFDEF Use_Baloons}
procedure ShowBalloonEv(ev: Thevent);
{$ENDIF Use_Baloons}
function addToNIL(c: TRnQContact; isBulk: Boolean = False): Boolean;
procedure NILifNIL(c: TRnQContact; isBulk: Boolean = False);
function setRosterAnimation(v: Boolean): Boolean;
// function eventName(ev:integer):string;
function behactionName(a: Tbehaction): string;
// function sendMCIcommand(cmd:PChar):string;
function doLock: Boolean;
// function loadNewOrOldVersionContactList(fn:string; altpath:string=''):string;
procedure trayAction;
function chopAndRealizeEvent: Boolean;
procedure realizeEvents(const kind_: integer; c: TRnQContact);
procedure realizeEvent(ev: Thevent);
procedure removeSWhotkeys;
function updateSWhotkeys: Boolean;
procedure hideTaskButtonIfUhave2;
function behave(ev: Thevent; kind: integer = -1 { ; const info: Ansistring='' } ): Boolean;
procedure startTimer;
procedure stopMainTimer;
procedure contactCreation(c: TRnQContact);
procedure contactDestroying(c: TRnQContact);
procedure clearDB(db: TRnQCList);
procedure freeDB(var db: TRnQCList);
function isSpam(var wrd: String; c: TRnQContact; msg: string = ''; flags: dword = 0): Boolean;
function filterRefuse(c: TRnQContact; const msg: string = ''; flags: dword = 0; ev: Thevent = NIL): Boolean;
function rosterImgNameFor(c: TRnQContact): TPicName;
procedure setAppBarSize;
procedure check4update;
function CheckUpdates(cnt: TRnQContact): Boolean;
function setAutomsg(const s: string): string;
function applyVars(c: TRnQContact; const s: String; fromAM: Boolean = False): String;
function getAutomsgFor(c: TRnQContact): string;
function getXStatusMsgFor(c: TRnQContact): string;
procedure toggleOnlyOnline;
procedure toggleOnlyImVisibleTo;
procedure openURL(const pURL: String); OverLoad;
procedure openICQURL(const pURL: String);
function enterPwdDlg(var pwd: String; const title: string = ''; maxLength: integer = 0; AllowNull: Boolean = False): Boolean;
function enterUinDlg(const proto: TRnQProtocol; var uin: TUID; const title: string = ''): Boolean;
function sendProtoMsg(var oe: Toevent): Boolean;
procedure SendEmail2Mail(const email: String);
function childParent(child, parent: integer): Boolean;
// procedure redrawUIN(uin:TUID);
procedure myBeep;
function findViewInfo(c: TRnQContact): TRnQViewInfoForm;
procedure sortCL(cl: TRnQCList);
procedure sortCLbyGroups(cl: TRnQCList);
procedure updateViewInfo(c: TRnQContact);
{$IFDEF RNQ_FULL2}
procedure convertHistoriesDlg(oldPwd, newPwd: string);
{$ENDIF}
procedure openSendContacts(dest: TRnQContact);
function isEmailAddress(const s: string; start: integer): integer;
procedure notAvailable;
// strings
// function TLV(code:integer; data:string):string;
function mb(q: extended): string;
procedure onlyDigits(obj: Tobject); overload;
// icq communication
procedure addToIgnorelist(c: TRnQContact; const Local_only: Boolean = False);
procedure removeFromIgnorelist(c: TRnQContact);
procedure removeFromRoster(c: TRnQContact; const withHistory: Boolean = False);
function addToRoster(c: TRnQContact; group: integer; const isLocal: Boolean = True): Boolean; overload;
function doConnect: Boolean;
procedure connect_after_dns(const proto: TRnQProtocol);
// convert
function ints2cl(a: TintegerDynArray): TRnQCList;
function event2imgName(e: integer): TPicName;
function statusDrawExt(const DC: HDC; const x, y: integer; const s: byte; const inv: Boolean = False;
const ExtSts: byte = 0): TSize;
// function statusDraw(cnv:Tcanvas; x,y:integer; s:Tstatus; inv:boolean=FALSE) : TSize;
function beh2str(kind: integer): RawByteString;
procedure str2beh(const b, s: RawByteString); overload;
function str2beh(s: AnsiString): Tbehaviour; overload;
function str2status(const s: AnsiString): byte;
function str2visibility(const s: AnsiString): Tvisibility;
function str2html(const s: string): string;
function strFromHTML(const s: string): string;
function db2strU(db: TRnQCList): RawByteString;
// window management
procedure toggleMainfrmBorder(setBrdr: Boolean = False; IsBrdr: Boolean = True);
procedure applySnap();
procedure mainfrmHandleUpdate;
procedure dockSet(var r: Trect); overload;
procedure dockSet; overload;
procedure fixWindowPos(frm: Tform);
procedure showAuthreq(c: TRnQContact; msg: string);
procedure showSplash;
function viewTextWindow(title, body: string; image: RawByteString): Tform;
function viewHeventWindow(ev: Thevent): Tform;
procedure hideForm(frm: Tform);
procedure showForm(whatForm: TwhatForm; const Page: String = ''; Mode: TfrmViewMode = vmFull); overload;
function PrefIsVisiblePage(pf: String): Boolean;
procedure restoreForeWindow;
procedure applyTransparency(forced: integer = -1);
procedure applyDocking(Undock: Boolean = False);
function whatStatusPanel(statusbar: Tstatusbar; x: integer): integer;
// graphic
procedure wallpaperize(canvas: Tcanvas); overload;
procedure wallpaperize(DC: THandle; r: Trect); inline; overload;
// file management
function delSUBtree(subPath: string): Boolean;
function deltree(path: string): Boolean;
function deleteFromTo(fn: string; from, to_: integer): Boolean;
function saveAllLists(const uPath: String; const pr: TRnQProtocol; pProxys: Tarrproxy): Boolean;
function loadDB(zp: TZipFile; pCheckGroups: Boolean): Boolean;
// procedure saveDB;
// procedure saveLists(pr : TRnQProtocol);
procedure loadLists(const pr: TRnQProtocol; zp: TZipFile; const uPath: String);
procedure LoadExtSts(zp: TZipFile);
// procedure SaveExtSts;
procedure loadSpamQuests(zp: TZipFile);
// procedure SaveSpamQuests;
procedure LoadProxies(zp: TZipFile; var pProxys: Tarrproxy);
// procedure SaveProxies(pProxys : Tarrproxy);
// procedure saveInbox;
// procedure loadInbox(zp : TZipFile);
// procedure saveOutbox;
procedure loadOutInBox(zp: TZipFile);
// procedure saveRetrieveQ;
function openSaveDlg(parent: Tform; const Cptn: String; IsOpen: Boolean; const ext: string = ''; const extCptn: String = '';
const defFile: String = ''; MultiSelect: Boolean = False): string;
function str2sortby(const s: AnsiString): TsortBy;
procedure CheckBDays;
function GetWidth(chk: TCheckBox): integer;
function StringFromFile(const FileName: TFileName): RawByteString;
procedure parseMsgImages(imgStr: RawByteString; var imgList: TStringList);
// costants for files
const
DBFK_OLDUIN = 00;
DBFK_NICK = 01;
DBFK_FIRST = 02;
DBFK_LAST = 03;
DBFK_EMAIL = 04;
DBFK_CITY = 05;
DBFK_STATE = 06;
DBFK_ABOUT = 07;
DBFK_DISPLAY = 08;
DBFK_QUERY = 09;
DBFK_ZIP = 10;
DBFK_COUNTRY = 11;
DBFK_BIRTH = 12;
DBFK_LANG = 13;
DBFK_HOMEPAGE = 14;
DBFK_CELLULAR = 15;
DBFK_IP = 16;
DBFK_AGE = 17;
DBFK_GMT = 18;
DBFK_GENDER = 19;
DBFK_GROUP = 20;
DBFK_LASTUPDATE = 21;
DBFK_LASTONLINE = 22;
// DBFK_LASTMSG = 23; DON'T USE, it was badly updated
DBFK_LASTMSG = 24;
DBFK_NOTES = 25;
DBFK_DONTDELETE = 26;
DBFK_ASKEDAUTH = 27;
DBFK_MEMBERSINCE = 28;
DBFK_ONLINESINCE = 29;
DBFK_SMSABLE = 30;
DBFK_NODB = 31;
DBFK_SENDTRANSL = 32;
DBFK_INTERESTS = 33;
DBFK_WORKPAGE = 34;
DBFK_WORKSTNT = 35; // ���������
DBFK_WORKDEPT = 36; // �����������
DBFK_WORKCOMPANY = 37; // ��������
DBFK_WORKCOUNTRY = 38;
DBFK_WORKZIP = 39;
DBFK_WORKADDRESS = 40;
DBFK_WORKPHONE = 41;
DBFK_WORKSTATE = 42;
DBFK_WORKCITY = 43;
DBFK_UID = 111;
DBFK_BIRTHL = 112;
DBFK_SSIID = 113;
DBFK_Authorized = 114;
DBFK_ssNoteStr = 115;
DBFK_ICONSHOW = 116;
DBFK_ICONMD5 = 117;
DBFK_ssMail = 118;
DBFK_ssCell = 119;
DBFK_MARSTATUS = 120;
DBFK_lclNoteStr = 121;
DBFK_ZODIAC = 122;
DBFK_qippwd = 123;
DBFK_LASTBDINFORM = 124;
DBFK_LASTINFOCHG = 125;
DBFK_ADDRESS = 126;
DBFK_BIRTHCOUNTRY = 127;
DBFK_BIRTHSTATE = 128;
DBFK_BIRTHCITY = 129;
DBFK_REGULAR = 130;
DBFK_ssCell2 = 131;
DBFK_ssCell3 = 132;
implementation
uses
ShlObj, shellapi,
Themes, DwmApi, math, UITypes,
{$IFDEF UNICODE}
AnsiStrings,
Character,
{$ELSE nonUNICODE}
// Enable russian codepage by default
RusClipboard in 'RusClipboard.pas',
{$ENDIF UNICODE}
// {$IFDEF EUREKALOG}
// ExceptionLog7, ECore, ETypes,
// {$ENDIF EUREKALOG}
Base64,
OverbyteIcsWSocket,
OverbyteIcsMD5,
RQUtil, RDFileUtil, RDUtils, RnQSysUtils,
RQMenuItem, RQThemes, RQLog, RnQDialogs,
RnQLangs, RnQButtons, RnQBinUtils, RnQGlobal, RnQCrypt, RnQPics,
RDtrayLib, RnQTips,
{$IFDEF RNQ_FULL}
{$ENDIF RNQ_FULL}
{$IFDEF RNQ_FULL2}
convertHistoriesDlg,
{$ENDIF}
// ���� ������ ����� ��� ���� ��������!!!
// {$IFNDEF RNQ_LITE}
prefDlg, RnQPrefsLib,
// ignore_fr,
design_fr,
// {$ENDIF RNQ_LITE}
{$IFDEF RNQ_PLAYER}
uSimplePlayer,
{$ENDIF RNQ_PLAYER}
mainDlg, iniLib, pluginutil,
chatDlg, selectContactsDlg, incapsulate,
pluginLib, authreqDlg,
lockDlg, langLib, groupsLib, outboxDlg, pwdDlg, // msgsDlg,
history,
addContactDlg, wpDlg, RnQMacros,
usersDlg, visibilityDlg,
changepwdDlg, ThemesLib, RnQStrings,
Protocols_all,
{$IFDEF PROTOCOL_MRA}
MRAv1, MRAcontacts,
wpMRADlg,
{$ENDIF PROTOCOL_MRA}
RQ_ICQ, ICQv9, ICQContacts,
icq_fr,
Protocol_ICQ, // ICQClients,
{$IFDEF USE_GDIPLUS}
RnQGraphics,
{$ELSE}
RnQGraphics32,
{$ENDIF USE_GDIPLUS}
// AsyncCalls,
menusUnit, HistAllSearch, NetEncoding, cHash;
function str2sortby(const s: AnsiString): TsortBy;
begin
result := low(TsortBy);
while result <= high(TsortBy) do
if s = sortby2str[result] then
exit
else
inc(result);
result := SB_EVENT;
end; // str2sortby
// procedure openURL(url: AnsiString);
procedure openURL(const pURL: String);
begin
RnQSysUtils.openURL(pURL, useDefaultBrowser, browserCmdLine);
end; // openURL
procedure openICQURL(const pURL: String);
var
hash, query, baseUrl, redirectUrl, unixTime, devId, sToken: String;
url, hashStr, sSecret: RawByteString;
session: TSessionParams;
digest: T256BitDigest;
icq: TICQSession;
begin
icq := TICQSession(Account.AccProto.getContact(Account.AccProto.ProtoElem.MyAccNum).fProto);
session := icq.getSession;
if (icq.getPwdOnly = '') or (session.secret = '') or (session.token = '') then
begin
openURL(pURL);
exit;
end;
baseUrl := 'http://www.icq.com/karma_api/karma_client2web_login.php';
sToken := TNetEncoding.url.Encode(session.token);
digest := CalcHMAC_SHA256(StrToUTF8(icq.getPwdOnly), StrToUTF8(session.secret));
sSecret := Base64EncodeString(SHA256DigestToStrA(digest));
devId := 'ic1nmMjqg7Yu-0hL';
redirectUrl := TNetEncoding.url.Encode(pURL);
unixTime := IntToStr(DateTimeToUnix(Now, False));
query := 'a=' + sToken + '&d=' + redirectUrl + '&k=' + devId + '&owner=' + Account.AccProto.ProtoElem.MyAccNum + '&ts='
+ unixTime;
hash := 'GET&' + TNetEncoding.url.Encode(baseUrl) + '&' + TNetEncoding.url.Encode(query);
digest := CalcHMAC_SHA256(sSecret, StrToUTF8(hash));
hashStr := Base64EncodeString(SHA256DigestToStrA(digest));
url := StrToUTF8(baseUrl + '?' + query + '&sig_sha256=' + TNetEncoding.url.Encode(hashStr));
openURL(url);
end;
procedure onlyDigits(obj: Tobject);
var
i: integer;
begin
if obj is Tcustomedit then
with (obj as Tcustomedit) do
begin
i := selstart;
text := onlyDigits(text);
if i > length(text) then
i := length(text);
selstart := i;
end;
end; // onlyDigits
procedure loadLists(const pr: TRnQProtocol; zp: TZipFile; const uPath: String);
var
zipLists: Boolean;
function LoadZorF(const fn: String): RawByteString;
var
i: integer;
begin
if zipLists then
begin
i := zp.IndexOf(fn);
if i >= 0 then
result := zp.data[i]
else
result := '';
end
else
// s := loadNewOrOldVersionContactList(visibleFileName1);
result := loadFileA(uPath + fn);
end;
var
s: RawByteString;
i: integer;
begin
// backward compatibility
renamefile(uPath + 'uin.list', uPath + uinlistFilename);
i := -1;
zipLists := False;
if Assigned(zp) then
try
i := zp.IndexOf(rosterFileName1);
if i >= 0 then
s := zp.data[i];
except
i := -1;
s := '';
end;
if i >= 0 then
begin
zipLists := True;
end
else
// s := loadNewOrOldVersionContactList(rosterFileName1);
s := loadFileA(uPath + rosterFileName1);
pr.readList(LT_ROSTER).fromString(pr, s, contactsDB);
{ if zipLists then
begin
i := zp.IndexOf(visibleFileName1);
if i >= 0 then
s := zp.Uncompressed[i];
end
else
// s := loadNewOrOldVersionContactList(visibleFileName1);
s := loadFile(uPath + visibleFileName1);
pr.readList(LT_VISIBLE).fromString(pr.getContactClass, s, contactsDB );
}
pr.readList(LT_VISIBLE).fromString(pr, LoadZorF(visibleFileName1), contactsDB);
pr.readList(LT_INVISIBLE).fromString(pr, LoadZorF(invisibleFileName1), contactsDB);
notInlist.fromString(pr, LoadZorF(nilFilename1), contactsDB);
notInlist.remove(pr.readList(LT_ROSTER));
ignoreList.fromString(pr, LoadZorF(ignoreFilename1), contactsDB);
uinlists.fromString(pr, LoadZorF(uinlistFilename));
{$IFDEF CHECK_INVIS}
CheckInvis.CList.fromString(pr, LoadZorF(CheckInvisFileName1), contactsDB);
{$ENDIF}
retrieveQ.fromString(pr, LoadZorF(retrieveFileName1), contactsDB);
end; // loadLists
(* procedure saveLists(pr : TRnQProtocol);
begin
if not saveFile(userPath+rosterFileName+'.txt', pr.readList(LT_ROSTER).toString, True) then msgDlg(getTranslation('Error saving contact list'),mtError);
if not saveFile(userPath+visibleFileName+'.txt', pr.readList(LT_VISIBLE).toString, True) then msgDlg(getTranslation('Error saving visible list'),mtError);
if not saveFile(userPath+invisibleFileName+'.txt', pr.readList(LT_INVISIBLE).toString, True) then msgDlg(getTranslation('Error saving invisible list'),mtError);
if not saveFile(userPath+ignoreFileName+'.txt', ignorelist.toString, True) then msgDlg(getTranslation('Error saving ignore list'),mtError);
if NILdoWith = 2 then
if not saveFile(userPath+nilFileName+'.txt', notinlist.toString, True) then msgDlg(getTranslation('Error saving not-in-list'),mtError);
if not saveFile(userPath+uinlistFilename, uinlists.toString, True) then msgDlg(getTranslation('Error saving uinlists'), mtError);
{$IFDEF CHECK_INVIS}
if not saveFile(userPath+CheckInvisFileName+'.txt', CheckInvis.CList.toString, True) then msgDlg(getTranslation('Error saving Check-invisibility list'),mtError);
{$ENDIF}
end; // saveLists
*)
procedure LoadExtSts(zp: TZipFile);
var
k, line, s: RawByteString;
i: integer;
begin
// clear;
// s := loadFile(userPath + extstatusesFilename);
s := loadFromZipOrFile(zp, Account.ProtoPath, extstatusesFilename);
i := 0;
while s > '' do
begin
line := chopLine(s);
k := chop(AnsiString('='), line);
k := trim(k);
line := trim(line);
if isOnlyDigits(k) then
try
i := strToInt(k);
if i < length(ExtStsStrings) then
begin
ExtStsStrings[i].Cap := '';
ExtStsStrings[i].Desc := '';
end;
except
i := -1;
// setlength(a,length(a)-1);
end
else
// if (i >= Low(XStatus6))and(i <= High(XStatus6)) then
if (i >= Low(ExtStsStrings)) and (i <= High(ExtStsStrings)) then
if k = 'caption' then
try
ExtStsStrings[i].Cap := UnUTF(Copy(line, 1, MaxXStatusLen));
except
end
else if k = 'desc' then
try
ExtStsStrings[i].Desc := UnUTF(StringReplace(Copy(line, 1, MaxXStatusDescLen), AnsiString('\n'), CRLF,
[rfReplaceAll]));
except
end;
end;
end;
{ procedure SaveExtSts;
var
i:integer;
f : string;
begin
f:='';
// for I := low(XStatus6) to High(XStatus6) do
for I := low(ExtStsStrings) to High(ExtStsStrings) do
begin
f := f+format('%d=%s'//+CRLF+'caption=%s'
+CRLF+'desc=%s', [
i, XStatusArray[i].Caption, newline2slashn(ExtStsStrings[i])]);
// f := f+format(CRLF+'ssi=%d', [a[i].ssiID]);
f:=f+CRLF;
end;
saveFile(userPath + extstatusesFilename, f);
end;
}
procedure loadSpamQuests(zp: TZipFile);
var
k, line, s: RawByteString;
i, j: integer;
begin
// clear;
s := loadFromZipOrFile(zp, Account.ProtoPath, SpamQuestsFilename);
i := -1;
// i := 0;
while s > '' do
begin
line := chopLine(s);
k := trim(chop('=', line));
line := trim(line);
{ if isOnlyDigits(k) then
try
i := strToInt(k);
except
// setlength(a,length(a)-1);
end
else }
if k = 'question' then
try
i := length(spamfilter.quests);
SetLength(spamfilter.quests, i + 1);
spamfilter.quests[i].q := UnUTF(StringReplace(line, AnsiString('\n'), CRLF, [rfReplaceAll]));
except
end
else if k = 'answer' then
try
if i >= 0 then
try
j := length(spamfilter.quests[i].ans);
SetLength(spamfilter.quests[i].ans, j + 1);
spamfilter.quests[i].ans[j] := UnUTF(line);
except
end;
except
end;
end;
end;
{ procedure SaveSpamQuests;
var
i, j : integer;
f : string;
begin
if fantomWork then Exit;
f:='';
for I := low(spamfilter.quests) to High(spamfilter.quests) do
begin
f := f+format('question=%s',
[newline2slashn(spamfilter.quests[i].q)]);
for j := low(spamfilter.quests[i].ans) to High(spamfilter.quests[i].ans) do
f := f+format(CRLF + 'answer=%s',[spamfilter.quests[i].ans[j]]);
// f := f+format(CRLF+'ssi=%d', [a[i].ssiID]);
f:=f+CRLF + '**********' + CRLF;
end;
saveFile(userPath + SpamQuestsFilename, f);
end;
}
procedure LoadProxies(zp: TZipFile; var pProxys: Tarrproxy);
var
cfg, l, h: RawByteString;
i, ppp: integer;
function yesno: Boolean;
begin
result := comparetext(l, AnsiString('yes')) = 0
end;
// var
// pp : TproxyProto;
begin
// cfg := loadfile(userPath + proxiesFileName);
cfg := loadFromZipOrFile(zp, Account.ProtoPath, proxiesFileName);
i := 0;
ClearProxyArr(pProxys);
// SetLength(pProxys, 0);
// ProxyIDBox.ItemIndex := 0;
while cfg > '' do
begin
l := chop(CRLF, cfg);
h := chop('=', l);
if h = 'proxy-name' then
begin
i := length(pProxys);
SetLength(pProxys, i + 1);
ClearProxy(pProxys[i]);
pProxys[i].name := UnUTF(l);
end
else if length(pProxys) > 0 then
begin
if h = 'proxy-ver5' then
if yesno then
pProxys[i].proto := PP_SOCKS5
else
pProxys[i].proto := PP_SOCKS4
// else if h='proxy' then pProxys[i].enabled:=yesno
else if h = 'proxy-auth' then
pProxys[i].auth := yesno
else if h = 'proxy-user' then
pProxys[i].user := UnUTF(l)
else if h = 'proxy-ntlm' then
pProxys[i].NTLM := yesno
else if h = 'connection-ssl' then
pProxys[i].ssl := yesno
else if h = 'proxy-pass' then
pProxys[i].pwd := passDecrypt(l)
else if h = 'proxy-pass64' then
pProxys[i].pwd := passDecrypt(Base64DecodeString(l))
else if h = 'proxy-serv-host' then
pProxys[i].serv.host := l
else if h = 'proxy-serv-port' then
pProxys[i].serv.port := StrToIntDef(l, 0)
else if h = 'proxy-host' then
pProxys[i].addr.host := l
else if h = 'proxy-port' then
pProxys[i].addr.port := StrToIntDef(l, 0)
else if h = 'proxy-proto' then
begin
ppp := findInStrings(l, proxyproto2str);
if ppp < 0 then
begin
// pProxys[i].enabled:=FALSE;
// pProxys[i].proto:=PP_SOCKS5;
pProxys[i].proto := PP_NONE;
end
else
pProxys[i].proto := TproxyProto(ppp);
end
{ else if Pos('proxy-', h)>0 then
for pp:=low(pp) to high(pp) do
begin
if h='proxy-'+proxyproto2str[pp]+'-host' then proxyes[i].addr[pp].host:=l;
if h='proxy-'+proxyproto2str[pp]+'-port' then proxyes[i].addr[pp].port:=l;
end; }
end
end;
end;
(* procedure SaveProxies(pProxys : Tarrproxy);
var
cfg : string;
// pp : TproxyProto;
I: Integer;
begin
if fantomWork then Exit;
cfg := '';
for I := 0 to Length(pProxys) - 1 do
begin
if pProxys[i].name = '' then
pProxys[i].name := 'Proxy' + IntToStr(i+1);
cfg := cfg
+ 'proxy-name=' + pProxys[i].name+CRLF
// + 'proxy='+yesno[pProxys[i].enabled]+CRLF
+'proxy-serv-host='+pProxys[i].serv.host+CRLF
+'proxy-serv-port='+IntToStr(pProxys[i].serv.port)+CRLF
+ 'proxy-auth='+yesno[pProxys[i].auth]+CRLF
+ 'proxy-user='+pProxys[i].user+CRLF
+ 'proxy-pass='+passCrypt(pProxys[i].pwd)+CRLF
+ 'proxy-NTLM='+yesno[pProxys[i].NTLM]+CRLF
+ 'proxy-proto='+proxyproto2str[pProxys[i].proto]+CRLF
{ for pp:=low(pp) to high(pp) do cfg:=cfg
+'proxy-'+proxyproto2str[pp]+'-host='+proxyes[i].addr[pp].host+CRLF
+'proxy-'+proxyproto2str[pp]+'-port='+proxyes[i].addr[pp].port+CRLF;
}
+'proxy-host='+pProxys[i].addr.host+CRLF
+'proxy-port='+IntToStr(pProxys[i].addr.port)+CRLF;
cfg := cfg + '------------------' + CRLF;
end;
savefile(userPath+proxiesFileName, CFG, True)
end;
*)
function saveAllLists(const uPath: String; const pr: TRnQProtocol; pProxys: Tarrproxy): Boolean;
const
splitMsg = 'automsg: ';
autoaway_name = 'AUTO-AWAY';
var
zf: TZipFile;
// ZIP: TZIPWriter;
procedure AddFile2Zip(const fn: String; const cfg: RawByteString);
// var
// fIDX : Integer;
begin
// if cfg > '' then
begin
// fIDX := zf.AddFile(fn);
// fIDX := zf.AddFile(fn, 0, '123');
// fIDX := zf.AddFile(fn, 0, AccPass);
// zf.Data[fIDX] := cfg;
// fIDX :=
zf.AddFile(fn, 0, AccPass, cfg);
end;
// zf.Files[fIDX].CommonFileHeader.VersionNeededToExtract
end;
var
// s : string;
cfg: RawByteString;
sA: AnsiString;
// i : Integer;
k, l: integer;
Saved: Boolean;
memStream: TMemoryStream;
lFileOld, lFileNew, lFileBak: string;
begin
result := False;
if fantomWork then
exit;
{
groups.save; -- OK
saveLists(MainProto); -- OK
saveInbox; -- OK
saveOutbox; -- OK
saveCFG; -- OK
saveAutoMessages; -- OK
saveMacros; -- OK
savecommonCFG; -- OK
saveDB; -- OK
saveRetrieveQ; -- OK
if reopenchats then chatFrm.savePages; -- OK
SaveExtSts; -- OK
SaveSpamQuests; -- OK
}
zf := TZipFile.Create;
// i := 0;
// zf.AddFile(dbFileName);
// zf.Data[i] := db2str(contactsDB);
zf.ZipFileComment := 'DB file of R&Q ver.' + IntToStrA(RnQBuild);
cfg := db2strU(contactsDB);
AddFile2Zip(dbFileName, cfg);
cfg := AnsiString('protocol=') + AnsiString(pr.ProtoName) + CRLF + AnsiString('account-id=') + pr.getMyInfo.UID2cmp + CRLF +
AnsiString('account-name=') + StrToUTF8(pr.getMyInfo.displayed)
{$IFDEF UseNotSSI}
+ CRLF + AnsiString('use-ssi=') + yesno[useSSI2]
{$ELSE UseNotSSI}
+ CRLF + AnsiString('use-ssi=') + yesno[True]
{$ENDIF UseNotSSI}
;
AddFile2Zip(AboutFileName, cfg);
cfg := '';
AddFile2Zip(groupsFilename, groups.toString);
AddFile2Zip(rosterFileName1, pr.readList(LT_ROSTER).toString);
// msgDlg(getTranslation('Error saving contact list'),mtError);
AddFile2Zip(visibleFileName1, pr.readList(LT_VISIBLE).toString);
// msgDlg(getTranslation('Error saving visible list'),mtError);
AddFile2Zip(invisibleFileName1, pr.readList(LT_INVISIBLE).toString);
// msgDlg(getTranslation('Error saving invisible list'),mtError);
AddFile2Zip(ignoreFilename1, ignoreList.toString);
// msgDlg(getTranslation('Error saving ignore list'),mtError);
// if NILdoWith = 2 then
begin
AddFile2Zip(nilFilename1, notInlist.toString);
// msgDlg(getTranslation('Error saving not-in-list'),mtError);
end;
AddFile2Zip(uinlistFilename, uinlists.toString);
// msgDlg(getTranslation('Error saving uinlists'), mtError);
{$IFDEF CHECK_INVIS}
AddFile2Zip(CheckInvisFileName1, CheckInvis.CList.toString);
// msgDlg(getTranslation('Error saving Check-invisibility list'),mtError);
{$ENDIF}
if Assigned(eventQ) then
AddFile2Zip(inboxFilename, eventQ.toString);
if Assigned(Account.outbox) then
AddFile2Zip(outboxFilename, Account.outbox.toString);
AddFile2Zip(configFileName, getCFG);
begin
if length(automessages[0]) > 5000 then
automessages.Strings[0] := Copy(automessages[0], 1, 5000);
cfg := StrToUTF8(automessages[0]) + CRLF;
k := 1;
while k < automessages.count do
begin
cfg := cfg + splitMsg + StrToUTF8(automessages[k]) + CRLF + StrToUTF8(automessages[k + 1]) + CRLF;
inc(k, 2);
end;
cfg := cfg + splitMsg + autoaway_name + CRLF + StrToUTF8(autoaway.msg) + CRLF;
AddFile2Zip(automsgFilename, cfg);
cfg := '';
end;
AddFile2Zip(macrosFileName, macros2str(macros));
// inc(i);
// zf.AddFile(commonFileName);
// zf.Data[i] := getCommonCFG;
if retrieveQ.empty then
// deleteFile(uPath+retrieveFileName+'.txt')
else
AddFile2Zip(retrieveFileName1, retrieveQ.toString);
if Assigned(chatFrm) then
AddFile2Zip(reopenchatsFileName, chatFrm.Pages2String);
cfg := '';
// for I := low(XStatus6) to High(XStatus6) do
for k := low(ExtStsStrings) to High(ExtStsStrings) do
begin
cfg := cfg + format(AnsiString('%d=%s' + CRLF + 'caption=%s' + CRLF + 'desc=%s'),
[k, AnsiString(XStatusArray[k].Caption), StrToUTF8(ExtStsStrings[k].Cap),
StrToUTF8(newline2slashn(ExtStsStrings[k].Desc))]);
// f := f+format(CRLF+'ssi=%d', [a[i].ssiID]);
cfg := cfg + CRLF;
end;
AddFile2Zip(extstatusesFilename, cfg);
cfg := '';
for k := low(spamfilter.quests) to High(spamfilter.quests) do
begin
sA := StrToUTF8(newline2slashn(spamfilter.quests[k].q));
if sA > '' then
begin
cfg := cfg + format(AnsiString('question=%s'), [sA]);
for l := low(spamfilter.quests[k].ans) to High(spamfilter.quests[k].ans) do
// cfg := cfg+format(AnsiString(CRLF + 'answer=%s'),[StrToUTF8(spamfilter.quests[k].ans[l])]);
cfg := cfg + CRLF + AnsiString('answer=') + StrToUTF8(spamfilter.quests[k].ans[l]);
// f := f+format(CRLF+'ssi=%d', [a[i].ssiID]);
cfg := cfg + CRLF + '**********' + CRLF;
end;
end;
AddFile2Zip(SpamQuestsFilename, cfg);
cfg := '';
if length(pProxys) > 0 then
for k := 0 to length(pProxys) - 1 do
begin
if pProxys[k].name = '' then
pProxys[k].name := 'Proxy' + IntToStr(k + 1);
cfg := cfg + 'proxy-name=' + StrToUTF8(pProxys[k].name) + CRLF
// + 'proxy='+yesno[pProxys[i].enabled]+CRLF
+ 'proxy-serv-host=' + AnsiString(pProxys[k].serv.host) + CRLF + 'proxy-serv-port=' + IntToStrA(pProxys[k].serv.port) +
CRLF + 'proxy-auth=' + yesno[pProxys[k].auth] + CRLF + 'proxy-user=' + StrToUTF8(pProxys[k].user) + CRLF
// + 'proxy-pass=' +passCrypt(pProxys[k].pwd)+CRLF
+ 'proxy-pass64=' + Base64EncodeString(passCrypt(pProxys[k].pwd)) + CRLF + 'proxy-ntlm=' + yesno[pProxys[k].NTLM] + CRLF +
'connection-ssl=' + yesno[pProxys[k].ssl] + CRLF + 'proxy-proto=' + proxyproto2str[pProxys[k].proto] + CRLF
{ for pp:=low(pp) to high(pp) do cfg:=cfg
+'proxy-'+proxyproto2str[pp]+'-host='+proxyes[i].addr[pp].host+CRLF
+'proxy-'+proxyproto2str[pp]+'-port='+proxyes[i].addr[pp].port+CRLF;
}
+ 'proxy-host=' + AnsiString(pProxys[k].addr.host) + CRLF + 'proxy-port=' + IntToStrA(pProxys[k].addr.port) + CRLF;
cfg := cfg + '------------------' + CRLF;
end;
AddFile2Zip(proxiesFileName, cfg);
try
// zf.SaveToFile(uPath+dbFileName + '4.new');
memStream := TMemoryStream.Create;
zf.SaveToStream(memStream);
memStream.SaveToFile(uPath + dbFileName + '5.new');
memStream.Free;
Saved := True;
except
msgDlg('Error on saving DB5', True, mtError);
Saved := False;
end;
zf.Free;
if Saved then
try
if FileExists(uPath + dbFileName + '5') then
begin
lFileOld := uPath + dbFileName + '5';
lFileNew := uPath + dbFileName + '5.new';
lFileBak := uPath + dbFileName + '5.bak';
if MakeBakups then
begin
ReplaceFile(PChar(lFileOld), PChar(lFileNew), PChar(lFileBak), REPLACEFILE_IGNORE_MERGE_ERRORS, NIL, NIL)
end
else
ReplaceFile(PChar(lFileOld), PChar(lFileNew), NIL, REPLACEFILE_IGNORE_MERGE_ERRORS, NIL, NIL)
end
else
// DeleteFile(uPath+dbFileName + '5');
renamefile(uPath + dbFileName + '5.new', uPath + dbFileName + '5');
except
// RnQFileUtil.saveFile(userPath+dbFileName, s, True);
msgDlg('Error on saving DB', True, mtError);
end;
// if FileExists(userPath+dbFileName) then
// DeleteFile(userPath+dbFileName);
// if FileExists(userPath+dbFileName + '2') then
// DeleteFile(userPath+dbFileName + '2');
result := True;
end;
function doConnect: Boolean;
var
// msg : string;
// evInt : Integer;
pr: TRnQProtocol;
begin
result := False;
if not Assigned(Account.AccProto) or not Account.AccProto.isOffline then
exit;
result := True;
if not useLastStatus then
lastStatus := RnQstartingStatus;
setProgBar(Account.AccProto, 0.1 / progLogonTotal);
pr := Account.AccProto.ProtoElem;
// if MainProto.ProtoName = 'ICQ' then
begin
// proxy_http_Enable(ICQ.sock);
if (MainProxy.ssl)
{$IFNDEF ICQ_ONLY}
and (pr.ProtoID = ICQProtoID)
{$ENDIF ICQ_ONLY}
then
MainProxy.serv.host := TICQSession(pr).SSLserver;
CopyProxy(pr.aProxy, MainProxy);
pr.sock.proxySettings(pr.aProxy);
pr.loginServerAddr := pr.aProxy.serv.host;
pr.loginServerPort := IntToStrA(pr.aProxy.serv.port);
{$IFDEF USE_SSL}
pr.sock.isSSL := pr.aProxy.ssl;
{$ENDIF USE_SSL}
// if pr.aProxy.proto = PP_HTTPS then
begin
// statusicon.update;
// try
// ICQ.sock.DnsLookup(proxy.serv.host);
if (pr.loginServerAddr = lastserverAddr) and (lastServerIP > '') then
connect_after_dns(Account.AccProto)
else if WSocketIsDottedIP(pr.loginServerAddr) or not MainProxy.rslvIP then
begin
lastserverAddr := pr.loginServerAddr;
lastServerIP := pr.loginServerAddr;
connect_after_dns(Account.AccProto)
end
else
begin
if resolving then
exit;
// icq.sock.MultiThreaded := True;
// icq.sock.ThreadAttach
// try
resolving := True;
PostMessage(RnQmain.Handle, WM_RESOLVE_DNS, 0, 0);
{ pr.sock.DnsLookup(pr.aProxy.serv.host);
except
on E:Exception do
begin
evInt:=WSocket_WSAGetLastError;
msg := E.Message;
Account.AccProto.disconnect;
resolving:= False;
setProgBar(Account.AccProto, 0);
msgDlg(getTranslation('DNS error: [%d]\n%s' , [evInt, Msg]), False, mtError);
end
else
begin
evInt:=WSocket_WSAGetLastError;
Msg := WSocketErrorDesc(evInt);
Account.AccProto.disconnect;
resolving:= False;
setProgBar(Account.AccProto, 0);
msgDlg(getTranslation('DNS error: [%d]\n%s' , [evInt, Msg]), False, mtError);
end;
end; }
// pr.sock.DnsLookup(pr.loginServerAddr)
end;
// lastserverAddr := ICQ.loginServerAddr
;
end
end
end; // doConnect
procedure connect_after_dns(const proto: TRnQProtocol);
// var
// icq : TicqSession;
begin
begin
if lastServerIP > '' then
proto.ProtoElem.loginServerAddr := lastServerIP;
{$IFDEF UseNotSSI}
if (proto.ProtoElem is TICQSession) then
TICQSession(proto.ProtoElem).updateVisibility;
// ICQ.updateVisibility;
{$ENDIF UseNotSSI}
// proto.ProtoElem.sock.MultiThreaded := False;
// proto.ProtoElem.sock.MultiThreaded := True;
if lastStatus = byte(SC_OFFLINE) then
proto.setStatus(byte(SC_ONLINE))
else if not exitFromAutoaway() then
proto.setStatus(byte(lastStatus));
end;
end; // connect_after_dns
function findAuthReq(c: TRnQContact): TauthreqFrm;
var
i: integer;
begin
with childWindows do
begin
i := 0;
while i < count do
begin
if Tobject(items[i]) is TauthreqFrm then
begin
result := TauthreqFrm(items[i]);
if result.contact.equals(c) then
exit;
end;
inc(i);
end;
end;
result := NIL;
end; // findAuthreq
function findViewInfo(c: TRnQContact): TRnQViewInfoForm;
var
i: integer;
begin
with childWindows do
begin
i := 0;
while i < count do
begin
if Tobject(items[i]) is TRnQViewInfoForm then
begin
result := TRnQViewInfoForm(items[i]);
if result.contact.equals(c) then
exit;
end;
inc(i);
end;
end;
result := NIL;
end;
procedure showSplash;
const
minWidth = 200;
{ var
// region:HRGN;
// b0 : TBitmap;
// b1 : TGPBitmap;
// gr : TGPGraphics;
// p :TGPPointF;
// gp : TGPGraphicsPath;
// fnt : TGPFont;
// br : TGPBrush;
// rgn : TGPRegion;
// x : Integer;
transcolor:integer;
brF : HBRUSH;
st : Integer;
// transcolor :TColor;
}
begin
try
{ bmp2 := TBitmap.Create;
bmp2.PixelFormat := pf32bit; }
splashImgElm.ThemeToken := -1;
splashImgElm.picName := PIC_SPLASH;
splashImgElm.Element := RQteDefault;
splashImgElm.pEnabled := True;
with theme.GetPicSize(splashImgElm) do
begin
(*
begin
if (cx = 0) or (cy = 0) then
Exit;
{ bmp := createBitmap(max(cx, minWidth), cy + 30);
bmp.PixelFormat := pf32bit;}
// b0 := createBitmap(max(cx, minWidth), cy + 30);
// b0 := createBitmap(max(cx, minWidth), cy);
b0 := createBitmap(cx, cy);
b0.PixelFormat := pf32bit;
// b0.PixelFormat := pf24bit;
// b0.TransparentColor := ABCD_ADCB($020201);
// b0.TransparentColor := $020201;
b0.TransparentColor := ABCD_ADCB($030201);
// b0.Canvas.fi;
transcolor := b0.TransparentColor AND $FFFFFF;
b0.TransparentMode := tmFixed;
// transcolor := b0.TransparentColor;
b0.TransparentColor := transcolor;
b0.Transparent := True;
// bmp.TransparentColor := transcolor;
brF := CreateSolidBrush(transcolor);
FillRect(b0.Canvas.Handle, b0.Canvas.ClipRect, brF);
DeleteObject(brF);
// b0.Canvas.Brush.Color := transcolor;
// b0.Canvas.FillRect(b0.Canvas.ClipRect);
// theme.drawPic(b0.Canvas, x, 30, PIC_SPLASH);
// bmp2.Free;
{ b0.Canvas.Font.Size := 18;
b0.Canvas.Brush.Color := clBlue;
b0.Canvas.Font.Color := clBlue;
theme.ApplyFont('splash', b0.Canvas.Font);
// SetBKMode(b0.canvas.Handle, TRANSPARENT);
SetBKMode(b0.canvas.Handle, TRANSPARENT);
TextOut(b0.canvas.Handle, 5, 0, 'http://RnQ.ru', length('http://RnQ.ru'));
}
// theme.drawPic(b0.Canvas.Handle, (max(cx, minWidth)- cx) div 2, 30, PIC_SPLASH,
theme.drawPic(b0.Canvas.Handle, Point(0, 0), splashImgElm);
// region:= CreateRectRgn(0, 0, cx, 30 + cy);
// b1 := TGPBitmap.Create(max(cx, minWidth), cy + 30);
{ if cx < minWidth then
x := (minWidth - cx) div 2
else
x := 0;}
end;
{ gr := TGPGraphics.Create(b0.Canvas.Handle);
// gr := TGPGraphics.Create(b1);
gr.Clear(aclTransparent);
{ Fnt := TGPFont.Create('Arial', 18, FontStyleBold or FontStyleItalic);
Br := TGPSolidBrush.Create(aclBlue);
p.X := 0; p.Y := 0;
gr.DrawString(wideString('http://RnQ.ru'), length('http://RnQ.ru'), fnt,
p, br);
br.Free; fnt.Free;
}
// theme.drawPic(gr, 0, 30, PIC_SPLASH, splashPicTkn, splashPicLoc, splashPicIdx);
// bmp.Canvas.TextOut(0, 0, 'http://RnQ.ru');
// theme.getPic(PIC_SPLASH, bmp);
// region := theme.GetPicRGN(PIC_SPLASH, splashPicTkn, splashPicLoc, splashPicIdx);
{
rgn := TGPRegion.Create;
gp := TGPGraphicsPath.Create;
gp.AddString(wideString('http://RnQ.ru'), length('http://RnQ.ru'), fnt, FontStyleBold, 18,
p, br)
region := rgn.GetHRGN(gr);
}
// gr.Free;//rgn.Free;
// b0.Transparent := True;
// region:=getRegion2(b0);
region:=getRegion(b0);
*)
splashFrm := Tform.Create(application);
// SetWindowLong(splashFrm.Handle, GWL_EXSTYLE, GetWindowLong(splashFrm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
// GetWindowLong(Parent.Handle, GWL_STYLE)
// SetWindowLong(splashFrm.Handle, GWL_STYLE, WS_VISIBLE);
// SetWindowPos(splashFrm.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_FRAMECHANGED);
g_hLib_User32 := LoadLibrary('user32.dll');
if g_hLib_User32 = 0 then
raise Exception.Create('LoadLibrary(user32.dll) failed');
@g_pUpdateLayeredWindow := GetProcAddress(g_hLib_User32, 'UpdateLayeredWindow');
with splashFrm do
begin
// color:=clBlack;
// color := theme.GetFontProp('splash', FPT_COLOR).color;
// TransparentColorValue := transcolor;
position := poScreenCenter;
Width := cx;
Height := cy;
borderstyle := bsNone;
// if region > 0 then
// SetWindowRgn(handle,region,TRUE);
borderstyle := bsNone;
onPaint := RnQmain.splashPaint;
// st := GetWindowLong(splashFrm.Handle, GWL_EXSTYLE);
// SetWindowLong(splashFrm.Handle, GWL_EXSTYLE, st and not WS_EX_LAYERED);
// SetWindowLong(splashFrm.Handle, GWL_EXSTYLE, st or WS_EX_LAYERED);
SetWindowLong(splashFrm.Handle, GWL_STYLE, WS_VISIBLE);
// SetWindowLongPtr(splashFrm.Handle, GWL_STYLE, WS_VISIBLE); // Win64 compatible!!!
SetWindowPos(splashFrm.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_FRAMECHANGED);
show;
RnQmain.splashPaint(splashFrm);
bringForeground := splashFrm.Handle;
setTopMost(splashFrm, True);
// repaint;
// splashFrm.Canvas.Draw(0, 0, b0);
end;
end;
(* b0.Free; *)
except
end;
end; // ShowSplash
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color1: TColor;
Color2: TColor;
Rect: Trect;
Rgn: HRGN;
hnd: HDC;
p: TPicName;
ss: String;
begin
hnd := Message.DrawItemStruct.HDC;
Rect := Message.DrawItemStruct.rcItem;
SelectClipRgn(hnd, 0);
inc(Rect.Left, 2);
inc(Rect.Top, 2);
inc(Rect.Bottom, 4);
inc(Rect.Right, 2);
case Message.DrawItemStruct.itemState of
1:
begin
Color1 := theme.GetColor('button.bg.selected', clWebLightgrey);
Color2 := theme.GetColor('button.frame.selected', clWebGray);;
FillRect(hnd, Rect, CreateSolidBrush(Color1));
FrameRect(hnd, Rect, CreateSolidBrush(Color2));
end;
end;
with canvas do
begin
inc(Rect.Left, 4);
dec(Rect.Right, 2);
// inc(Rect.Top, 2);
// inc(Rect.bottom, 2);
SetBKMode(hnd, TRANSPARENT);
if (Message.DrawItemStruct.itemState = 1) then
p := 'chat.tab.active'
else
p := 'chat.tab.inactive';
theme.ApplyFont(p, canvas.Font);
ss := Self.Tabs.Strings[Message.DrawItemStruct.itemID];
DrawText(hnd, PChar(ss), length(ss), Rect, DT_SINGLELINE or DT_VCENTER);
end;
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.HDC, Rgn);
DeleteObject(Rgn);
Message.result := 1;
inherited;
end;
destructor TImageEx.Destroy;
begin
if Assigned(ImageStream) then
ImageStream.Free;
inherited;
end;
procedure parseMsgImages(imgStr: RawByteString; var imgList: TStringList);
var
pos1, pos2: integer;
image: RawByteString;
begin
if not Assigned(imgList) then
exit;
image := imgStr;
repeat
pos1 := PosEx(RnQImageTag, image);
if (pos1 > 0) then
begin
pos2 := PosEx(RnQImageUnTag, image, pos1 + length(RnQImageTag));
imgList.Add(Copy(image, pos1 + length(RnQImageTag), pos2 - (pos1 + length(RnQImageTag))));
image := Copy(image, pos2 + length(RnQImageUnTag), length(image));
end
else
Break;
until pos1 <= 0;
image := imgStr;
repeat
pos1 := PosEx(RnQImageExTag, image);
if (pos1 > 0) then
begin
pos2 := PosEx(RnQImageExUnTag, image, pos1 + length(RnQImageExTag));
imgList.Add(Copy(image, pos1 + length(RnQImageExTag), pos2 - (pos1 + length(RnQImageExTag))));
image := Copy(image, pos2 + length(RnQImageExUnTag), length(image));
end
else
Break;
until pos1 <= 0;
end;
function viewTextWindow(title, body: string; image: RawByteString): Tform;
var
form: Tform;
memo: Tmemo;
img: TImageEx;
scroll: TScrollBox;
PIn, POut: Pointer;
RnQPicStream: TMemoryStream;
OutSize: Cardinal;
ff: TPAFormat;
png: TPNGImage;
winimg: TWICImage;
bmp: TBitmap;
gif: TGIFImage;
// rnqbmp: TRnQBitmap;
pic: IPicture;
a, b: integer;
h, w: integer;
r: Trect;
// NonAnimated: Boolean;
imgList: TStringList;
imgcnt: integer;
imgtag: RawByteString;
{ i, } j: integer;
pagectl: TPageControl;
pagetab: TTabSheet;
begin
form := Tform.Create(RnQmain);
result := form;
form.Caption := title;
form.position := poDefaultPosOnly;
pagectl := TPageControl.Create(form);
pagectl.parent := form;
pagectl.Align := alClient;
pagectl.TabPosition := tpTop;
pagectl.DoubleBuffered := True;
pagectl.MultiLine := True;
pagectl.Style := tsButtons;
pagectl.StyleElements := [];
pagectl.OwnerDraw := True;
pagectl.name := 'pagectl';
if (trim(body) <> '') then
begin
pagetab := TTabSheet.Create(pagectl);
pagetab.Caption := getTranslation('message');
pagetab.PageControl := pagectl;
pagetab.BorderWidth := 0;
pagetab.ControlStyle := pagetab.ControlStyle + [csOpaque];
memo := Tmemo.Create(pagetab);
memo.parent := pagetab;
memo.text := body;
memo.Align := alClient;
memo.WordWrap := bViewTextWrap;
memo.borderstyle := bsNone;
if memo.WordWrap then
memo.ScrollBars := ssVertical
else
memo.ScrollBars := ssBoth;
// form.InsertControl(memo);
memo.OnKeyDown := RnQmain.MemoKeyDown;
end;
if (trim(image) <> '') then
begin
imgList := TStringList.Create;
parseMsgImages(image, imgList);
for imgcnt := 0 to imgList.count - 1 do
begin
pagetab := TTabSheet.Create(pagectl);
pagetab.PageControl := pagectl;
pagetab.BorderWidth := 0;
pagetab.ControlStyle := pagetab.ControlStyle + [csOpaque];
j := pagectl.PageCount - 1;
pagetab.name := 'pagetab' + IntToStr(j);
scroll := TScrollBox.Create(pagetab);
scroll.Align := alClient;
scroll.parent := pagetab;
scroll.HorzScrollBar.Smooth := True;
scroll.HorzScrollBar.Tracking := True;
scroll.VertScrollBar.Smooth := True;
scroll.VertScrollBar.Tracking := True;
scroll.DoubleBuffered := True;
scroll.borderstyle := bsNone;
scroll.name := 'scroll' + IntToStr(j);
imgtag := imgList.Strings[imgcnt];
PIn := @imgtag[1];
OutSize := CalcDecodedSize(PIn, length(imgtag));
RnQPicStream := TMemoryStream.Create;
RnQPicStream.SetSize(OutSize);
RnQPicStream.position := 0;
POut := RnQPicStream.Memory;
Base64Decode(PIn^, length(imgtag), POut^);
img := TImageEx.Create(scroll);
img.parent := scroll;
img.AutoSize := True;
img.Center := False;
img.Stretch := False;
img.Proportional := True;
img.OnMouseDown := RnQmain.imgMouseDown;
img.OnMouseMove := RnQmain.imgMouseMove;
img.name := 'image' + IntToStr(j);
img.PopupMenu := RnQmain.imgmenu;
img.ImageStream := TMemoryStream.Create;
img.ImageStream.LoadFromStream(RnQPicStream);
ff := DetectFileFormatStream(RnQPicStream);
RnQPicStream.Seek(0, soBeginning);
case ff of
PA_FORMAT_BMP:
try
img.Picture.Bitmap.LoadFromStream(RnQPicStream);
pagetab.Caption := 'BMP';
img.Tag := 1;
except
end;
PA_FORMAT_JPEG:
try
LoadPictureStream(RnQPicStream, pic);
if pic <> NIL then
begin
pic.get_Width(a);
pic.get_Height(b);
bmp := TBitmap.Create;
bmp.PixelFormat := pf24bit;
w := MulDiv(a, GetDeviceCaps(bmp.canvas.Handle, LOGPIXELSX), 2540);
h := MulDiv(b, GetDeviceCaps(bmp.canvas.Handle, LOGPIXELSY), 2540);
r.Left := 0;
r.Top := 0;
r.Right := w;
r.Bottom := h;
bmp.SetSize(w, h);
pic.Render(bmp.canvas.Handle, 0, 0, w, h, 0, b, a, -b, r);
pic := NIL;
if Assigned(bmp) then
img.Picture.Bitmap.Assign(bmp);
bmp.Free;
end;
pagetab.Caption := 'JPEG';
img.Tag := 2;
except
end;
PA_FORMAT_GIF:
try
gif := TGIFImage.Create;
gif.LoadFromStream(RnQPicStream);
img.Picture.Assign(gif);
(img.Picture.Graphic as TGIFImage).Animate := True;
img.TRANSPARENT := True;
pagetab.Caption := 'GIF';
img.Tag := 3;
gif.Free;
except
end;
PA_FORMAT_PNG:
try
png := TPNGImage.Create;
png.LoadFromStream(RnQPicStream);
img.Picture.Assign(png);
pagetab.Caption := 'PNG';
img.Tag := 4;
png.Free;
except
end;
PA_FORMAT_ICO:
try
img.Picture.Icon.LoadFromStream(RnQPicStream);
img.TRANSPARENT := True;
pagetab.Caption := 'ICO';
img.Tag := 5;
except
end;
PA_FORMAT_TIF:
try
winimg := TWICImage.Create;
winimg.LoadFromStream(RnQPicStream);
img.Picture.Assign(winimg);
pagetab.Caption := 'TIFF';
img.Tag := 6;
winimg.Free;
except
end;
PA_FORMAT_WEBP:
try
winimg := TWICImage.Create;
winimg.LoadFromStream(RnQPicStream);
img.Picture.Assign(winimg);
pagetab.Caption := 'WEBP';
img.Tag := 7;
winimg.Free;
except
end;
PA_FORMAT_UNK:
try
pagetab.Free;
img.Tag := 0;
except
end;
end;
end;
imgList.Free;
FreeAndNil(RnQPicStream);
end;
if (pagectl.PageCount = 1) then
begin
pagectl.Pages[0].TabVisible := False;
pagectl.Pages[0].Visible := True;
end;
form.OnClose := RnQmain.onCloseSomeWindows;
with desktopworkarea(mainDlg.RnQmain.Handle) do
begin
form.Width := (Right - Left) div 3;
form.Height := (Bottom - Top) div 3 + 100;
end;
applyTaskButton(form);
form.OnKeyPress := RnQmain.previewFormKeyPress;
form.KeyPreview := True;
form.show;
end; // viewTextWindow
function viewHeventWindow(ev: Thevent): Tform;
begin
result := NIL;
if ev = NIL then
exit;
result := viewTextWindow(ev.getHeaderText, ev.getBodyText, ev.getBodyBin);
// theme.GetIco2(ev.pic, result.icon);
theme.pic2ico(RQteFormIcon, ev.pic, result.Icon);
end; // viewHeventWindow
function openSaveDlg(parent: Tform; const Cptn: String; IsOpen: Boolean; const ext: String = ''; const extCptn: String = '';
const defFile: String = ''; MultiSelect: Boolean = False): string;
var
Filtr: String;
fn: String;
hndl: THandle;
// defDir : String;
begin
if ext > '' then
if extCptn > '' then
Filtr := getTranslation(extCptn) + '|*.' + ext + '|' + getTranslation('All files') + '|*.*'
else
Filtr := '*.' + ext + '|*.' + ext + '|' + getTranslation('All files') + '|*.*'
else
Filtr := getTranslation('All files') + '|*.*';
// if defFile = '' then
// defFile := myPath;
// dlg.options:=[ofFileMustExist,ofEnableSizing];
if parent <> NIL then
hndl := parent.Handle
else
hndl := 0;
fn := ExtractFileName(defFile);
if OpenSaveFileDialog(hndl, ext, Filtr, ExtractFileDir(defFile), getTranslation(Cptn), fn, IsOpen, MultiSelect) then
result := fn
else
result := '';
end; // opendlg
function str2html(const s: string): string;
begin
result := template(s, ['&', '&amp;', '"', '&quot;', '<', '&lt;', '>', '&gt;', CRLF, '<br>', #13, '<br>', #10, '<br>']);
end; // str2html
function strFromHTML(const s: string): string;
begin
result := template(s, ['&amp;', '&', '&quot;', '"', '&lt;', '<', '&gt;', '>', '<br>', CRLF
// '<br>', #13,
// '<br>', #10,
]);
end; // str2html
procedure restoreForeWindow;
begin
if oldForewindow = 0 then
exit;
bringForeground := oldForewindow;
oldForewindow := 0;
end; // restoreForeWIndow
procedure applyTransparency(forced: integer = -1);
var
bak: THandle;
begin
if not running then
exit;
bak := RnQmain.Handle;
RnQmain.alphablend := transparency.forRoster or (forced > 0);
chatFrm.alphablend := transparency.forChat or (forced > 0);
if RnQmain.alphablend then
if forced >= 0 then
begin
RnQmain.alphablendvalue := forced;
// chatfrm.alphablendvalue:=forced
end
else
begin
// chatFrm.AlphaBlendValue:=transparency.active;
if RnQmain.Handle = getForegroundWindow then
RnQmain.alphablendvalue := transparency.active
else
RnQmain.alphablendvalue := transparency.inactive;
end;
if chatFrm.alphablend then
if forced >= 0 then
chatFrm.alphablendvalue := forced
else
chatFrm.alphablendvalue := transparency.active;
if bak <> RnQmain.Handle then
mainfrmHandleUpdate;
end; // applyTransparency
procedure applyDocking(Undock: Boolean = False);
var
r: Trect;
begin
try
if docking.Dock2Chat then
begin
if Undock then
begin
if not RnQmain.Floating then
begin
if Assigned(RnQmain.parent) then
r.TopLeft := RnQmain.parent.ClientToScreen(Point(RnQmain.Left, RnQmain.Top))
else
r.TopLeft := Point(RnQmain.Left, RnQmain.Top);
end;
r.Right := r.Left + RnQmain.Width;
r.Bottom := r.Top + RnQmain.Height;
RnQmain.ManualFloat(r);
end
else
begin
mainDlg.RnQmain.DragKind := dkDock;
chatFrm.CLSplitter.Visible := True;
chatFrm.CLPanel.Visible := True;
if docking.Docked2chat and RnQmain.Floating then
if chatFrm.pageCtrl.PageCount > 0 then
begin
chatFrm.MainFormWidth := RnQmain.Width;
RnQmain.ManualDock(chatFrm.CLPanel);
RnQmain.Visible := True;
end;
end;
end
else
begin
if not RnQmain.Floating then
try
{ if Assigned(chatFrm.DockManager) then
chatFrm.DockManager.RemoveControl(RnQmain)
else
if Assigned(chatFrm.CLPanel.DockManager) then
chatFrm.CLPanel.DockManager.RemoveControl(RnQmain); }
if Assigned(RnQmain.parent) then
r.TopLeft := RnQmain.parent.ClientToScreen(Point(RnQmain.Left, RnQmain.Top))
else
r.TopLeft := Point(RnQmain.Left, RnQmain.Top);
r.Right := r.Left + RnQmain.Width;
r.Bottom := r.Top + RnQmain.Height;
RnQmain.ManualFloat(r);
except
end;
docking.Docked2chat := False;
mainDlg.RnQmain.DragKind := dkDrag;
chatFrm.CLPanel.Visible := False;
chatFrm.CLSplitter.Visible := False;
end;
finally
mainfrmHandleUpdate;
end;
end;
function loadDB(zp: TZipFile; pCheckGroups: Boolean): Boolean;
var
s: RawByteString;
zf: TZipFile;
i: integer;
begin
freeDB(contactsDB);
s := '';
if Assigned(zp) then
begin
// zf := TZipFile.Create;
try
i := zp.IndexOf(dbFileName);
if i >= 0 then
s := zp.data[i];
except
s := '';
end
end;
if s = '' then
if FileExists(Account.ProtoPath + dbFileName) then
s := loadFileA(Account.ProtoPath + dbFileName)
else
begin
zf := TZipFile.Create;
try
// if FileExists(userPath+dbFileName + '4') then
// begin
// zf.LoadFromFile(userPath+dbFileName + '4');
// i := zf.IndexOf(dbFileName);
// if i >=0 then
// s := zf.Uncompressed[i];
// end
// else
if FileExists(Account.ProtoPath + dbFileName + '3') then
begin
zf.LoadFromFile(Account.ProtoPath + dbFileName + '3');
i := zf.IndexOf(dbFileName);
if i >= 0 then
s := zf.data[i];
end
except
s := '';
end;
zf.Free;
end;
// if FileExists(userPath+dbFileName + '2') then
// s := ZDecompressStrEx(loadFile(userPath+dbFileName + '2'))
// else
// contactsDB:=str2db(Account.AccProto.getContactClass, s, result)
contactsDB := str2db(Account.AccProto, s, result, pCheckGroups);
contactsDB.Add(Account.AccProto, Account.AccProto.ProtoElem.MyAccNum)
end; // loadDB
(*
procedure saveDB;
var
s : string;
zf : TZipFile;
// ZIP: TZIPWriter;
begin
s := db2str(contactsDB);
// saveFile(userPath+dbFileName, s, True);
// saveFile(userPath+dbFileName + '2', ZCompressStrEx(s, clMax), True);
{ ZIP := TZIPWriter.Create(userPath+dbFileName + '3', '');
try
// for i := 0 to (List.Count - 1) do
// ZIP.AddFile(List[i], ExtractFileName(List[i]));
ZIP.AddString(s, dbFileName);
finally
ZIP.Free;
end;
}
zf := TZipFile.Create;
zf.AddFile(dbFileName);
zf.Data[0] := s;
try
zf.SaveToFile(userPath+dbFileName + '3');
if FileExists(userPath+dbFileName) then
DeleteFile(userPath+dbFileName);
except
RnQFileUtil.saveFile(userPath+dbFileName, s, True);
msgDlg('Error on saving DB', mtError);
end;
zf.Free;
if FileExists(userPath+dbFileName + '2') then
DeleteFile(userPath+dbFileName + '2');
end;
*)
function compContacts(Item1, Item2: Pointer): integer;
begin
result := comparetext(TRnQContact(Item1).displayed, TRnQContact(Item2).displayed)
end;
function compContactsByGroup(Item1, Item2: Pointer): integer;
var
c1, c2: TRnQContact;
begin
c1 := TRnQContact(Item1);
c2 := TRnQContact(Item2);
if c1.group < c2.group then
result := -1
else if c1.group > c2.group then
result := +1
else
result := comparetext(c1.displayed, c2.displayed);
end; // compContacts
procedure sortCL(cl: TRnQCList);
begin
cl.sort(compContacts)
end;
procedure sortCLbyGroups(cl: TRnQCList);
begin
cl.sort(compContactsByGroup)
end;
/// ///////////////////////////////////////////////////////////////////////
procedure hideForm(frm: Tform);
begin
if frm = NIL then
exit;
if frm = RnQmain then
begin
if formvisible(RnQmain) then
RnQmain.toggleVisible;
exit;
end;
frm.hide;
ShowWindow(application.Handle, SW_HIDE)
end;
function PrefIsVisiblePage(pf: String): Boolean;
begin
result := True;
if pf = 'ICQ' then
if not Assigned(Account.AccProto)
{$IFNDEF ICQ_ONLY}
or not(Account.AccProto.ProtoElem.ProtoID = ICQProtoID)
{$ENDIF ICQ_ONLY}
then
result := False;
{$IFNDEF ICQ_ONLY}
if pf = 'XMPP' then
if not Assigned(Account.AccProto) or not(Account.AccProto.ProtoElem.ProtoID = XMPProtoID) then
result := False;
{$ENDIF ICQ_ONLY}
end;
procedure showForm(whatForm: TwhatForm; const Page: String = ''; Mode: TfrmViewMode = vmFull);
var
frm: ^Tform;
frmclass: TcomponentClass;
i // , actPage
: byte;
arr: array of TPrefPage;
cr: Boolean;
begin
case whatForm of
// {$IFNDEF RNQ_LITE}
WF_PREF:
begin
frmclass := TprefFrm;
frm := @prefFrm
end;
// {$ENDIF RNQ_LITE}
WF_USERS:
begin
frmclass := TusersFrm;
frm := @usersFrm
end;
WF_WP:
begin
frmclass := TwpFrm;
frm := @wpFrm
end;
{$IFDEF PROTOCOL_MRA}
WF_WP_MRA:
begin
frmclass := TwpMRAFrm;
frm := @wpMRAFrm
end;
{$ENDIF PROTOCOL_MRA}
WF_SEARCH:
begin
frmclass := TAllHistSrchForm;
frm := @AllHistSrchForm;
end;
else
exit;
end;
if frm^ = NIL then
begin
cr := True;
application.createForm(frmclass, frm^);
applyCommonSettings(frm^);
translateWindow(frm^);
end
else
cr := False;
// {$IFNDEF RNQ_LITE}
// actPage := 0;
if whatForm = WF_PREF then
begin
SetLength(arr, 0);
if Page > '' then
if cr and (Mode <> vmFull) then
for i := 0 to length(prefPages) - 1 do
if prefPages[i].name = Page then
begin
// if cr and (Mode <> vmFull) then
begin
SetLength(arr, 1);
arr[0] := prefPages[i];
end;
// else
// actPage := i;
Break;
end;
if cr then
begin
prefFrm.SetViewMode(arr);
if Mode = vmFull then
begin
prefFrm.SetActivePage(Page);
end
end
else if Page > '' then
begin
prefFrm.SetActivePage(Page);
end;
SetLength(arr, 0);
end;
// {$ENDIF RNQ_LITE}
showForm(frm^);
end; // showPref
function showUsers(var pass: String): TUID;
begin
application.createForm(TusersFrm, usersFrm);
applyCommonSettings(usersFrm);
// applyTaskButton(usersFrm);
translateWindow(usersFrm);
result := usersFrm.doSelect;
pass := usersFrm.resAccPass;
FreeAndNil(usersFrm);
end; // showUsers
function CheckAccPas(const uid: TUID; const db: String; var pPass: String): Boolean;
begin
pPass := '';
if enterPwdDlg(pPass, getTranslation('Account password') + ' (' + uid + ')', 16) then
if CheckZipFilePass(db, dbFileName, pPass) then
begin
// resAccPass := newAccPass;
result := True
end
else
begin
pPass := '';
result := False;
msgDlg('Wrong password', True, mtWarning)
end
else
begin
result := False;
msgDlg('Please enter password', True, mtWarning);
end;
end;
procedure updateViewInfo(c: TRnQContact);
begin
if not updateViewInfoQ.exists(c) then
updateViewInfoQ.Add(c);
end;
{
procedure saveInbox;
begin
if Assigned(eventQ) then
saveFile( userPath+inboxFilename, eventQ.toString )
end;
procedure loadInbox(zp : TZipFile);
var
s : AnsiString;
i : Integer;
begin
i := -1;
if Assigned(zp) then
try
i := zp.IndexOf(inboxFilename);
if i >= 0 then
s := zp.Uncompressed[i];
except
i := -1;
s := '';
end;
if i < 0 then
s := loadfile(userPath+inboxFilename)
eventQ.fromString( s );
eventQ.removeExpiringEvents;
end;
{
procedure saveOutbox;
begin saveFile( userPath+outboxFilename, outbox.toString ) end; }
procedure loadOutInBox(zp: TZipFile);
var
s: RawByteString;
i: integer;
zipPref: Boolean;
begin
i := -1;
zipPref := False;
if Assigned(zp) then
try
i := zp.IndexOf(outboxFilename);
if i >= 0 then
s := zp.data[i];
except
i := -1;
s := '';
end;
if i < 0 then
s := loadFileA(Account.ProtoPath + outboxFilename)
else
zipPref := True;
Account.outbox.fromString(s);
if zipPref then
begin
i := zp.IndexOf(inboxFilename);
if i >= 0 then
s := zp.data[i];
end
else
s := loadFileA(Account.ProtoPath + inboxFilename);
eventQ.fromString(s);
eventQ.removeExpiringEvents;
end;
procedure openSendContacts(dest: TRnQContact);
var
wnd: TselectCntsFrm;
begin
if not Assigned(dest) then
exit;
wnd := TselectCntsFrm.doAll2(RnQmain, getTranslation('To %s', [dest.displayed]), getTranslation('Send selected contacts'),
dest.fProto, notInlist.clone.Add(dest.fProto.readList(LT_ROSTER)), RnQmain.sendContactsAction,
[sco_multi, sco_groups, sco_predefined], @wnd);
// Theme.getIco2(PIC_CONTACTS, wnd.icon);
theme.pic2ico(RQteFormIcon, PIC_CONTACTS, wnd.Icon);
wnd.extra := Tincapsulate.aString(dest.uid);
end; // openSendContacts
function isEmailAddress(const s: string; start: integer): integer;
// const
// emailChar=['a'..'z','A'..'Z','0'..'9','-','_','.'];
var
j: integer;
existsDot: Boolean;
begin
result := -1;
if CharInSet(s[start], EMAILCHARS) then // chi comincia bene...
begin
// try to find the @
j := start + 1;
while (j < length(s)) and (CharInSet(s[j], EMAILCHARS)) do
inc(j);
if s[j] = '@' then
begin
// @ found, now skip the @ and search for .
inc(j);
existsDot := False;
while (j < length(s)) and (CharInSet(s[j + 1], EMAILCHARS)) do
begin
if s[j] = '.' then
begin
existsDot := True;
Break;
end;
inc(j);
end;
if existsDot and (CharInSet(s[j], EMAILCHARS)) then
// at least a valid char after the . must exists
begin
repeat
inc(j);
until (j > length(s)) or not (CharInSet(s[j], EMAILCHARS));
// go forth till we're out or we meet an invalid char
result := j - 1;
end;
end;
end;
end; // isEmailAddress
procedure notAvailable;
begin
msgDlg('This feature isn''t available yet.\nCome back tomorrow...', True, mtInformation)
end;
// procedure redrawUIN(uin:TUID);
// begin rosterLib.redraw(contactsDB.get(uin)) end;
function childParent(child, parent: integer): Boolean;
begin
result := True;
repeat
if child = parent then
exit;
child := getParent(child);
until child = 0;
result := parent = 0;
end; // childParent
procedure myBeep;
begin
if playSounds then
beep
end;
function whatStatusPanel(statusbar: Tstatusbar; x: integer): integer;
var
x1: integer;
begin
result := 0;
x1 := statusbar.panels[0].Width;
while (x > x1) and (result < statusbar.panels.count - 1) do
begin
inc(result);
inc(x1, statusbar.panels[result].Width);
end;
end; // whatStatusPanel
function sendProtoMsg(var oe: Toevent): Boolean;
var
// c : Tcontact;
ev: Thevent;
vBin, rbsStr: RawByteString;
vStr: String;
send_msg: String;
fl: Cardinal;
i: integer;
begin
// c:= Tcontact(contactsDB.get( oe.uid));
{ if (c.lastPriority>0) and (c.status in [SC_dnd,SC_occupied]) then
oe.flags:=oe.flags or c.lastPriority; }
oe.flags := oe.flags or IF_urgent;
if oe.flags and IF_multiple <> 0 then
oe.flags := oe.flags or IF_noblink and not IF_urgent;
vBin := plugins.castEv(PE_MSG_SENT, oe.whom.uid, oe.flags, oe.info);
if (vBin > '') then
if (byte(vBin[1]) = PM_DATA) then
begin
i := _int_at(vBin, 2);
send_msg := UnUTF(_istring_at(vBin, 2));
if length(vBin) >= 1 + 4 + i + 4 then
oe.info := UnUTF(_istring_at(vBin, 2 + 4 + i))
else
oe.info := send_msg;
end
else if (byte(vBin[1]) = PM_ABORT) then
exit
else
begin
end
else
send_msg := oe.info;
vBin := '';
if length(send_msg) = 0 then
exit;
result := True;
oe.id := oe.whom.fProto.sendMsg(oe.whom, oe.flags, send_msg, result);
oe.timeSent := Now;
if result then
Account.acks.Add(oe.kind, oe.whom, oe.flags, 'MSG').id := oe.id;
if length(oe.info) = 0 then
exit;
{$IFDEF DB_ENABLED}
if (oe.flags and IF_Bin) <> 0 then
begin
vBin := oe.info;
vStr := '';
fl := oe.flags;
end
else
begin
vBin := '';
vStr := oe.info;
fl := oe.flags or IF_UTF8_TEXT;
end;
{$ELSE ~DB_ENABLED}
if (oe.flags and IF_Bin) <> 0 then
begin
vBin := oe.info;
vStr := '';
fl := oe.flags;
end
else
begin
vBin := StrToUTF8(oe.info);
vStr := '';
fl := oe.flags or IF_UTF8_TEXT;
end;
{$ENDIF ~DB_ENABLED}
if EnableImgLinksOut then
begin
if not (vStr = '') then
begin
rbsStr := vStr;
parseImgLinks(rbsStr);
vStr := rbsStr;
end;
if not (vBin = '') then
parseImgLinks(vBin);
end;
ev := Thevent.new(EK_MSG, oe.whom.fProto.getMyInfo, oe.timeSent, vBin{$IFDEF DB_ENABLED}, vStr{$ENDIF DB_ENABLED}, fl, oe.id);
ev.fIsMyEvent := True;
if logpref.writehistory and (BE_save in behaviour[ev.kind].trig) and (oe.flags and IF_not_save_hist = 0) then
writeHistorySafely(ev, oe.whom);
// if oe.flags and IF_not_show_chat = 0 then
// chatFrm.addEvent_openchat(c, ev.clone);
chatFrm.addEvent(oe.whom, ev.clone);
ev.Free;
end; // sendProtoMsg
procedure SendEmail2Mail(const email: String);
begin
if email > '' then
exec('mailto:' + email);
end;
function deleteFromTo(fn: string; from, to_: integer): Boolean;
begin
result := partDeleteFile(fn, from, to_ - from)
end;
function enterUinDlg(const proto: TRnQProtocol; var uin: TUID; const title: string = ''): Boolean;
var
res: TUID;
ttl: String;
s: String;
// e: integer;
// fUIN : Int64;
prCl: TRnQProtoClass;
begin
if title = '' then
ttl := 'uin'
else
ttl := title;
res := '';
repeat
result := InputQuery(getTranslation(ttl), getTranslation('UIN'), s);
res := s;
if result then
begin
res := trim(res);
uin := res;
if proto = NIL then
begin
result := False;
for prCl in RnQProtos do
// if prCl._isValidUid(uin) then
if prCl._isProtoUid(uin) then
begin
result := True;
uin := res;
Break;
end;
end
else
result := proto.validUid1(uin);
if result then
begin
// uin := res;
Break
end
else
msgDlg('Invalid UIN', True, mtError)
end;
until not result;
end; // enterUinDlg
function enterPwdDlg(var pwd: String; const title: string = ''; maxLength: integer = 0; AllowNull: Boolean = False): Boolean;
var
frm: pwdDlg.TmsgFrm;
begin
frm := pwdDlg.TmsgFrm.Create(application);
frm.txtBox.maxLength := maxLength;
translateWindow(frm);
SetWindowLong(frm.Handle, GWL_HWNDPARENT, 0);
// You must not call SetWindowLong with the GWL_HWNDPARENT index to change the parent of a child window.
// Instead, use the SetParent function.
// SetParent(frm.handle, 0);
if title > '' then
// frm.caption:=getTranslation(title)
frm.Caption := title
// else
;
frm.txtBox.text := '';
frm.AllowNull := AllowNull;
bringForeground := frm.Handle;
// setTopMost(frm, True);
frm.showModal;
frm.BringToFront;
result := frm.exitCode = pwdDlg.EC_enter;
if result then
pwd := trim(frm.txtBox.text);
FreeAndNil(frm);
end; // enterPwdDlg
{$IFDEF RNQ_FULL2}
procedure convertHistoriesDlg(oldPwd, newPwd: AnsiString);
begin
if oldPwd = newPwd then
exit;
if not icq.isOffline then
if messageDlg(getTranslation('You have to be offline for this operation!\nDisconnect?'), mtConfirmation, [mbYes, mbNo], 0) = mrNo
then
exit
else
icq.disconnect;
chatFrm.closeAllPages;
convhistFrm := TconvhistFrm.Create(application);
convhistFrm.oldPwd := oldPwd;
convhistFrm.newPwd := newPwd;
convhistFrm.showModal;
end; // convertHistoriesDlg
{$ENDIF}
function addToRoster(c: TRnQContact; group: integer; const isLocal: Boolean = True): Boolean;
begin
// Add SSI
result := False;
if c = NIL then
exit;
if group = 2000 then
group := 0;
c.group := group;
saveGroupsDelayed := True;
result := addToRoster(c, isLocal) or roasterLib.update(c);
end; // addToRoster
function addToNIL(c: TRnQContact; isBulk: Boolean = False): Boolean;
begin
result := False;
c.fProto.removeContact(c);
if not notInlist.Add(c) then
exit;
if not isBulk then
begin
roasterLib.update(c);
saveListsDelayed := True;
end;
plugins.castEvList(PE_LIST_ADD, PL_NIL, c);
result := True;
end; // addToNIL
procedure NILifNIL(c: TRnQContact; isBulk: Boolean = False);
begin
if Assigned(c) then
if not c.isInRoster then
begin
addToNIL(c, isBulk);
if not isBulk and (c is TICQContact) then
if TICQContact(c).infoUpdatedTo = 0 then
TICQSession(c.fProto).sendQueryInfo(TICQContact(c).uinINT);
end;
end; // eventFrom
function deltree(path: string): Boolean;
var
sr: TsearchRec;
begin
result := False;
if (path = '') or not directoryExists(path) then
exit;
path := includeTrailingPathDelimiter(path);
if findFirst(path + '*.*', faAnyFile, sr) = 0 then
repeat
if (sr.name <> '.') and (sr.name <> '..') then
if sr.Attr and faDirectory > 0 then
deltree(path + sr.name)
else
deleteFile(path + sr.name);
until findNext(sr) <> 0;
findClose(sr);
// path:=ExcludeTrailingPathDelimiter(path);
result := RemoveDir(path);
end; // deltree
function delSUBtree(subPath: string): Boolean;
var
sr: TsearchRec;
path: String;
begin
result := False;
path := myPath + subPath;
if (subPath = '') or (subPath = PathDelim) or (path = '') or not directoryExists(path) then
exit;
subPath := includeTrailingPathDelimiter(subPath);
path := includeTrailingPathDelimiter(path);
if findFirst(path + '*.*', faAnyFile, sr) = 0 then
repeat
if (sr.name <> '.') and (sr.name <> '..') then
if sr.Attr and faDirectory > 0 then
delSUBtree(subPath + sr.name)
else
deleteFile(path + sr.name);
until findNext(sr) <> 0;
findClose(sr);
// path:=ExcludeTrailingPathDelimiter(path);
result := RemoveDir(path);
end; // deltree
function rosterImgNameFor(c: TRnQContact): AnsiString;
begin
if notInlist.exists(c) then
result := status2imgName(byte(SC_UNK), False)
else
// result:=status2imgName(tstatus(c.status), c.invisible)
result := c.fProto.Statuses[c.getStatus].ImageName;
// Result := c.statusImg;
end; // rosterImgIdxFor
{
function statusDraw(cnv:Tcanvas; x,y:integer; s:Tstatus; inv:boolean=FALSE) : TSize;
begin
result := theme.drawPic(cnv, x, y, status2imgName(s, inv),
statusPics[s, inv].tkn, statusPics[s, inv].Loc, statusPics[s, inv].idx)
end; }
function statusDrawExt(const DC: HDC; const x, y: integer; const s: byte; const inv: Boolean = False;
const ExtSts: byte = 0): TSize;
begin
if XStatusAsMain and (ExtSts > 0) then
if DC = 0 then
result := theme.GetPicSize(RQteDefault, XStatusArray[ExtSts].picName)
else
result := theme.drawPic(DC, x, y, XStatusArray[ExtSts].picName)
else
begin
if statusPics[s, inv].picName = '' then
begin
statusPics[s, inv].picName := status2imgName(s, inv);
statusPics[s, inv].pEnabled := True;
statusPics[s, inv].ThemeToken := -1;
statusPics[s, inv].Element := RQteDefault;
end;
if DC = 0 then
result := theme.GetPicSize(statusPics[s, inv])
else
result := theme.drawPic(DC, Point(x, y), statusPics[s, inv])
end;
end;
procedure showAuthreq(c: TRnQContact; msg: string);
var
ar: TauthreqFrm;
begin
msg := dupString(msg);
ar := findAuthReq(c);
if ar = NIL then
TauthreqFrm.doAll(RnQmain, c, msg)
else
begin
ar.msgBox.text := msg;
ar.BringToFront;
end;
end; // showAuthreq
function countContactsIn(proto: TRnQProtocol; const st: byte): integer;
var
cl: TRnQCList;
i: integer;
begin
result := 0;
cl := TRnQCList(proto.readList(LT_ROSTER));
for i := 0 to TList(cl).count - 1 do
if byte(TICQContact(cl[i]).status) = st then
inc(result);
end; // countContactsIn
procedure toggleOnlyOnline;
begin
roasterLib.setOnlyOnline(not showOnlyOnline);
// design_fr.prefToggleOnlyOnline;
end;
procedure toggleOnlyImVisibleTo;
begin
showOnlyImvisibleto := not showOnlyImvisibleto;
saveCfgDelayed := True;
updateHiddenNodes;
end; // toggleOnlyImVisibleto
function setAutomsg(const s: string): string;
begin
result := automessages[0];
automessages[0] := s;
end; // setAutomsg
function applyVars(c: TRnQContact; const s: String; fromAM: Boolean = False): String;
var
h: Tdatetime;
s1, s2: String;
begin
if imAwaySince > 0 then
h := (Now - imAwaySince) * 24
else
h := 0;
result := template(s, ['%awaysince%', formatDatetime(timeformat.automsg, imAwaySince), '%awaysince-gmt%',
formatDatetime(timeformat.automsg, imAwaySince - GMToffset), '%elapsedhours%', IntToStr(trunc(h)), '%elapsedminutes%',
IntToStr(trunc(frac(h) * 60)), '%h%', IntToStr(hourof(Now)), '%m%', IntToStr(minuteof(Now)), '%s%', IntToStr(secondof(Now)),
'%D%', IntToStr(dayof(Now)), '%M%', IntToStr(monthof(Now)), '%Y%', IntToStr(yearof(Now)), '%hh%', IntToStr(hourof(Now), 2),
'%mm%', IntToStr(minuteof(Now), 2), '%ss%', IntToStr(secondof(Now), 2), '%DD%', IntToStr(dayof(Now), 2), '%MM%',
IntToStr(monthof(Now), 2),
{$IFDEF RNQ_PLAYER}
'%track%', uSimplePlayer.RnQPlayer.getPlayingTitle,
{$ENDIF RNQ_PLAYER}
'%onlinecontacts%', IntToStr(TList(Account.AccProto.readList(LT_ROSTER)).count - countContactsIn(Account.AccProto,
byte(SC_OFFLINE))), '%offlinecontacts%', IntToStr(countContactsIn(Account.AccProto, byte(SC_OFFLINE))), '%events%',
IntToStr(eventQ.count)
// '%AutoMess%', ifThen(fromAM, '', getAutomsgFor(c))
]);
if Assigned(c) then
begin
if (c is TICQContact) then
begin
if TICQContact(c).connection.ip = 0 then
s1 := getTranslation(Str_unk)
else
s1 := ip2str(TICQContact(c).connection.ip);
if TICQContact(c).proto = 0 then
s2 := getTranslation(Str_unk)
else
s2 := IntToStr(TICQContact(c).proto);
end
else
begin
s1 := getTranslation(Str_unk);
s2 := s1;
end;
result := template(result, ['%you%', c.displayed, '%nick%', c.nick, '%first%', c.first, '%last%', c.last, '%status%',
getTranslation(c.fProto.Statuses[c.getStatus].Cptn), '%ip%', s1, '%proto%', s2]);
end
else
result := template(result, ['%you%', '', '%nick%', '', '%first%', '', '%last%', '', '%ip%', getTranslation(Str_unk),
'%status%', getTranslation(Str_unk),
// statusNameExt2(byte(SC_OFFLINE)),
'%proto%', getTranslation(Str_unk)]);
end;
function getAutomsgFor(c: TRnQContact): string;
begin
result := applyVars(c, automessages[0], True);
end; // getAutomsg
function getXStatusMsgFor(c: TRnQContact): string;
begin
// result := applyVars(c, curXStatusDesc, True);
// result := applyVars(c, ExtStsStrings[ICQ.curXStatus][1], True);
// result := applyVars(c, ExtStsStrings[TicqSession(c.fProto).curXStatus], True);
if Assigned(c) then
result := applyVars(c, ExtStsStrings[TICQSession(c.fProto).curXStatus].Desc, True)
else
result := applyVars(NIL, ExtStsStrings[TICQSession(Account.AccProto.ProtoElem).curXStatus].Desc, True)
end; // getAutomsg
procedure check4update;
// var
// ct : Tcontact;
begin
// ct.uin := uinToUpdate;
if Account.AccProto.ProtoName = 'ICQ' then
if Account.AccProto.isOnline then
begin
TICQSession(Account.AccProto.ProtoElem).sendQueryInfo(uinToUpdate);
checkupdate.checking := True;
end
else if not checkupdate.autochecking then
OnlFeature(Account.AccProto, False);
// icq.sendSimpleQueryInfo(uinToUpdate);
end; // check4update
function CheckUpdates(cnt: TRnQContact): Boolean;
var
// ss:Tstrings;
v, previewv: Longword;
serial: integer;
ct: TICQContact;
// thisVer:string;
procedure found(v: Longword; build: Longword; preview: Boolean);
var
vs, ps, url: string;
begin
if preview then
url := ct.workpage
else
url := ct.homepage;
// ps:=plugins.castEv(PE_UPDATE_INFO, checkupdate.info, ip2str(v), url, preview, v);
// if isAbort(ps) then exit;
vs := IntToStr(v) + ' ' + getTranslation('Build') + ' ' + IntToStr(build) + ifThen(preview, ' PREVIEW');
ps := ifThen(PREVIEWversion, CRLF + getTranslation('Your version is a "preview"!'), '');
if messageDlg(getTranslation('There''s a new version available! version %s%s\nDo you want to download the new version?',
[vs, ps]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
openURL(url)
end; // found
procedure nothingFound;
begin
if not checkupdate.autochecking then
msgDlg('No new version available', True, mtInformation);
end; // nothingFound
begin
checkupdate.checking := False;
result := False;
if cnt is TICQContact then
ct := TICQContact(cnt)
else
exit;
if (error <> 0) and not checkupdate.autochecking then
begin
msgDlg('Error checking for updates', True, mtError);
exit;
end;
if not matches(ct.nick, 1, 'R&Q Updater') then
exit;
checkupdate.last := Now;
// thisVer:=ip2str(RnQversion);
try
serial := StrToInt64Def(ct.zip, 0);
v := StrToInt64Def(ct.city, RnQBuild);
previewv := StrToInt64Def(ct.state, RnQBuildCustom);
if PREVIEWversion and ((v > RnQBuild) or (previewv > RnQBuildCustom)) then
begin
result := True;
if messageDlg(getTranslation('You are running OLD TEST BUILD!\nRun anyway?'), mtWarning, [mbYes, mbNo], 0) <> mrYes then
openURL(rnqSite)
else
begin
result := False;
// if IsEurekaLogActive then
// {$IFDEF EUREKALOG}
// ExceptionLog7.CurrentEurekaLogOptions.EMailSendMode := esmNoSend;
// ExceptionLog7.CurrentEurekaLogOptions.SaveLogFile := False;
// {$ENDIF EUREKALOG}
// SetEurekaLogState(False);
end;
// msgDlg(getTranslation('StartR&Q: Old Test build'),mtError);
exit;
end;
if (serial > checkupdate.lastSerial) or not checkupdate.autochecking then
begin
if ct.about > '' then
msgDlg(ct.about, True, mtInformation);
// openURL(checkupdate.ct.);
// if pos(thisVer, ss.values['deprecated']) > 0 then
// msgDlg(getTranslation('This version of R&&Q is DEPRECATED\nYou are invited to upgrade as soon as possible'), mtWarning);
// if pos(thisVer, ss.values['block']) > 0 then
// msgDlg(getTranslation('This version of R&&Q is BLOCKED\nYou SHOULD NOT use it, cause it has a serious bug\nPlease upgrade as soon as possible'), mtWarning);
if checkupdate.betas and (previewv > RnQBuildCustom) then
begin
result := True;
found(v, previewv, False)
end
else if v > RnQBuild then
begin
result := True;
found(v, previewv, False);
end
else
nothingFound;
// openURL(ss.values['html-message']);
end
else
nothingFound;
finally
end;
checkupdate.lastSerial := serial;
// saveCFG;
saveCfgDelayed := True;
end;
procedure dockSet;
var
r: Trect;
begin
if RnQmain = NIL then
exit;
r := RnQmain.boundsrect;
dockSet(r);
RnQmain.boundsrect := r;
end; // dockSet
procedure dockSet(var r: Trect);
var
w: integer;
vOn: Boolean;
begin
if not RnQmain.Visible or not running then
exit;
vOn := docking.appBar and docking.active and not docking.tempOff;
if vOn <> docking.appBarFlag then
begin
docking.appBarFlag := vOn;
RnQSysUtils.dockSet(RnQmain.Handle, vOn, WM_DOCK);
end;
if not docking.active then
exit;
w := r.Right - r.Left;
r := desktopworkarea(mainDlg.RnQmain.Handle);
if docking.appBar then
begin
r.Left := 0;
r.Right := screen.Width;
end;
if docking.pos = DP_left then
begin
dec(r.Left, getsystemmetrics(SM_CXFRAME));
r.Right := r.Left + w;
end
else
begin
inc(r.Right, getsystemmetrics(SM_CXFRAME));
r.Left := r.Right - w;
end;
appbarResizeDelayed := True;
end; // dockSet
procedure setAppBarSize;
// var
// r : TRect;
begin
// r := RnQmain.boundsrect;
/// / r.Right := r.Right + 10;
RnQSysUtils.setAppBarSize(RnQmain.Handle, RnQmain.boundsrect, WM_DOCK, docking.pos = DP_left)
end; // setAppBarSize
procedure fixWindowPos(frm: Tform);
var
dwa: Trect;
begin
if frm = NIL then
exit;
if not doFixWindows or docking.active or (frm.WindowState <> wsNormal) then
exit;
dwa := screen.DesktopRect;
// dwa:=desktopWorkArea;
if fixingWindows.lastWidth <> dwa.Right then
begin
if fixingWindows.onTheRight then
frm.Left := dwa.Right - fixingWindows.lastRightSpace;
fixingWindows.lastWidth := dwa.Right;
end;
if frm.Left < (dwa.Left - frm.Width) then
frm.Left := dwa.Left - frm.Width + 10;
if frm.Top < (dwa.Top - frm.Height) then
frm.Top := dwa.Top - frm.Height + 10;
if frm.Left > dwa.Right - 10 then
frm.Left := dwa.Right - 10;
if frm.Top > dwa.Bottom - 10 then
frm.Top := dwa.Bottom - 10;
if frm.Height > screen.Height then
frm.Height := screen.Height - 20;
if frm.Width > screen.Width then
frm.Width := screen.Width - 20;
fixingWindows.onTheRight := centerPoint(frm.boundsrect).x > (screen.Width div 2);
fixingWindows.lastRightSpace := dwa.Right - frm.Left;
end; // fixWindowPos
function isSpam(var wrd: String; c: TRnQContact; msg: string = ''; flags: dword = 0): Boolean;
var
b, filter: Boolean;
s: string;
i: integer;
begin
if (flags and IF_auth > 0) and spamfilter.ignoreauthNIL and
// (not roasterLib.exists(c) or notInList.exists(c))
(notInlist.exists(c) or not c.isInRoster) then
begin
result := True;
exit;
end;
if spamfilter.ignoreNIL and
// (not roasterLib.exists(c) or notInList.exists(c))
(notInlist.exists(c) or not c.isInRoster) or spamfilter.ignorepagers and (IF_pager and flags > 0) then
begin
result := True;
exit;
end;
result := False;
filter := False;
if spamfilter.uingt > 0 then
if TryStrToInt(c.uid, i) and (i <= spamfilter.uingt) then
exit
else
filter := True;
if spamfilter.notnil then
// if roasterLib.exists(c) then exit
if c.isInRoster then
exit
else
filter := True;
if spamfilter.multisend then
if flags and IF_multiple = 0 then
exit
else
filter := True;
if spamfilter.notEmpty then
if ExistsHistWith(c.UID2cmp) then
exit
else
filter := True;
if spamfilter.nobadwords then
begin
b := False;
s := spamfilter.badwords;
while not b and (s > '') do
begin
wrd := chop(';', s);
b := ansiContainsText(msg, wrd);
end;
if b then
filter := True
else
begin
wrd := '';
filter := False;
// exit;
end;
end;
result := filter;
end; // isSpam
function filterRefuse(c: TRnQContact; const msg: string = ''; flags: dword = 0; ev: Thevent = NIL): Boolean;
var
wrd: String;
spamCnt: TRnQContact;
begin
result := True;
wrd := '';
if isSpam(wrd, c, msg, flags) then
begin
if spamfilter.addToHist then
if (msg > '') and (Assigned(ev)) then
begin
// spamCnt:= contactsDB.get(TICQContact, spamsFilename);
spamCnt := contactsDB.Add(c.fProto, spamsFilename);
writeHistorySafely(ev, spamCnt);
// if chatFrm.chats.idxOfUIN(spamsFilename) >= 0 then
chatFrm.addEvent(spamCnt, ev.clone);
end;
if spamfilter.warn then
if wrd > '' then
msgDlg(getTranslation('SPAM FILTERED FROM %s \n BY WORD %s', [c.displayed + ' (' + c.uid + ')', wrd]), False,
mtInformation, c.uid)
else
msgDlg(getTranslation('SPAM FILTERED FROM %s', [c.displayed + ' (' + c.uid + ')']), False, mtInformation, c.uid);
exit;
end;
result := enableIgnoreList and ignoreList.exists(c);
end; // filterRefuse
function db2strU(db: TRnQCList): RawByteString;
var
dim: integer;
procedure addStr(const s: RawByteString);
var
i: integer;
begin
if length(s) > 0 then
begin
i := length(result);
while dim + length(s) > i do
inc(i, 10000);
if i > length(result) then
SetLength(result, i);
system.move(Pointer(s)^, result[dim + 1], length(s));
inc(dim, length(s));
end;
end; // addStr
var
i: integer;
cnt: TRnQContact;
begin
result := '';
dim := 0;
i := 0;
while i < TList(db).count do
begin
cnt := db.getAt(i);
if Assigned(cnt) then
addStr(cnt.GetDBrow);
inc(i);
end;
SetLength(result, dim);
end; // db2str
function str2status(const s: AnsiString): byte;
var
ss: TPicName;
begin
ss := LowerCase(s);
for result := byte(low(status2img)) to byte(high(status2img)) do
// if LowerCase(status2img[TICQStatus(result)]) = s then
if status2img[result] = ss then
exit;
result := byte(SC_ONLINE); // shut up compiler warning
end; // str2status
function str2visibility(const s: AnsiString): Tvisibility;
var
ss: TPicName;
begin
ss := LowerCase(s);
for result := low(result) to high(result) do
if visib2str[result] = ss then
exit;
result := VI_normal; // shut up compiler warning
end; // str2visibility
procedure clearDB(db: TRnQCList);
var
i: integer;
begin
for i := 0 to TList(db).count - 1 do
with db.getAt(i) do
Free;
db.clear;
end; // clearDB
procedure freeDB(var db: TRnQCList);
begin
if not Assigned(db) then
exit;
clearDB(db);
db.Free;
db := NIL;
end; // freeDB
procedure contactCreation(c: TRnQContact);
begin
// getMem(c.data, sizeof(TCE));
// new(TCE(c.data));
c.data := AllocMem(sizeof(TCE));
fillChar(c.data^, sizeof(TCE), 0);
TCE(c.data^).toquery := True;
end;
procedure contactDestroying(c: TRnQContact);
begin
if Assigned(c.data) then
begin
{ if assigned(pTCE(c.data).history0) then
begin
Thistory(pTCE(c.data).history0).Free;
pTCE(c.data).history0 := NIL;
end; }
if Assigned(pTCE(c.data).node) then
FreeAndNil(pTCE(c.data).node);
SetLength(TCE(c.data^).notes, 0);
freeMem(c.data);
end;
end;
procedure startTimer;
begin
RnQmain.timer.enabled := True
end;
procedure stopMainTimer;
begin
RnQmain.timer.enabled := False;
// RnQmain.timer.OnTimer := NIL;
end;
function behave(ev: Thevent; kind: integer = -1 { ; const info: AnsiString='' } ): Boolean;
function IsAnswer(ans: array of string; text: String): Boolean;
var
i: integer;
begin
result := False;
if (length(ans) = 0) then
exit;
for i := Low(ans) to High(ans) do
if (AnsiStartsText(ans[i], text) or AnsiStartsText('<HTML><BODY>' + ans[i], text)) then
begin
result := True;
exit;
end;
end;
procedure Answers0(var ans: array of string);
var
i: integer;
begin
for i := Low(ans) to High(ans) do
SetLength(ans[i], 0);
// SetLength(ans, 0);
end;
const
SpamBotMsgFlags = IF_not_show_chat or IF_not_save_hist or IF_Simple;
var
ok: Boolean;
wnd: TselectCntsFrm;
// str1:string;
// spamCnt : Tcontact;
spmHist: Thistory;
i, j: integer;
ev0: Thevent;
s: string;
fn: string;
foundInSpam: Boolean;
vProto: TRnQProtocol;
tipsAllowed: Boolean;
SkipEvent: Boolean;
picsFound: Boolean;
picsName: TPicName;
gr: Pgroup;
dd: TDivisor;
begin
result := False;
{$IFNDEF DB_ENABLED}
// if info > '' then
// ev.setInfo(info);
{$ENDIF ~DB_ENABLED}
if kind >= 0 then
ev.kind := kind;
case kind of
EK_GCARD, EK_MSG, EK_URL, EK_BUZZ:
ok := not filterRefuse(ev.who, ev.getBodyText, 0, ev);
EK_AUTHREQ:
ok := (not(enableIgnoreList and ignoreList.exists(ev.who))) and (not filterRefuse(ev.who, '', IF_auth));
else
ok := not filterRefuse(ev.who);
end;
if not ok then
exit;
tipsAllowed := IsCanShowNotifications;
vProto := ev.who.fProto;
if (spamfilter.useBotInInvis or (ev.who.imVisibleTo)) and spamfilter.useBot then
if not(vProto.isInList(LT_ROSTER, ev.who) or notInlist.exists(ev.who) or chatFrm.isChatOpen(ev.who)) then
begin
if kind in [EK_typingBeg .. EK_Xstatusreq, EK_incoming, EK_outgoing, EK_auth, EK_authDenied, EK_statuschange] then
exit
else if (IF_offline and ev.flags > 1) then
begin
end
else if kind in [EK_automsgreq, EK_automsg, EK_XstatusMsg, EK_Xstatusreq] then
begin
end
else if ((kind = EK_MSG) and (length(ev.who.antispam.lastQuests) > 0) and IsAnswer(ev.who.antispam.lastQuests,
ev.getBodyText)) then
begin
ev.who.antispam.Tryes := 0;
Answers0(ev.who.antispam.lastQuests);
SetLength(ev.who.antispam.lastQuests, 0);
{$IFNDEF DB_ENABLED}
try
// spamCnt := contactsDB.get(spamsFilename);
spmHist := Thistory.Create;
fn := Account.ProtoPath + historyPath + spamsFilename;
// spmHist.fromString(loadFile(fn));
spmHist.load(vProto.getContact(spamsFilename));
// chatFrm.closeChatWith(spamCnt);
foundInSpam := False;
i := 0;
while i < spmHist.count do
begin
ev0 := spmHist.getAt(i);
ev0.expires := -1;
if ev0.who.equals(ev.who) then
begin
foundInSpam := True;
// OPENCHAT
if // not BossMode.isBossKeyOn and
(BE_openchat in behaviour[ev0.kind].trig) and not vProto.getStatusDisable.OpenChat then
chatFrm.OpenChat(ev0.who);
// SAVE
if logpref.writehistory and (BE_save in behaviour[ev0.kind].trig) then
writeHistorySafely(ev0, ev0.who);
// HISTORY
if BE_history in behaviour[ev0.kind].trig then
chatFrm.addEvent(ev0.who, ev0.clone);
// TRAY
if (ev0.kind = EK_CONTACTS) and chatFrm.isVisible and (ev0.who = chatFrm.thisChat.who) then
TselectCntsFrm.doAll2(RnQmain, getTranslation('from %s', [ev0.who.displayed]),
getTranslation('Add selected contacts'), vProto, ev0.cl.clone, RnQmain.addContactsAction, [sco_multi], @wnd)
else if BE_tray in behaviour[ev0.kind].trig then
eventQ.Add(ev0.clone);
// TIP
if tipsAllowed and not BossMode.isBossKeyOn and (BE_tip in behaviour[ev0.kind].trig) and
(ev0.flags and IF_offline = 0) and not vProto.getStatusDisable.tips then
try
// TipAdd(ev0);
TipAdd3(ev0);
except
end;
spmHist.Delete(i);
end
else
inc(i);
end;
if foundInSpam then
saveFile2(fn, spmHist.toString);
spmHist.Free;
except
end;
{$ENDIF ~DB_ENABLED}
// utilLib.deleteFromTo(fn, getAt(st).fpos, getAt(en).fpos+length(getAt(en).toString));
// history.deleteFromTo(userPath+historyPath + spamCnt.uid, st,en);
Proto_Outbox_add(OE_msg, ev.who, SpamBotMsgFlags, getTranslation(AntiSpamMsgs[2]))
end
else
begin
Answers0(ev.who.antispam.lastQuests);
SetLength(ev.who.antispam.lastQuests, 0);
if logpref.writehistory and (BE_save in behaviour[ev.kind].trig) then
writeHistorySafely(ev, contactsDB.Add(vProto, spamsFilename));
if (BE_history in behaviour[ev.kind].trig) then
// if chatFrm.chats.idxOfUIN(spamsFilename) >= 0 then
chatFrm.addEvent(contactsDB.Add(vProto, spamsFilename), ev.clone);
if ev.who.antispam.Tryes = spamfilter.BotTryesCount then
begin
inc(ev.who.antispam.Tryes);
Proto_Outbox_add(OE_msg, ev.who, SpamBotMsgFlags, AnsiReplaceStr(getTranslation(AntiSpamMsgs[3]), '%uin%', ev.who.uid));
exit;
end
else if ev.who.antispam.Tryes > spamfilter.BotTryesCount then
exit
else
begin
Randomize;
if spamfilter.UseBotFromFile and (length(spamfilter.quests) > 0) then
begin
i := RandomRange(0, length(spamfilter.quests));
// if i >0 then
begin
with spamfilter.quests[i] do
begin
Answers0(ev.who.antispam.lastQuests);
SetLength(ev.who.antispam.lastQuests, length(ans));
for j := 0 to length(ans) - 1 do
ev.who.antispam.lastQuests[j] := ans[j];
s := q;
end;
end
{ else
begin
s := '';
ev.who.antispam.lastQuest := '';
end; }
end
else
begin
i := RandomRange(100, 999);
Answers0(ev.who.antispam.lastQuests);
SetLength(ev.who.antispam.lastQuests, 1);
ev.who.antispam.lastQuests[0] := IntToStr(i);
s := TxtFromInt(i)
end;
if length(ev.who.antispam.lastQuests) > 0 then
begin
inc(ev.who.antispam.Tryes);
if spamfilter.UseBotFromFile and (length(spamfilter.quests) > 0) then
Proto_Outbox_add(OE_msg, ev.who, SpamBotMsgFlags, AnsiReplaceStr(getTranslation(AntiSpamMsgs[5]), '%attempt%',
IntToStr(spamfilter.BotTryesCount + 1 - ev.who.antispam.Tryes)) + CRLF + getTranslation(AntiSpamMsgs[6])
+ CRLF + s)
else
Proto_Outbox_add(OE_msg, ev.who, SpamBotMsgFlags, AnsiReplaceStr(getTranslation(AntiSpamMsgs[5]), '%attempt%',
IntToStr(spamfilter.BotTryesCount + 1 - ev.who.antispam.Tryes)) + CRLF + getTranslation(AntiSpamMsgs[4]) +
CRLF + s);
exit;
end;
end;
end;
end;
// prevent annoying fast oncoming/offgoing sequences
if minOnOff then
if (ev.kind = EK_incoming) and (Now - ev.who.lastTimeSeenOnline < minOnOffTime * DTseconds) or (ev.kind = EK_outgoing) and
(Now - TCE(ev.who.data^).lastOncoming < minOnOffTime * DTseconds) then
exit;
result := True;
if ev.kind in [EK_MSG .. EK_automsg] then
TCE(ev.who.data^).lastEventTime := Now;
if ev.kind in [EK_MSG, EK_URL, EK_BUZZ, EK_CONTACTS, EK_auth, EK_authDenied, EK_AUTHREQ] then
TCE(ev.who.data^).lastMsgTime := ev.when;
// SAVE
if logpref.writehistory and (BE_save in behaviour[ev.kind].trig) then
writeHistorySafely(ev)
else
ev.fpos := -1;
SkipEvent := False;
if DsblEvnt4ClsdGrp and (ev.kind in [EK_incoming, EK_outgoing, EK_statuschange, EK_automsgreq, EK_automsg, EK_typingBeg,
EK_typingFin, EK_XstatusMsg, EK_Xstatusreq]) then
begin
// gr := ev.who.group;
gr := groups.get(ev.who.group);
if OnlOfflInOne then
dd := d_contacts
else
dd := d_online;
SkipEvent := (gr <> NIL) and not gr.expanded[dd];
end;
// SOUND
if not BossMode.isBossKeyOn and (BE_sound in behaviour[ev.kind].trig) and not vProto.getStatusDisable.sounds and not SkipEvent
then
if ev.flags and IF_no_matter = 0 then
begin
picsFound := False;
if UseContactThemes and Assigned(ContactsTheme) then
begin
picsName := TPicName(ev.who.UID2cmp) + '.' + event2str[ev.kind];
picsFound := (ContactsTheme.GetSound(picsName) > '');
if picsFound then
ContactsTheme.PlaySound(picsName)
else
begin
picsName := TPicName('group.') + TPicName(AnsiLowerCase(groups.id2name(ev.who.group))) + '.' +
TPicName(event2str[ev.kind]);
picsFound := (ContactsTheme.GetSound(picsName) > '');
if picsFound then
ContactsTheme.PlaySound(picsName);
end;
end;
if not picsFound then
theme.PlaySound(event2str[ev.kind]);
end;
// TIP
if tipsAllowed and not BossMode.isBossKeyOn and (BE_tip in behaviour[ev.kind].trig) and (ev.flags and IF_offline = 0) and
not vProto.getStatusDisable.tips and not SkipEvent then
if ev.flags and IF_no_matter = 0 then
try
// TipAdd(ev);
TipAdd3(ev);
except
end;
{$IFDEF Use_Baloons}
if not BossMode.isBossKeyOn and (be_BALLOON in behaviour[ev.kind].trig) and (ev.flags and IF_offline = 0) and
not vProto.getStatusDisable.tips and not SkipEvent then
if ev.flags and IF_no_matter = 0 then
ShowBalloonEv(ev);
{$ENDIF Use_Baloons}
// TRAY
if (ev.kind = EK_CONTACTS) and chatFrm.isVisible and (ev.who = chatFrm.thisChat.who) then
TselectCntsFrm.doAll2(RnQmain, getTranslation('from %s', [ev.who.displayed]), getTranslation('Add selected contacts'), vProto,
ev.cl.clone, RnQmain.addContactsAction, [sco_multi], @wnd)
else if (BE_tray in behaviour[ev.kind].trig) and not SkipEvent then
// if ev.flags and IF_no_matter = 0 then
eventQ.Add(ev.clone);
// OPENCHAT
if (BE_openchat in behaviour[ev.kind].trig) and not vProto.getStatusDisable.OpenChat then
if ev.flags and IF_no_matter = 0 then
if chatFrm.OpenChat(ev.who, False, True) then
if not BossMode.isBossKeyOn and (BE_flashchat in behaviour[ev.kind].trig) then
if not ev.kind = EK_BUZZ then
chatFrm.flash;
// HISTORY
if BE_history in behaviour[ev.kind].trig then
if chatFrm.addEvent(ev.who, ev.clone) then
if ev.flags and IF_no_matter = 0 then
if not vProto.getStatusDisable.OpenChat then
if not BossMode.isBossKeyOn and (BE_flashchat in behaviour[ev.kind].trig) then
if not ev.kind = EK_BUZZ then
chatFrm.flash;
// POP UP
if not BossMode.isBossKeyOn and (BE_popup in behaviour[ev.kind].trig) then
if not chatFrm.isVisible then
if not vProto.getStatusDisable.OpenChat then
if ev.flags and IF_no_matter = 0 then
chatFrm.openOn(ev.who, focusOnChatPopup);
// SHAKE IT BABY!
if ev.kind = EK_BUZZ then
if not BossMode.isBossKeyOn and (BE_flashchat in behaviour[ev.kind].trig) then
if chatFrm.Visible then
chatFrm.shake
end; // behave
function beh2str(kind: integer): RawByteString;
var
s: RawByteString;
begin
s := '';
if behaviour[kind].tiptimes then
s := s + 'times(' + IntToStrA(behaviour[kind].tiptimeplus) + ')+';
if BE_tip in behaviour[kind].trig then
s := s + 'tip(' + IntToStrA(behaviour[kind].tiptime) + ')+';
if BE_tray in behaviour[kind].trig then
s := s + 'tray+';
if BE_openchat in behaviour[kind].trig then
s := s + 'openchat+';
if BE_save in behaviour[kind].trig then
s := s + 'save+';
if BE_sound in behaviour[kind].trig then
s := s + 'sound+';
if BE_history in behaviour[kind].trig then
s := s + 'history+';
if BE_popup in behaviour[kind].trig then
s := s + 'popup+';
if BE_flashchat in behaviour[kind].trig then
s := s + 'flashchat+';
if be_BALLOON in behaviour[kind].trig then
s := s + 'balloon+';
Delete(s, length(s), 1);
result := s;
end; // beh2str
procedure str2beh(const b, s: RawByteString);
var
i: byte;
begin
// for e:=EK_last downto 1 do
// for i:=0 to EK_last-1 do
for i := 1 to EK_last do
if b = event2str[i] + '-behaviour' then
behaviour[i] := str2beh(s)
end;
function str2beh(s: AnsiString): Tbehaviour;
const
tipstr = AnsiString('tip');
function extractPar(const lab: AnsiString): AnsiString;
var
i, j: integer;
begin
result := '';
i := AnsiPos(lab + '(', s);
if i > 0 then
begin
inc(i, length(lab) + 1);
j := PosEx(')', s, i);
// j:=i;
// while (length(s) > j) and (s[j]<>')') do
// inc(j);
if j > 0 then
result := Copy(s, i, j - i)
else
result := ''
end;
end; // extractPar
var
tS: AnsiString;
begin
result.trig := [];
result.tiptime := 0;
result.tiptimes := False;
result.tiptimeplus := 0;
s := LowerCase(s);
result.tiptimes := ansiContainsText(s, AnsiString('times'));
try
tS := extractPar(AnsiString('times'));
if tS <> '' then
result.tiptimeplus := strToInt(tS)
except
end;
if ansiContainsText(s, tipstr) then
include(result.trig, BE_tip);
try
tS := extractPar(tipstr);
if tS <> '' then
result.tiptime := strToInt(tS)
except
end;
if ansiContainsText(s, AnsiString('tray')) then
include(result.trig, BE_tray);
if ansiContainsText(s, AnsiString('openchat')) then
include(result.trig, BE_openchat);
if ansiContainsText(s, AnsiString('save')) then
include(result.trig, BE_save);
if ansiContainsText(s, AnsiString('sound')) then
include(result.trig, BE_sound);
if ansiContainsText(s, AnsiString('history')) then
include(result.trig, BE_history);
if ansiContainsText(s, AnsiString('popup')) then
include(result.trig, BE_popup);
if ansiContainsText(s, AnsiString('flashchat')) then
include(result.trig, BE_flashchat);
if ansiContainsText(s, AnsiString('balloon')) then
include(result.trig, be_BALLOON);
end; // str2beh
// function event2imgidx(e:integer):integer;
function event2imgName(e: integer): AnsiString;
begin
case e of
EK_URL:
result := PIC_URL;
EK_MSG:
result := PIC_MSG;
EK_CONTACTS:
result := PIC_CONTACTS;
EK_ADDEDYOU:
result := PIC_ADDEDYOU;
EK_AUTHREQ:
result := PIC_AUTH_REQ;
EK_typingBeg:
result := PIC_TYPING;
EK_typingFin:
result := PIC_TYPING;
EK_incoming:
result := PIC_ONCOMING;
EK_outgoing:
result := PIC_OFFGOING;
EK_file:
result := PIC_FILE;
EK_GCARD:
result := PIC_GCARD;
EK_BUZZ:
result := PIC_BUZZ;
else
result := PIC_OTHER_EVENT;
end;
end; // event2imgidx
procedure hideTaskButtonIfUhave2;
begin
if not menuViaMacro then
ShowWindow(application.Handle, SW_HIDE)
end;
function registerHK(id: integer; hk: word): Boolean;
var
m: integer;
begin
m := 0;
if hk and $1000 > 0 then
inc(m, MOD_WIN);
if hk and $2000 > 0 then
inc(m, MOD_SHIFT);
if hk and $4000 > 0 then
inc(m, MOD_CONTROL);
if hk and $8000 > 0 then
inc(m, MOD_ALT);
result := RegisterHotKey(RnQmain.Handle, id, m, LOBYTE(hk));
end; // registerHK
function updateSWhotkeys: Boolean;
var
i: integer;
begin
result := False;
if RnQmain = nil then
exit;
removeSWhotkeys;
result := True;
for i := 0 to length(macros) - 1 do
if macros[i].sw then
result := registerHK(i, macros[i].hk) and result;
end; // updateSWhotkeys
procedure removeSWhotkeys;
var
i: integer;
begin
for i := 0 to 200 do
unregisterHotKey(RnQmain.Handle, i);
end; // removeSWhotkeys
{
procedure saveRetrieveQ;
begin
if fantomWork then Exit;
if retrieveQ.empty then
deleteFile(userPath+retrieveFileName1)
else
saveFile(userPath+retrieveFileName1, retrieveQ.toString);
end; // saveRetrieveQ
}
procedure addToIgnorelist(c: TRnQContact; const Local_only: Boolean = False);
// var
// i : Byte;
begin
if (c = NIL) or ignoreList.exists(c) then
exit;
ignoreList.Add(c);
if
{$IFDEF UseNotSSI}
// icq.useSSI and
(not(c.iProto.ProtoElem is TICQSession) or TICQSession(c.iProto.ProtoElem).useSSI) and
{$ENDIF UseNotSSI}
not Local_only then
// activeICQ.add2ignore(c);
c.fProto.AddToList(LT_SPAM, c);
// activeICQ.SSI_AddVisItem(c.UID, FEEDBAG_CLASS_ID_IGNORE_LIST);
{ for i := Low(prefPages) to High(prefPages) do
if prefPages[i].Name = 'Ignore list' then
if Assigned(prefPages[i].frame) then
TignoreFr(prefPages[i].frame).ignoreBox.addItem(c.displayed,c);
}
saveListsDelayed := True;
end; // addToIgnorelist
procedure removeFromIgnorelist(c: TRnQContact);
// var
// i : Byte;
begin
if (c = NIL) or not ignoreList.exists(c) then
exit;
ignoreList.remove(c);
{$IFDEF UseNotSSI}
// if icq.useSSI then
if (not(c.iProto.ProtoElem is TICQSession) or TICQSession(c.iProto.ProtoElem).useSSI) then
{$ENDIF UseNotSSI}
begin
// if ICQ.readList(LT_SPAM).exists(c) then
c.fProto.RemFromList(LT_SPAM, c);
// ICQ.SSI_DelVisItem(c.UID, FEEDBAG_CLASS_ID_IGNORE_LIST);
end;
{ for i := Low(prefPages) to High(prefPages) do
if prefPages[i].Name = 'Ignore list' then
if Assigned(prefPages[i].frame) then
with TignoreFr(prefPages[i].frame).ignoreBox do
items.delete(items.indexOfObject(c));
}
saveListsDelayed := True;
end; // removeFromIgnorelist
procedure removeFromRoster(c: TRnQContact; const withHistory: Boolean = False);
var
grp: integer;
begin
if c = NIL then
exit;
if c.isInRoster then
plugins.castEvList(PE_LIST_REMOVE, PL_ROSTER, c);
grp := c.group;
roasterLib.remove(c);
// c.iProto.removeContact(c);
if withHistory then
DelHistWith(c.UID2cmp);
// if FileExists(userPath + historyPath + c.UID) then
// DeleteFile(userPath + historyPath + c.UID);
if (grp > 0) and (TRnQCList(c.fProto.readList(LT_ROSTER)).getCount(grp) = 0) then
if messageDlg(getTranslation('This group (%s) is empty! Do you want to delete it?', [groups.id2name(grp)]), mtConfirmation,
[mbYes, mbNo], 0) = mrYes then
roasterLib.removeGroup(grp);
c.group := 0;
end; // removeFromRoster
procedure realizeEvents(const kind_: integer; c: TRnQContact);
var
k: integer;
ev0: Thevent;
begin
k := -1;
repeat
k := eventQ.getNextEventFor(c, k);
// if (ev0 = nil) then
// Break;
// if ev0.kind in clearEvents then
// begin
// if not chatFrm.moveToTimeOrEnd(c, ev0.when) then
// chatFrm.addEvent(c, ev0.clone);
// k := eventQ.find(t, c);
if (k >= 0) and (k < eventQ.count) then
begin
ev0 := Thevent(eventQ.items[k]);
if (kind_ < 0) or (ev0.kind = kind_) then
begin
eventQ.removeAt(k);
realizeEvent(ev0);
end;
// if ev0.kind in clearEvents then
// eventQ.removeAt(k);
// end
// eventQ.Remove(ev0);
// else
;
end;
until (k < 0);
end;
procedure realizeEvent(ev: Thevent);
var
wnd: TselectCntsFrm;
{$IFDEF usesDC}
dd: TProtoDirect;
{$ENDIF usesDC}
// ev0:Thevent;
begin
if not Assigned(ev) then
exit;
roasterLib.redraw(ev.who);
TipRemove(ev);
if ev.kind in [EK_ADDEDYOU, EK_AUTHREQ, EK_MSG, EK_GCARD, EK_URL, EK_CONTACTS] then
NILifNIL(ev.who);
case ev.kind of
EK_ADDEDYOU:
if ev.who.isInList(LT_ROSTER) then
msgDlg(getTranslation('%s added you to his/her contact list.', [ev.who.displayed]), False, mtInformation)
else if messageDlg(getTranslation('%s added you to his/her contact list.\nDo you want to add him/her to your contact list?',
[ev.who.displayed]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
addToRoster((ev.who));
EK_AUTHREQ:
showAuthreq((ev.who), ev.getBodyText);
EK_incoming:
if showOncomingDlg then
msgDlg(getTranslation('%s is online', [ev.who.displayed]), False, mtInformation);
EK_file:
begin
{$IFDEF usesDC}
dd := TICQSession(ev.who.fProto).directs.findID(ev.id);
if Assigned(dd) then
receiveFile(dd);
{$ENDIF usesDC}
end;
EK_GCARD, EK_URL, EK_MSG:
with chatFrm do
begin
openOn(ev.who);
// moveToTimeOrEnd(ev.who, ev.when);
// ev0:=eventQ.firstEventFor(ev.who);
// if (ev0 = nil)or(ev = ev0) then
begin
// if not chatFrm.moveToTimeOrEnd(ev.who, ev.when) then
if not chatFrm.moveToTimeOrEnd(ev.who, ev.when, False) then
chatFrm.addEvent(ev.who, ev.clone);
end
// else
// begin
// sdfsdf
// end;