You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
4759 lines
143 KiB
Plaintext
4759 lines
143 KiB
Plaintext
{
|
||||
This file is part of R&Q.
|
||||
Under same license
|
||||
}
|
||||
unit ChatBox;
|
||||
{$I RnQConfig.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows, Winapi.Messages,
|
||||
System.SysUtils, System.Classes, System.Character, System.Types, System.StrUtils, System.DateUtils,
|
||||
System.NetEncoding, System.Variants, System.JSON, System.RegularExpressionsCore, System.RegularExpressionsConsts, System.Win.TaskbarCore,
|
||||
Generics.Collections, Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.Imaging.PNGImage, Vcl.Taskbar,
|
||||
Sciter, SciterApi, RDGlobal, RnQNet, ICQCommon, ICQContacts, history, events, utilLib, pluginLib, Stickers, GR32, SQLiteDB, BaseWindow;
|
||||
|
||||
{$I PubRTTI.inc}
|
||||
|
||||
type
|
||||
TLinkKind = (LK_FTP, LK_EMAIL, LK_WWW, LK_UIN, LK_ED);
|
||||
TDrawStyle = (dsNone, dsBuffer, dsMemory, dsGlobalBuffer32);
|
||||
|
||||
TItemKind = (PK_NONE, PK_HEAD, PK_TEXT, PK_ARROWS_UP, PK_ARROWS_DN, PK_LINK, PK_SMILE, PK_CRYPTED, PK_RQPIC, PK_RQPICEX, PK_RNQBUTTON);
|
||||
TSendAction = (SA_APPEND, SA_PREPEND, SA_UPDATE);
|
||||
|
||||
TChatItem = record
|
||||
kind: TItemKind;
|
||||
stringData: String;
|
||||
timeData: TDateTime;
|
||||
end;
|
||||
|
||||
TMessageData = record
|
||||
what, when, prefix, prefixCls, msg, embedded, cls, time, msgid,
|
||||
statusImg, statusImgExt, eventImg, cryptImg: String;
|
||||
encrypted, writeHist: Boolean;
|
||||
patches: TParams;
|
||||
end;
|
||||
|
||||
TPageSettings = record
|
||||
splitX, splitY: Integer;
|
||||
tiled, positioned: String
|
||||
end;
|
||||
|
||||
TChatSettings = record
|
||||
showSmiles, showRelTimes, showAvatar, showSmileCaption, showHintsInChat, showSmartReplies, autoCopy, smoothFontRendering, fontCodes,
|
||||
viewTextWrap, animatedScroll, quoteSelected, cursorBelow, alwaysOnTop: Boolean;
|
||||
wheelVelocity, imageQuality, maxImgWidth, maxImgHeight, msgBuffer, sendOnEnter, spellErrorStyle, screenshotFormat: Integer;
|
||||
cachePath, spellErrorColor, screenshotFilename, chatCSS: String;
|
||||
end;
|
||||
|
||||
TVideoFormat = record
|
||||
url: String;
|
||||
quality: String;
|
||||
format: String;
|
||||
codecs: String;
|
||||
title: String;
|
||||
end;
|
||||
|
||||
TParamPair = record
|
||||
param: String;
|
||||
value: String;
|
||||
end;
|
||||
|
||||
{$I NoRTTI.inc}
|
||||
|
||||
TChatType = (CT_IM, CT_PLUGING);
|
||||
|
||||
PChatInfo = ^TChatInfo;
|
||||
TChatInfo = class
|
||||
public
|
||||
ID: IntPtr;
|
||||
chatType: TChatType;
|
||||
who: TICQContact;
|
||||
single: Boolean; // single-message
|
||||
lastInputText: string; // last input.text before quoting sequence
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure CheckTypingTime;
|
||||
end;
|
||||
|
||||
TChats = class(Tlist)
|
||||
function validIdx(i: Integer): boolean;
|
||||
function idxOf(c: TICQContact): Integer;
|
||||
function idxOfUIN(const uin: TUID): Integer;
|
||||
function idxOfID(ID: Integer): Integer;
|
||||
function byIdx(i: Integer): TChatInfo;
|
||||
function byContact(c: TICQContact): TChatInfo;
|
||||
function byUIN(const uid: TUID): TChatInfo;
|
||||
function byID(id: Integer): TChatInfo;
|
||||
procedure CheckTypingTimeAll;
|
||||
end;
|
||||
|
||||
TInputCallback = procedure(Sender: TObject; selected: String = '') of object;
|
||||
|
||||
TTaskbarEx = class(TTaskbar)
|
||||
protected
|
||||
function GetFormHandle: HWND; override;
|
||||
public
|
||||
function GetMainWindowHwnd: HWND; override;
|
||||
end;
|
||||
|
||||
TChatBox = class(TBaseWindow)
|
||||
private
|
||||
Preview: Boolean;
|
||||
TaskBar: TTaskbarEx;
|
||||
selectedText: String;
|
||||
StartSel, EndSel: TDateTime;
|
||||
IsWholeEvents: Boolean;
|
||||
histories: TObjectDictionary |
||||
public
|
||||
CurrentContact: TICQContact;
|
||||
LastContact: TICQContact;
|
||||
|
||||
Chats: TChats;
|
||||
selectedUIN: TUID;
|
||||
plugBtns: TPlugButtons;
|
||||
MainFormWidth: Integer;
|
||||
menuWasCancelled: boolean;
|
||||
PagesEnumStr: String;
|
||||
DraggingTab: Boolean;
|
||||
|
||||
constructor Create(MsgPreview: Boolean = False);
|
||||
destructor Destroy; override;
|
||||
function ChatWndProc(var Message: TMessage): Boolean;
|
||||
|
||||
procedure Show;
|
||||
procedure Hide;
|
||||
procedure Resize;
|
||||
procedure UpdateCaption(const Caption: String);
|
||||
|
||||
function IsChatOpen(otherHand: TICQContact): boolean;
|
||||
function OpenChat(otherHand: TICQContact; ForceActive: Boolean = False; isAuto: Boolean = False): Boolean;
|
||||
function OpenOn(c: TICQContact; focus: Boolean = True; pShow: Boolean = True): Boolean;
|
||||
procedure Open(Focus: Boolean = True);
|
||||
function NewIMChannel(c: TICQContact): Integer;
|
||||
procedure UpdateAvatar(c: TICQContact); overload;
|
||||
function ThisChat: TChatInfo;
|
||||
function ThisChatUID: TUID;
|
||||
procedure SetCurrent(idx: Integer);
|
||||
procedure UserChanged(c: TICQContact);
|
||||
procedure CloseThisPage;
|
||||
procedure CloseAllPages(isAuto: boolean = false);
|
||||
procedure ClosePageAt(idx: Integer);
|
||||
procedure CloseChat(ci: TChatInfo);
|
||||
procedure CloseChatWith(c: TICQContact);
|
||||
procedure CloseChatUID(const UID: TUID);
|
||||
procedure CloseChatID(ID: Integer);
|
||||
function SawAllHere: boolean;
|
||||
function isVisible: boolean;
|
||||
procedure UpdateContactStatus(cnt: TICQContact = nil);
|
||||
procedure UpdateChatPreviewArea;
|
||||
procedure SetStatusbar(const s: String);
|
||||
function HasEvent(c: TICQContact; ev: Thevent): Boolean;
|
||||
procedure MoveToEvent(c: TICQContact; ev: Thevent);
|
||||
procedure SetUnreadEvent(c: TICQContact; ev: Thevent);
|
||||
function thisContact: TICQContact;
|
||||
procedure Flash;
|
||||
procedure Shake;
|
||||
function Pages2String: String;
|
||||
procedure LoadPages(const s: String); overload;
|
||||
procedure LoadPages(const cl: TRnQCList); overload;
|
||||
procedure UpdateGraphics(c: TICQContact = nil);
|
||||
|
||||
procedure Init;
|
||||
procedure InitDocument;
|
||||
procedure RefreshTaskbarButtons;
|
||||
procedure InitSpellCheck;
|
||||
procedure SpellCheck;
|
||||
procedure SetupStickersButton;
|
||||
|
||||
procedure ApplyTitleColors(Active: Boolean);
|
||||
|
||||
procedure InitPage(cnt: TICQContact);
|
||||
procedure OpenPage(cnt: TICQContact; focused: Boolean = False); overload;
|
||||
procedure OpenPage(ID: Integer; const Caption: String); overload;
|
||||
procedure ClosePage(UID: TUID = ''); overload;
|
||||
procedure ClosePage(id: Integer); overload;
|
||||
procedure SwitchToPage(const UID: TUID); overload;
|
||||
procedure SwitchToPage(id: Integer); overload;
|
||||
procedure SwitchToNextPage;
|
||||
procedure SwitchToPrevPage;
|
||||
procedure UpdateSpelling(data: Variant);
|
||||
procedure RedrawTabs;
|
||||
procedure RedrawTab(c: TICQContact); overload;
|
||||
procedure RedrawTab(c: TICQContact; hash, hashadd: LongWord); overload;
|
||||
procedure RedrawTab(id: Integer; const caption: String; hash: LongWord); overload;
|
||||
procedure RedrawPluginTab(ci: TChatInfo);
|
||||
procedure ClearEvents(const UID: TUID = '');
|
||||
procedure DeleteEvent(const UID: TUID; MsgID: TMsgID);
|
||||
procedure DeleteEvents(const UID: TUID; st, en: TDateTime);
|
||||
procedure InitSettings;
|
||||
procedure InitMsgPreview;
|
||||
procedure UpdateSmiles;
|
||||
procedure ReloadSmiles;
|
||||
procedure PreloadPickers;
|
||||
procedure LoadStickers;
|
||||
procedure LoadSearchResults;
|
||||
procedure PageFire(const UID: TUID; cmd: UINT; data: Variant); overload;
|
||||
procedure PageFire(id: Integer; cmd: UINT; data: Variant); overload;
|
||||
procedure PageCall(const UID: TUID; const method: AnsiString; const args: TParams); overload;
|
||||
procedure PageCall(id: Integer; const method: AnsiString; const args: TParams); overload;
|
||||
function GetPage(const UID: TUID): HELEMENT; overload;
|
||||
function GetPage(id: Integer): HELEMENT; overload;
|
||||
function GetLastEventTime(const UID: TUID): TDateTime;
|
||||
procedure AddChatItem(var Params: TParams; var MsgData: TMessageData; Evt: Thevent; Animate: Boolean);
|
||||
procedure SendChatItems(const UID: TUID; var Params: TParams; Action: TSendAction = SA_APPEND);
|
||||
procedure HideHistory(const UID: TUID);
|
||||
procedure ViewInWindow(const title, body: String; const when: String; const formicon: String = '');
|
||||
procedure ShowServerHistoryNotif(const UID: TUID);
|
||||
procedure ShowSearchHere;
|
||||
procedure FinishImage(const link: String);
|
||||
function GetHistory(const UID: TUID): Thistory;
|
||||
function GetPluginBounds: TRect;
|
||||
procedure AddPluginButton(i: Integer);
|
||||
procedure DelPluginButton(i: Integer);
|
||||
procedure ModifyPluginButton(i: Integer);
|
||||
procedure SetSendBtnImage(const pic: TPicName);
|
||||
procedure ClearAvatar(const UID: TUID);
|
||||
procedure UpdateAvatar(const UID: TUID); overload;
|
||||
procedure SetupChatButtons;
|
||||
procedure SetupSingleBtn(status: Boolean);
|
||||
procedure SetupFileBtn(status: Boolean);
|
||||
procedure SetupStickersBtn(status: Boolean);
|
||||
procedure SetupBuzzBtn(status: Boolean);
|
||||
procedure ResetHistory;
|
||||
procedure ApplyTheme;
|
||||
procedure AddToCurrentInput(const s: String);
|
||||
function FileUpload(Compress: Boolean; fn: String = ''): String;
|
||||
|
||||
procedure MoveToTime(const UID: TUID; time: TDateTime; fast: Boolean = False);
|
||||
procedure SetFirstUnreadEvent(const UID: TUID; time: TDateTime);
|
||||
function getSelHtml(smiles: boolean): String;
|
||||
function WholeEventsAreSelected: Boolean;
|
||||
|
||||
procedure SetSelection(const UID: TUID; from, to_: TDateTime);
|
||||
procedure ClearSelection(const UID: TUID);
|
||||
procedure SelectionAll(const UID: TUID);
|
||||
|
||||
function AddEvent_OpenChat(otherHand: TICQContact; ev: Thevent): Boolean;
|
||||
function AddEvent(Cnt: TICQContact; Ev: Thevent): Boolean; overload;
|
||||
procedure AddEvent(const UID: TUID; Ev: Thevent); overload;
|
||||
function UpdateEvent(Cnt: TICQContact; Ev: Thevent): Boolean; overload;
|
||||
procedure UpdateEvent(const UID: TUID; var Ev: Thevent); overload;
|
||||
procedure ScrollEvent(d: Integer);
|
||||
procedure ScrollLine(d: Integer);
|
||||
procedure ScrollWheel(d: Integer);
|
||||
procedure ScrollToTop(animate: Boolean);
|
||||
procedure Quote(const QS: String = ''; LimitWidth: Boolean = False);
|
||||
procedure UpdateMsgStatus(hev: Thevent);
|
||||
procedure UpdateStatusBar;
|
||||
procedure UpdateRelTimes;
|
||||
procedure SetStatusBarHint(const hint: String);
|
||||
procedure SetSmartReplies(Contact: TICQCOntact; const suggests: TArray |
||||
|
||||
function ParseMessageBody(const body: String): String;
|
||||
procedure ReplaceSmileMatch(Sender: TObject; var ReplaceWith: PCREString);
|
||||
procedure ReplaceOtherMatch(Sender: TObject; var ReplaceWith: PCREString);
|
||||
function GetReplacement(args: TArray |
||||
function ReplaceEmoji(const msg: String): String;
|
||||
|
||||
procedure DisplayHint(Sender: TObject);
|
||||
procedure TaskBarThumbButtonClick(Sender: TObject; AButtonID: Integer);
|
||||
end;
|
||||
|
||||
function CHAT_TAB_ADD(Control: Integer; iIcon: HIcon; const TabCaption: String): Integer;
|
||||
procedure CHAT_TAB_MODIFY(Control: Integer; iIcon: HIcon; const TabCaption: String);
|
||||
procedure CHAT_TAB_DELETE(Control: Integer);
|
||||
|
||||
procedure OnChatShow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure OnChatHide(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure OnChatResize(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure OnChatActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure OnChatMouseEnter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure OnChatMouseLeave(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure UpdateChatXY(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure AttachWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure DetachWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
|
||||
procedure LoadHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure UpdateSelection(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure UploadLastSnapshot(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure DeleteSnapshot(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure UploadFiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetLinkInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetYoutubeLinks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetVimeoLinks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetVolumeLevel(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SaveVolumeLevel(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ChatPageSelected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ChatPageDeselected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure PluginPageSelected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure PluginPageDeselected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SetTabDragging(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure CloseChatPage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ClosePluginPage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure AddUIN2CL(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure CopyLink(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SavePicture(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetEvent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SaveAs(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure AddLinkToFav(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure DeleteMessages(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure AddToAntispam(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ToggleSmiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ToggleRelTimes(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure RealizeEvents(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure StoreSplit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure InputChangedFor(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetMessageByIdx(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure WrapText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SendChatMessage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure EditChatMessage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetChatMessageText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ClosePages(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure UploadFile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SaveEmbeddedFile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ChatButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure PluginButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure ToggleTranslit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
// procedure QIPPwd(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SendStickerToCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetStoreStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure SearchStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure BuyStickerPack(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure RemoveStickerPack(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetStickerPackContent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetSpellingSuggestions(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
procedure GetEventHeaderTime(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
|
||||
var
|
||||
UploadCallbacks: TCallbacks;
|
||||
TabsIconCache: TObjectDictionary |
||||
EmbeddedImgs: TDictionary |
||||
MouseHook: Cardinal;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Math, Clipbrd, SciterLib,
|
||||
RnQSysUtils, RnQLangs, RDFileUtil, RDUtils, RnQBinUtils, RnQGraphics32,
|
||||
RQUtil, RQThemes, RnQGlobal, RnQCrypt, RnQPics, RnQDialogs, RnQ_Avatars, RnQTips, Protocols_all,
|
||||
globalLib, iniLib, outboxLib, langLib, groupsLib, roasterLib, themesLib,
|
||||
ICQConsts, ICQSession, Base64, Murmur2, EmojiConst, SpellCheck, HiddenForm, RQLog,
|
||||
mainDlg, selectcontactsDlg, outboxDlg, HTTPStatus;
|
||||
|
||||
const
|
||||
emojiExtNumbers: array [0..7] of Integer = (984, 1110, 386, 507, 501, 822, 694, 227);
|
||||
emojiExtHints: array [0..7] of String = ('People', 'Nature', 'Foods', 'Activity', 'Travel', 'Objects', 'Symbols', 'Flags');
|
||||
|
||||
var
|
||||
vKeyPicElm: TRnQThemedElementDtls;
|
||||
msgRegex, youtubeRegex, vimeoRegex: TPerlRegEx;
|
||||
IsLastParsedEventMine: Boolean = False;
|
||||
emojiSize: Integer = 22;
|
||||
emojisInARow: Integer = 36;
|
||||
emojiContents: TDictionary |
||||
|
||||
constructor TChatInfo.Create;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
destructor TChatInfo.Destroy;
|
||||
begin
|
||||
who := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
{ TChats }
|
||||
|
||||
{$WARN UNSAFE_CAST OFF}
|
||||
function TChats.idxOfUIN(const uin: TUID): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
while Result < count do
|
||||
begin
|
||||
if TchatInfo(items[Result]).chatType = CT_IM then
|
||||
if TchatInfo(items[Result]).who.equals(uin) then
|
||||
Exit;
|
||||
Inc(Result);
|
||||
end;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TChats.idxOfID(ID: Integer): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
while Result < count do
|
||||
begin
|
||||
if TchatInfo(items[Result]).chatType = CT_PLUGING then
|
||||
if TchatInfo(items[Result]).ID = ID then
|
||||
Exit;
|
||||
Inc(Result);
|
||||
end;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TChats.idxOf(c: TICQContact): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
while Result < count do
|
||||
begin
|
||||
if Assigned(items[Result]) then
|
||||
if TchatInfo(items[Result]).chatType = CT_IM then
|
||||
if TchatInfo(items[Result]).who.equals(c) then
|
||||
Exit;
|
||||
Inc(Result);
|
||||
end;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TChats.byIdx(i: Integer): TchatInfo;
|
||||
begin
|
||||
Result := nil;
|
||||
if validIdx(i) then
|
||||
Result := TchatInfo(items[i])
|
||||
end;
|
||||
{$WARN UNSAFE_CAST ON}
|
||||
|
||||
function TChats.byContact(c: TICQContact): TchatInfo;
|
||||
begin
|
||||
Result := byIdx(idxOf(c))
|
||||
end;
|
||||
|
||||
function TChats.byUIN(const UID: TUID): TchatInfo;
|
||||
begin
|
||||
Result := byIdx(idxOfUIN(UID))
|
||||
end;
|
||||
|
||||
function TChats.byID(id: Integer): TchatInfo;
|
||||
begin
|
||||
Result := byIdx(idxOfID(id))
|
||||
end;
|
||||
|
||||
function TChats.validIdx(i: Integer): boolean;
|
||||
begin
|
||||
Result := (i >= 0) and (i < count)
|
||||
end;
|
||||
|
||||
procedure TChats.CheckTypingTimeAll;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if Assigned(Account.AccProto) then
|
||||
if (Account.AccProto.SupportTypingNotif) and (Account.AccProto.IsSendTypingNotif) then
|
||||
if Count > 0 then
|
||||
for I := Count - 1 downto 0 do
|
||||
if TChatInfo(Items[I]).chatType = CT_IM then
|
||||
if Assigned(TChatInfo(Items[I]).who) then
|
||||
TChatInfo(Items[I]).CheckTypingTime;
|
||||
end;
|
||||
|
||||
{ TTaskbarEx }
|
||||
|
||||
function TTaskbarEx.GetFormHandle: HWND;
|
||||
begin;
|
||||
Result := UI.Chat.Window;
|
||||
end;
|
||||
|
||||
function TTaskbarEx.GetMainWindowHwnd: HWND;
|
||||
begin
|
||||
Result := UI.Chat.Window;
|
||||
end;
|
||||
|
||||
{ TChatBox }
|
||||
|
||||
function TChatBox.OpenChat(otherHand: TICQContact; ForceActive: Boolean = False; isAuto: Boolean = False): Boolean;
|
||||
const
|
||||
MaxNILpages = 101;
|
||||
var
|
||||
i, k: Integer;
|
||||
wasEmpty, alreadyThere: boolean;
|
||||
cnt: TICQContact;
|
||||
firstNILpage, NILcount: Integer;
|
||||
begin
|
||||
wasEmpty := chats.Count = 0;
|
||||
i := chats.idxOf(otherHand);
|
||||
Result := i < 0;
|
||||
if Result then
|
||||
i := NewIMChannel(otherHand);
|
||||
|
||||
alreadyThere := otherHand.equals(CurrentContact);
|
||||
if wasEmpty then
|
||||
begin
|
||||
if i >= 0 then
|
||||
setCurrent(i);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not alreadyThere and ForceActive then
|
||||
if i >= 0 then
|
||||
setCurrent(i)
|
||||
else
|
||||
setCurrent(chats.idxOf(otherHand));
|
||||
|
||||
if isAuto then
|
||||
begin // protection against bruteforce
|
||||
firstNILpage := -1;
|
||||
NILcount := 0;
|
||||
for k := 0 to chats.count - 1 do
|
||||
begin
|
||||
if chats.byIdx(k).chatType = CT_IM then
|
||||
begin
|
||||
cnt := chats.byIdx(k).who;
|
||||
if Assigned(cnt) and notInList.exists(cnt) then
|
||||
begin
|
||||
Inc(NILcount);
|
||||
if firstNILpage < 0 then
|
||||
firstNILpage := k;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (firstNILpage >= 0) and (NILcount > MaxNILpages) then
|
||||
ClosePageAt(firstNILpage);
|
||||
end;
|
||||
end;
|
||||
if ForceActive and not Visible then
|
||||
Show;
|
||||
end;
|
||||
|
||||
function TChatBox.IsChatOpen(otherHand: TICQContact): boolean;
|
||||
begin
|
||||
Result := chats.idxOf(otherHand) >= 0
|
||||
end;
|
||||
|
||||
procedure TChatBox.Init;
|
||||
begin
|
||||
InitDocument;
|
||||
InitSpellCheck;
|
||||
InitSettings;
|
||||
end;
|
||||
|
||||
procedure TChatBox.InitDocument;
|
||||
begin
|
||||
SetBounds(ChatXY);
|
||||
theme.smileNotify := ReloadSmiles;
|
||||
if EnableStickers then
|
||||
begin
|
||||
PreloadPickers;
|
||||
LoadStickers;
|
||||
end;
|
||||
CreateThreading;
|
||||
end;
|
||||
|
||||
procedure TChatBox.InitSpellCheck;
|
||||
begin
|
||||
DoInitSpellCheck;
|
||||
end;
|
||||
|
||||
procedure TChatBox.SpellCheck;
|
||||
begin
|
||||
DoSpellCheck;
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupStickersButton;
|
||||
begin
|
||||
SetupStickersBtn(EnableStickers);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetCurrent(idx: Integer);
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
if idx < 0 then
|
||||
Exit;
|
||||
|
||||
ch := chats.byIdx(idx);
|
||||
if Assigned(ch) then
|
||||
if ch.chatType = CT_PLUGING then
|
||||
SwitchToPage(ch.ID)
|
||||
else
|
||||
SwitchToPage(ch.who.UID);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UserChanged(c: TICQContact);
|
||||
var
|
||||
i: Integer;
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
if c = nil then
|
||||
Exit;
|
||||
ch := thisChat;
|
||||
if ch = nil then
|
||||
Exit;
|
||||
i := chats.idxOf(c);
|
||||
if i < 0 then
|
||||
Exit;
|
||||
UpdateContactStatus(c);
|
||||
RefreshTaskbarButtons;
|
||||
end;
|
||||
|
||||
function TChatBox.OpenOn(c: TICQContact; focus: Boolean = True; pShow: Boolean = True): Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
if c = nil then
|
||||
Exit;
|
||||
i := chats.idxOf(c);
|
||||
if i < 0 then
|
||||
begin
|
||||
Result := True;
|
||||
i := NewIMChannel(c);
|
||||
end;
|
||||
if i >= 0 then
|
||||
SetCurrent(i);
|
||||
if pShow then
|
||||
Open(focus);
|
||||
end;
|
||||
|
||||
function TChatBox.NewIMChannel(c: TICQContact): Integer;
|
||||
var
|
||||
chat: TchatInfo;
|
||||
begin
|
||||
chat := TchatInfo.Create;
|
||||
chat.who := c;
|
||||
chat.chatType := CT_IM;
|
||||
chat.single := singleDefault;
|
||||
chat.who.typing.bIAmTyping := False;
|
||||
chats.Add(chat);
|
||||
Result := chats.Count - 1;
|
||||
OpenPage(c);
|
||||
// ChatBox.CheckServerHistory(c);
|
||||
UpdateAvatar(c);
|
||||
Resize;
|
||||
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
|
||||
RedrawTab(c);
|
||||
RefreshTaskbarButtons;
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateAvatar(c: TICQContact);
|
||||
var
|
||||
ci: TchatInfo;
|
||||
i: Integer;
|
||||
begin
|
||||
i := chats.idxOf(c);
|
||||
if i >= 0 then
|
||||
begin
|
||||
ci := chats.byIdx(i);
|
||||
if Assigned(ci) and Assigned(ci.who) then
|
||||
if not avatarShowInChat or (c.icon.ToShow = IS_NONE) then
|
||||
ClearAvatar(ci.who.UID)
|
||||
else
|
||||
UpdateAvatar(ci.who.UID);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TchatInfo.CheckTypingTime;
|
||||
begin
|
||||
try
|
||||
if (chatType = CT_IM) and Assigned(who) then
|
||||
if (who.typing.bIAmTyping) and ((Now - who.typing.TypingTime) * SecsPerDay > TypingInterval) then
|
||||
Account.AccProto.InputChangedFor(TICQContact(who), False, True);
|
||||
except end;
|
||||
end;
|
||||
|
||||
function TChatBox.ThisChat: TchatInfo;
|
||||
begin
|
||||
if not Assigned(Chats) or (Chats.count = 0) then
|
||||
Result := nil
|
||||
else
|
||||
Result := Chats.byContact(CurrentContact);
|
||||
end;
|
||||
|
||||
function TChatBox.ThisContact: TICQContact;
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
ch := thisChat;
|
||||
if ch = nil then
|
||||
Result := nil
|
||||
else if ch.chatType = CT_IM then
|
||||
thisContact := ch.who
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TChatBox.ThisChatUID: TUID;
|
||||
var
|
||||
cnt: TICQContact;
|
||||
begin
|
||||
cnt := ThisContact;
|
||||
if Assigned(cnt) then
|
||||
Result := cnt.UID
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseThisPage;
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
if DraggingTab then
|
||||
Exit;
|
||||
|
||||
ch := thisChat;
|
||||
|
||||
if Assigned(ch) then
|
||||
CloseChat(ch);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateGraphics(c: TICQContact = nil);
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
ch := thisChat;
|
||||
if ch = nil then
|
||||
Exit;
|
||||
if ch.chatType = CT_PLUGING then
|
||||
Exit;
|
||||
if Assigned(c) and not ch.who.equals(c) then
|
||||
Exit;
|
||||
SetupSingleBtn(ch.single);
|
||||
UpdateContactStatus;
|
||||
UpdateStatusBar;
|
||||
RefreshTaskbarButtons;
|
||||
end;
|
||||
|
||||
function TChatBox.SawAllHere: Boolean;
|
||||
const
|
||||
ClearEvents = [EK_msg, EK_auth, EK_authDenied, EK_addedYou];
|
||||
var
|
||||
c: TICQContact;
|
||||
ch: TChatInfo;
|
||||
k: Integer;
|
||||
ev0: Thevent;
|
||||
Found: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
Found := False;
|
||||
if eventQ.Count = 0 then
|
||||
Exit;
|
||||
ch := thisChat;
|
||||
if (ch = nil) or (ch.chatType <> CT_IM) then
|
||||
Exit;
|
||||
c := ch.who;
|
||||
|
||||
k := -1;
|
||||
repeat
|
||||
k := eventQ.getNextEventFor(c, k);
|
||||
if (k >= 0) and (k < eventQ.count) then
|
||||
begin
|
||||
ev0 := eventQ.items[k];
|
||||
if ev0.Kind in ClearEvents then
|
||||
begin
|
||||
Found := True;
|
||||
eventQ.removeAt(k);
|
||||
if BE_history in behaviour[ev0.Kind].trig then
|
||||
if not UI.Chat.HasEvent(c, ev0) then
|
||||
UI.Chat.AddEvent(c, ev0.clone);
|
||||
try
|
||||
FreeAndNil(ev0);
|
||||
except end;
|
||||
end else
|
||||
Inc(k);
|
||||
end else
|
||||
k := -1;
|
||||
until (k < 0);
|
||||
|
||||
if Found then
|
||||
begin
|
||||
Result := True;
|
||||
RedrawTab(c);
|
||||
roasterLib.UpdateInPlace(c);
|
||||
ActionManager.Execute(AK_SAVEINBOX, SaveDelay);
|
||||
end;
|
||||
|
||||
UI.Tips.Remove(c);
|
||||
end;
|
||||
|
||||
procedure TChatBox.Open(Focus: Boolean = True);
|
||||
var
|
||||
Win: HWND;
|
||||
begin
|
||||
if chats.Count = 0 then
|
||||
Exit;
|
||||
if not Visible then
|
||||
Win := GetForegroundWindow
|
||||
else
|
||||
Win := 0;
|
||||
Show;
|
||||
if (Win > 0) and not Focus then
|
||||
ForceForegroundWindow(Win);
|
||||
if Focus then
|
||||
Activate(True);
|
||||
end;
|
||||
|
||||
function TChatBox.IsVisible: Boolean;
|
||||
begin
|
||||
Result := Visible and (GetForegroundWindow = Window);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateContactStatus(cnt: TICQContact = nil);
|
||||
begin
|
||||
if cnt = nil then
|
||||
cnt := thisContact;
|
||||
if cnt = nil then
|
||||
begin
|
||||
SetSendBtnImage(status2imgName(byte(SC_UNK), False));
|
||||
Exit;
|
||||
end;
|
||||
SetSendBtnImage(rosterImgNameFor(cnt));
|
||||
|
||||
if (thisChat.chatType = CT_IM) and not (thisChat.who = nil) then
|
||||
SetupBuzzBtn(thisChat.who.CanBuzz)
|
||||
else
|
||||
SetupBuzzBtn(False);
|
||||
|
||||
RedrawTab(cnt);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClosePageAt(idx: Integer);
|
||||
var
|
||||
ch: TchatInfo;
|
||||
cnt: TICQContact;
|
||||
id: Integer;
|
||||
ltype: TChatType;
|
||||
begin
|
||||
ch := chats.byIdx(idx);
|
||||
if ch = nil then
|
||||
Exit;
|
||||
|
||||
cnt := ch.who;
|
||||
id := ch.ID;
|
||||
ltype := ch.chatType;
|
||||
LastContact := cnt;
|
||||
|
||||
if ltype = CT_PLUGING then
|
||||
plugins.castEv(PE_CLOSETAB, ch.ID)
|
||||
else if ltype = CT_IM then
|
||||
Account.AccProto.InputChangedFor(TICQContact(ch.who), True);
|
||||
|
||||
try
|
||||
chats.Items[idx] := nil;
|
||||
chats.Delete(idx);
|
||||
FreeAndNil(ch);
|
||||
except end;
|
||||
|
||||
if ltype = CT_PLUGING then
|
||||
ClosePage(id)
|
||||
else if ltype = CT_IM then
|
||||
ClosePage(cnt.UID);
|
||||
|
||||
if not (UserStartTime = 0) then
|
||||
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
|
||||
RefreshTaskbarButtons;
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseChat(ci: TchatInfo);
|
||||
begin
|
||||
if ci = nil then
|
||||
Exit;
|
||||
if ci.chatType = CT_IM then
|
||||
ClosePageAt(chats.idxOf(ci.who))
|
||||
else
|
||||
ClosePageAt(chats.idxOfID(ci.ID));
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseChatWith(c: TICQContact);
|
||||
begin
|
||||
ClosePageAt(chats.idxOf(c))
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseChatUID(const UID: TUID);
|
||||
begin
|
||||
ClosePageAt(chats.idxOfUIN(UID))
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseChatID(ID: Integer);
|
||||
begin
|
||||
ClosePageAt(chats.idxOfID(ID));
|
||||
end;
|
||||
|
||||
procedure TChatBox.CloseAllPages(isAuto: boolean = false);
|
||||
begin
|
||||
if isAuto then
|
||||
PagesEnumStr := Pages2String
|
||||
else
|
||||
PagesEnumStr := '';
|
||||
|
||||
while chats.Count > 0 do
|
||||
ClosePageAt(0);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateChatPreviewArea;
|
||||
begin
|
||||
if not Assigned(TaskBar) then
|
||||
Exit;
|
||||
TaskBar.PreviewClipRegion.Height := Min(200, GetHeight);
|
||||
TaskBar.PreviewClipRegion.Width := Min(420, GetWidth);
|
||||
TaskBar.ApplyClipAreaChanges;
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetStatusbar(const s: String);
|
||||
var
|
||||
hint: String;
|
||||
begin
|
||||
if IsUploading then
|
||||
hint := GetTranslation('Uploading file') + ': ' + IntToStr(Trunc(UploadedSize / UploadSize * 100)) + '%'
|
||||
else
|
||||
hint := s;
|
||||
|
||||
SetStatusbarHint(hint);
|
||||
|
||||
if TOSVersion.Check(6, 1) then
|
||||
if Assigned(TaskBar) then
|
||||
with TaskBar do
|
||||
begin
|
||||
if (UploadedSize < UploadSize) and IsUploading then
|
||||
begin
|
||||
ProgressState := TTaskBarProgressState.Normal;
|
||||
ProgressValue := Trunc(UploadedSize / UploadSize * 100);
|
||||
end
|
||||
else
|
||||
begin
|
||||
ProgressState := TTaskBarProgressState.None;
|
||||
ProgressValue := 0;
|
||||
end;
|
||||
ApplyProgressChanges;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.MoveToEvent(c: TICQContact; ev: Thevent);
|
||||
begin
|
||||
MoveToTime(c.UID, ev.when);
|
||||
end;
|
||||
|
||||
function TChatBox.HasEvent(c: TICQContact; ev: Thevent): Boolean;
|
||||
var
|
||||
ch: TchatInfo;
|
||||
tlast: TDateTime;
|
||||
begin
|
||||
Result := False;
|
||||
ch := chats.byContact(c);
|
||||
if not Assigned(ch) then
|
||||
Exit;
|
||||
|
||||
if logpref.writehistory and (BE_save in behaviour[ev.kind].trig) then
|
||||
Result := True
|
||||
else
|
||||
begin
|
||||
tlast := GetLastEventTime(c.UID);
|
||||
if tlast > 0 then
|
||||
Result := CompareDateTime(tlast, ev.when) >= 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetUnreadEvent(c: TICQContact; ev: Thevent);
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
ch := chats.byContact(c);
|
||||
if not Assigned(ch) then
|
||||
Exit;
|
||||
|
||||
SetFirstUnreadEvent(c.UID, ev.when);
|
||||
end;
|
||||
|
||||
procedure TChatBox.Flash;
|
||||
var
|
||||
Rec: FLASHWINFO;
|
||||
begin
|
||||
// if doFlashChat then
|
||||
begin
|
||||
Rec.cbSize := SizeOf(Rec);
|
||||
Rec.hwnd := Window;
|
||||
Rec.dwFlags := FLASHW_CAPTION or FLASHW_TRAY or FLASHW_TIMERNOFG;
|
||||
Rec.dwTimeout := 0;
|
||||
Rec.uCount := DWord(-1);
|
||||
FlashWindowEx(Rec);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.Shake;
|
||||
const
|
||||
MAXDELTA = 8;
|
||||
SHAKETIMES = 150;
|
||||
var
|
||||
oRect, wRect: TRect;
|
||||
begin
|
||||
GetWindowRect(Window, wRect);
|
||||
oRect := wRect;
|
||||
Randomize;
|
||||
|
||||
TThread.CreateAnonymousThread(procedure
|
||||
var
|
||||
cnt: Integer;
|
||||
begin
|
||||
for cnt := 0 to SHAKETIMES do
|
||||
begin
|
||||
wRect := oRect;
|
||||
System.Types.OffsetRect(wRect, Round(Random(2 * MAXDELTA) - MAXDELTA), 0);
|
||||
MoveWindow(Window, wRect.Left, wRect.Top, wRect.Right - wRect.Left, wRect.Bottom - wRect.Top, True);
|
||||
Sleep(10);
|
||||
end;
|
||||
MoveWindow(Window, oRect.Left, oRect.Top, oRect.Right - oRect.Left, oRect.Bottom - oRect.Top, True);
|
||||
end).Start;
|
||||
end;
|
||||
|
||||
function TChatBox.Pages2String: String;
|
||||
var
|
||||
i: Integer;
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
if (UserStartTime = 0) and (chats.count = 0) then
|
||||
Result := PagesEnumStr
|
||||
else
|
||||
begin
|
||||
Result := '';
|
||||
for i := 0 to chats.Count - 1 do
|
||||
try
|
||||
ch := chats.byIdx(i);
|
||||
if Assigned(ch) and (ch.chatType = CT_IM) then
|
||||
Result := Result + ch.who.UID + #10;
|
||||
except end;
|
||||
Result := Result.Trim([#10]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.LoadPages(const s: String);
|
||||
var
|
||||
I: Integer;
|
||||
Pages: TArray |
||||
begin
|
||||
Pages := s.Split([#10]);
|
||||
|
||||
for I := 0 to Length(Pages) - 1 do
|
||||
OpenOn(Account.AccProto.GetContact(Pages[I]));
|
||||
|
||||
Open(True);
|
||||
end;
|
||||
|
||||
procedure TChatBox.LoadPages(const cl: TRnQCList);
|
||||
var
|
||||
cnt: TICQContact;
|
||||
begin
|
||||
for cnt in cl do
|
||||
OpenOn(cnt);
|
||||
Open(True);
|
||||
end;
|
||||
|
||||
// ----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
function CHAT_TAB_ADD(Control: Integer; iIcon: HIcon; const TabCaption: string): Integer;
|
||||
var
|
||||
chat: TchatInfo;
|
||||
i: Integer;
|
||||
begin
|
||||
i := UI.Chat.chats.idxOfID(Control);
|
||||
if UI.Chat.chats.validIdx(i) then
|
||||
begin
|
||||
UI.Chat.SetCurrent(i);
|
||||
UI.Chat.Resize;
|
||||
Result := -1;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
with UI.Chat do
|
||||
begin
|
||||
chat := TchatInfo.Create;
|
||||
chat.who := nil;
|
||||
chat.chatType := CT_PLUGING;
|
||||
chat.single := singleDefault;
|
||||
|
||||
chat.lastInputText := TabCaption;
|
||||
chats.Add(chat);
|
||||
|
||||
chat.ID := Control;
|
||||
if not (iIcon = 0) then
|
||||
theme.addHIco('plugintab' + IntToStr(chat.ID), iIcon, true);
|
||||
OpenPage(chat.ID, TabCaption);
|
||||
RedrawPluginTab(chat);
|
||||
Resize;
|
||||
RefreshTaskbarButtons;
|
||||
ActionManager.Execute(AK_SAVECONFIG, SaveDelay);
|
||||
|
||||
Result := Integer(Window);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CHAT_TAB_MODIFY(Control: Integer; iIcon: HIcon; const TabCaption: string);
|
||||
var
|
||||
chat: TchatInfo;
|
||||
i: Integer;
|
||||
begin
|
||||
chat := nil;
|
||||
for i := 0 to UI.Chat.chats.count - 1 do
|
||||
begin
|
||||
if UI.Chat.chats.byIdx(i).ID = Control then
|
||||
begin
|
||||
chat := UI.Chat.chats.byIdx(i);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
if chat = nil then
|
||||
Exit;
|
||||
if not (iIcon = 0) then
|
||||
theme.addHIco('plugintab' + IntToStr(chat.ID), iIcon, true);
|
||||
|
||||
chat.lastInputText := TabCaption;
|
||||
UI.Chat.RedrawPluginTab(chat);
|
||||
UI.Chat.RefreshTaskbarButtons;
|
||||
end;
|
||||
|
||||
procedure CHAT_TAB_DELETE(Control: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to UI.Chat.chats.count - 1 do
|
||||
begin
|
||||
if UI.Chat.chats.byIdx(i).ID = Control then
|
||||
begin
|
||||
UI.Chat.ClosePageAt(i);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//procedure TChatBox.WMWINDOWPOSCHANGING(var msg: TWMWINDOWPOSCHANGING);
|
||||
//const
|
||||
// chkLeft = true;
|
||||
// chkRight = true;
|
||||
// chkTop = true;
|
||||
// chkBottom = true;
|
||||
//var
|
||||
// // rWorkArea: TRect;
|
||||
// rMainRect: TRect;
|
||||
// StickAt: Word;
|
||||
//begin
|
||||
//// TODO: Stick to edges
|
||||
//// if Assigned(mainDlg.RnQmain) then
|
||||
//// if mainDlg.RnQmain.visible then
|
||||
//// begin
|
||||
//// StickAt := 15; // StrToInt(edStickAt.Text);
|
||||
//// rMainRect := mainDlg.RnQmain.BoundsRect;
|
||||
//// // SystemParametersInfo
|
||||
//// // (SPI_GETWORKAREA, 0, @rWorkArea, 0);
|
||||
////
|
||||
//// with msg.WindowPos^ do
|
||||
//// begin
|
||||
//// if chkLeft then
|
||||
//// // if ABS(x - rWorkArea.Left) <= StickAt then begin
|
||||
//// // x := rWorkArea.Left;
|
||||
//// if (ABS(X - rMainRect.Right) <= StickAt) and (Y < rMainRect.Bottom) and (Y + cy > rMainRect.Top) then
|
||||
//// X := rMainRect.Right;
|
||||
////
|
||||
//// if chkRight then
|
||||
//// // if abs(x + cx - rWorkArea.Right) <= StickAt then begin
|
||||
//// // x := rWorkArea.Right - cx;
|
||||
//// if (ABS(X + cx - rMainRect.Left) <= StickAt) and (Y < rMainRect.Bottom) and (Y + cy > rMainRect.Top) then
|
||||
//// X := rMainRect.Left - cx;
|
||||
////
|
||||
//// if chkTop then
|
||||
//// if (ABS(Y - rMainRect.Bottom) <= StickAt) and (X < rMainRect.Right) and (X + cx > rMainRect.Left) then
|
||||
//// Y := rMainRect.Bottom;
|
||||
////
|
||||
//// if chkBottom then
|
||||
//// if (ABS(Y + cy - rMainRect.Top) <= StickAt) and (X < rMainRect.Right) and (X + cx > rMainRect.Left) then
|
||||
//// Y := rMainRect.Top - cy;
|
||||
//// end;
|
||||
//// end;
|
||||
// inherited;
|
||||
//end;
|
||||
|
||||
procedure TChatBox.DisplayHint(Sender: TObject);
|
||||
begin
|
||||
if Assigned(UI.Chat) and UI.Chat.Visible then
|
||||
UI.Chat.SetStatusbar(Application.Hint);
|
||||
end;
|
||||
|
||||
procedure TChatBox.TaskBarThumbButtonClick(Sender: TObject; AButtonID: Integer);
|
||||
begin
|
||||
ODS('AButtonID: ' + inttostr(AButtonID));
|
||||
if AButtonID > chats.Count then
|
||||
Exit;
|
||||
SetCurrent(AButtonID);
|
||||
Open(true);
|
||||
end;
|
||||
|
||||
procedure TChatBox.RefreshTaskbarButtons;
|
||||
var
|
||||
taskBtn: TThumbBarButton;
|
||||
ci: TchatInfo;
|
||||
hi: HICON;
|
||||
i, cnt: Integer;
|
||||
bmp: TRnQBitmap;
|
||||
ev: Thevent;
|
||||
begin
|
||||
if not Running then Exit;
|
||||
if not TOSVersion.Check(6, 1) then Exit;
|
||||
if not Assigned(TaskBar) or not Assigned(TaskBar.TaskBarButtons) or (TaskBar.TaskBarButtons.Count = 0) then Exit;
|
||||
if not UI.Chat.Visible then Exit;
|
||||
|
||||
cnt := Min(7, chats.Count);
|
||||
|
||||
TaskBar.TaskBarButtons.BeginUpdate;
|
||||
for i := 0 to 6 do
|
||||
begin
|
||||
taskBtn := TaskBar.TaskBarButtons[i];
|
||||
if Assigned(taskBtn.Icon) and taskBtn.Icon.HandleAllocated then
|
||||
DestroyIcon(taskBtn.Icon.ReleaseHandle);
|
||||
|
||||
if (cnt = 0) or (i > cnt - 1) then
|
||||
begin
|
||||
taskBtn.Hint := '';
|
||||
taskBtn.ButtonState := [TThumbButtonState.Hidden];
|
||||
end
|
||||
else
|
||||
begin
|
||||
taskBtn.ButtonState := [TThumbButtonState.Enabled, TThumbButtonState.DismissOnClick];
|
||||
ci := TchatInfo(chats.byIdx(i));
|
||||
if not Assigned(ci) then
|
||||
Continue;
|
||||
|
||||
case ci.chatType of
|
||||
CT_IM:
|
||||
begin
|
||||
if not (taskBtn.Hint = ci.who.displayed) then
|
||||
taskBtn.Hint := ci.who.displayed;
|
||||
|
||||
ev := eventQ.firstEventFor(ci.who);
|
||||
if (ev <> nil) then
|
||||
begin
|
||||
theme.pic2ico(RQteFormIcon, ev.pic, taskBtn.Icon);
|
||||
Continue;
|
||||
end;
|
||||
end;
|
||||
CT_PLUGING:
|
||||
begin
|
||||
if not (taskBtn.Hint = ci.lastInputText) then
|
||||
taskBtn.Hint := ci.lastInputText;
|
||||
|
||||
theme.pic2ico(RQteFormIcon, 'plugintab' + IntToStr(ci.ID), taskBtn.Icon);
|
||||
Continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
if avatarShowInTaskBar and Assigned(ci.who.icon.Bmp) then
|
||||
begin
|
||||
if (ci.who.icon.Bmp.Animated) then
|
||||
bmp := ci.who.icon.Bmp.CloneFrame(0)
|
||||
else
|
||||
bmp := ci.who.icon.Bmp.CloneAll;
|
||||
|
||||
StretchPic(bmp, 16, 16);
|
||||
bmp.GetHICON(hi);
|
||||
taskBtn.Icon.Handle := hi;
|
||||
FreeAndNil(bmp);
|
||||
end else
|
||||
theme.pic2ico(RQteFormIcon, ci.who.statusImg, taskBtn.Icon);
|
||||
end;
|
||||
end;
|
||||
TaskBar.TaskBarButtons.EndUpdate;
|
||||
TaskBar.ApplyButtonsChanges;
|
||||
end;
|
||||
|
||||
procedure OnChatActivate(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Active: Boolean;
|
||||
I: Integer;
|
||||
begin
|
||||
I := 0;
|
||||
API.ValueIntData(argv, I);
|
||||
Active := I = 1;
|
||||
|
||||
if Assigned(UI) and Assigned(UI.Chat) then
|
||||
begin
|
||||
UI.Chat.ApplyTitleColors(Active);
|
||||
if Active and AutoConsumeEvents then
|
||||
UI.Chat.SawAllHere;
|
||||
end else
|
||||
Exit;
|
||||
|
||||
// Wait for active window to switch
|
||||
TThread.CreateAnonymousThread(procedure
|
||||
begin
|
||||
TThread.Queue(nil, procedure
|
||||
begin
|
||||
ApplyTransparency(AW_CHAT);
|
||||
end);
|
||||
end).Start;
|
||||
|
||||
if Active and Assigned(UI.Chat.TaskBar) and Assigned(UI.Chat.TaskBar.TaskBar) then
|
||||
UI.Chat.TaskBar.ActivateTab;
|
||||
end;
|
||||
|
||||
procedure OnChatMouseEnter(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Style: Integer;
|
||||
begin
|
||||
if Running and Assigned(UI.Chat) then
|
||||
if transparency.forChat and transparency.chgOnMouse then
|
||||
begin
|
||||
Style := GetWindowLong(UI.Chat.Window, GWL_EXSTYLE);
|
||||
if (Style and WS_EX_LAYERED) = 0 then
|
||||
SetWindowLong(UI.Chat.Window, GWL_EXSTYLE, Style or WS_EX_LAYERED);
|
||||
SetLayeredWindowAttributes(UI.Chat.Window, 0, transparency.active, LWA_ALPHA);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OnChatMouseLeave(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
ExStyle: Integer;
|
||||
begin
|
||||
if Running and Assigned(UI.Chat) then
|
||||
if UI.Chat.Window <> GetForegroundWindow then
|
||||
if transparency.forChat and transparency.chgOnMouse then
|
||||
begin
|
||||
ExStyle := GetWindowLong(UI.Chat.Window, GWL_EXSTYLE);
|
||||
if (ExStyle and WS_EX_LAYERED) = 0 then
|
||||
SetWindowLong(UI.Chat.Window, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
|
||||
SetLayeredWindowAttributes(UI.Chat.Window, 0, transparency.inactive, LWA_ALPHA);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.ApplyTitleColors(Active: Boolean);
|
||||
begin
|
||||
if TOSVersion.Check(10) then
|
||||
if Prevalence = 0 then
|
||||
Call('setActiveStyle', [GetRValue(clWhite), GetGValue(clWhite), GetBValue(clWhite)])
|
||||
else if Active then
|
||||
Call('setActiveStyle', [GetRValue(AccentColor), GetGValue(AccentColor), GetBValue(AccentColor)])
|
||||
else
|
||||
Call('setActiveStyle', [GetRValue(AccentColorInactive), GetGValue(AccentColorInactive), GetBValue(AccentColorInactive)])
|
||||
end;
|
||||
|
||||
function applyHtmlFont(fnt: Tfont; const s: string): string;
|
||||
var
|
||||
h, q: string;
|
||||
begin
|
||||
h := '';
|
||||
q := '';
|
||||
if fsItalic in fnt.style then
|
||||
begin
|
||||
h := h + '';
|
||||
q := '' + q;
|
||||
end;
|
||||
if fsBold in fnt.style then
|
||||
begin
|
||||
h := h + '';
|
||||
q := '' + q;
|
||||
end;
|
||||
result := h + s + q;
|
||||
end;
|
||||
|
||||
function str2html2(const s: string): string;
|
||||
begin
|
||||
result := template(s, ['&', '&', '<', '<', '>', '>', CRLF, ' |
||||
end;
|
||||
|
||||
function color2html(color: TColor): AnsiString;
|
||||
begin
|
||||
// if not ColorToIdent(Color, Result) then
|
||||
begin
|
||||
color := ABCD_ADCB(ColorToRGB(color));
|
||||
result := '#' + IntToHex(color, 6);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatBox.getSelHtml(smiles: boolean): String;
|
||||
const
|
||||
HTMLTemplate = '' + CRLF + CRLF +
|
||||
'' + CRLF +
|
||||
'' + CRLF +
|
||||
' |
||||
' ' + CRLF +
|
||||
' ' + CRLF +
|
||||
'' + CRLF +
|
||||
'' + CRLF +
|
||||
'%CONTENT% ' + CRLF +
|
||||
'' + CRLF +
|
||||
'';
|
||||
var
|
||||
SOS, EOS: TDateTime;
|
||||
ev: Thevent;
|
||||
Content: String;
|
||||
HTMLElement: String;
|
||||
|
||||
Host, Guest: String;
|
||||
HostUIN, GuestUIN: TUID;
|
||||
EvHost, EvGuest: Thevent;
|
||||
|
||||
function makeElement(const uin: TUID; font: TFont; isMy: Boolean): String;
|
||||
begin
|
||||
result := ' .uin' + UTF(uin) + ' {' + CRLF +
|
||||
' color: #333;' + CRLF;
|
||||
result := result + ' font-family: "Segoe UI";' + CRLF;
|
||||
result := result + ' font-size: 14px;' + CRLF;
|
||||
if fsBold in font.Style then
|
||||
result := result + ' font-weight: 500;';
|
||||
if fsItalic in font.Style then
|
||||
result := result + ' text-decoration: italic;';
|
||||
if fsUnderline in font.Style then
|
||||
result := result + ' text-decoration: underline;';
|
||||
result := result + ' }' + CRLF;
|
||||
result := result + ' .uin' + uin + ' .title {' + CRLF;
|
||||
if isMy then
|
||||
result := result + ' color: #283593;' + CRLF
|
||||
else
|
||||
result := result + ' color: #844103;' + CRLF;
|
||||
result := result + ' }';
|
||||
// +CRLF;
|
||||
end;
|
||||
|
||||
var
|
||||
fnt: TFont;
|
||||
tmp: String;
|
||||
events: Thevents;
|
||||
history: Thistory;
|
||||
begin
|
||||
if CurrentContact = nil then
|
||||
Exit;
|
||||
|
||||
result := '';
|
||||
fnt := TFont.Create;
|
||||
fnt.Assign(Application.DefaultFont);
|
||||
|
||||
if (StartSel = 0) or (EndSel = 0) then
|
||||
Exit;
|
||||
|
||||
if CompareDateTime(EndSel, StartSel) >= 0 then
|
||||
begin
|
||||
SOS := StartSel;
|
||||
EOS := EndSel;
|
||||
end
|
||||
else
|
||||
begin
|
||||
SOS := EndSel;
|
||||
EOS := StartSel;
|
||||
end;
|
||||
|
||||
Host := '';
|
||||
Guest := '';
|
||||
Content := '';
|
||||
history := GetHistory(CurrentContact.UID);
|
||||
if Assigned(history) then
|
||||
events := history.getTimeRange(SOS, EOS);
|
||||
for ev in events do
|
||||
begin
|
||||
if (Host = '') or (Guest = '') then
|
||||
begin
|
||||
if ev.outgoing then
|
||||
begin
|
||||
EvHost := ev;
|
||||
Host := ev.who.displayed;
|
||||
HostUIN := ev.who.UID;
|
||||
end
|
||||
else
|
||||
begin
|
||||
EvGuest := ev;
|
||||
Guest := ev.who.displayed;
|
||||
GuestUIN := ev.who.UID;
|
||||
end;
|
||||
end;
|
||||
|
||||
tmp := CRLF + ' |
||||
if not (ev.kind = EK_msg) then
|
||||
tmp := tmp + '[' + getTranslation(event2ShowStr[ev.kind]) + '] ';
|
||||
tmp := tmp + DateTimeToStr(ev.when) + ', ' +
|
||||
ev.who.displayed + '' + ' |
||||
str2html2(ev.getBodyText) + '';
|
||||
Content := Content + tmp;
|
||||
end;
|
||||
|
||||
// %TITLE%
|
||||
HTMLElement := getTranslation('History between [%s] and [%s]', [Host, Guest]);
|
||||
Result := StringReplace(HTMLTemplate, '%TITLE%', HTMLElement, []);
|
||||
|
||||
// %BODY%
|
||||
HTMLElement := ' body {' + CRLF +
|
||||
' background-color: ' + color2html(theme.GetColor('history.bg', clWindow)) + ';' + CRLF +
|
||||
' }' + CRLF +
|
||||
' div {' + CRLF +
|
||||
' margin-top: 5px' + CRLF +
|
||||
' }' + CRLF;
|
||||
Result := StringReplace(Result, '%BODY%', HTMLElement, []);
|
||||
|
||||
// %HOST%
|
||||
if Host > '' then
|
||||
begin
|
||||
fnt.Assign(Screen.MenuFont);
|
||||
EvHost.applyFont(fnt);
|
||||
HTMLElement := makeElement(HostUIN, fnt, True);
|
||||
end else
|
||||
HTMLElement := '';
|
||||
Result := StringReplace(Result, '%HOST%', HTMLElement, []);
|
||||
|
||||
// %GUEST%
|
||||
if Guest > '' then
|
||||
begin
|
||||
fnt.Assign(Screen.MenuFont);
|
||||
EvGuest.applyFont(fnt);
|
||||
HTMLElement := makeElement(GuestUIN, fnt, False)
|
||||
end else
|
||||
HTMLElement := '';
|
||||
Result := StringReplace(Result, '%GUEST%', HTMLElement, []);
|
||||
Result := StringReplace(Result, '%CONTENT%', Content, []);
|
||||
|
||||
Host := '';
|
||||
Guest := '';
|
||||
Content := '';
|
||||
HTMLElement := '';
|
||||
fnt.Free;
|
||||
for ev in events do
|
||||
ev.Free;
|
||||
end;
|
||||
(*
|
||||
PK_CRYPTED:
|
||||
if enterPwdDlg(histcrypt.pwd) then
|
||||
histcrypt.pwdkey := calculate_KEY(histcrypt.pwd);
|
||||
*)
|
||||
procedure TChatBox.MoveToTime(const UID: TUID; time: TDateTime; fast: Boolean = False);
|
||||
var
|
||||
ffs: TFormatSettings;
|
||||
begin
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
PageCall(UID, 'moveToTime', [FloatToStr(time, ffs), fast]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetFirstUnreadEvent(const UID: TUID; time: TDateTime);
|
||||
var
|
||||
ffs: TFormatSettings;
|
||||
begin
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
PageCall(UID, 'setFirstUnreadEvent', [FloatToStr(time, ffs)]);
|
||||
end;
|
||||
|
||||
function TChatBox.WholeEventsAreSelected: Boolean;
|
||||
begin
|
||||
Result := (StartSel > 0) and (EndSel > 0) and IsWholeEvents
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetSelection(const UID: TUID; from, to_: TDateTime);
|
||||
var
|
||||
args: TParams;
|
||||
ffs: TFormatSettings;
|
||||
begin
|
||||
StartSel := from;
|
||||
EndSel := to_;
|
||||
IsWholeEvents := True;
|
||||
SetLength(args, 2);
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
args[0] := FloatToStr(from, ffs);
|
||||
args[1] := FloatToStr(to_, ffs);
|
||||
PageCall(UID, 'setSelection', args);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClearSelection(const UID: TUID);
|
||||
begin
|
||||
StartSel := 0;
|
||||
IsWholeEvents := False;
|
||||
PageCall(UID, 'clearSelection', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SelectionAll(const UID: TUID);
|
||||
begin
|
||||
PageCall(UID, 'selectAll', []);
|
||||
end;
|
||||
|
||||
function TChatBox.AddEvent_OpenChat(otherHand: TICQContact; ev: Thevent): Boolean;
|
||||
begin
|
||||
OpenChat(otherHand);
|
||||
Result := AddEvent(otherHand, ev);
|
||||
end;
|
||||
|
||||
function TChatBox.AddEvent(Cnt: TICQContact; Ev: Thevent): Boolean;
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
Result := False;
|
||||
ch := chats.byContact(Cnt);
|
||||
if Assigned(ch) then
|
||||
begin
|
||||
Result := True;
|
||||
AddEvent(Cnt.UID, Ev);
|
||||
end;
|
||||
FreeAndNil(Ev);
|
||||
end;
|
||||
|
||||
function TChatBox.UpdateEvent(Cnt: TICQContact; Ev: Thevent): Boolean;
|
||||
var
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
Result := False;
|
||||
ch := chats.byContact(Cnt);
|
||||
if Assigned(ch) then
|
||||
begin
|
||||
Result := True;
|
||||
UpdateEvent(Cnt.UID, Ev);
|
||||
end;
|
||||
FreeAndNil(Ev);
|
||||
end;
|
||||
|
||||
procedure TChatBox.AddEvent(const UID: TUID; Ev: Thevent);
|
||||
var
|
||||
Params: TParams;
|
||||
MsgData: TMessageData;
|
||||
begin
|
||||
AddChatItem(Params, MsgData, Ev, True);
|
||||
SendChatItems(UID, Params);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateEvent(const UID: TUID; var Ev: Thevent);
|
||||
var
|
||||
Params: TParams;
|
||||
MsgData: TMessageData;
|
||||
begin
|
||||
AddChatItem(Params, MsgData, Ev, False);
|
||||
SendChatItems(UID, Params, SA_UPDATE);
|
||||
end;
|
||||
|
||||
procedure TChatBox.Quote(const QS: String = ''; LimitWidth: Boolean = False);
|
||||
begin
|
||||
PageCall('', 'quote', [QS, LimitWidth]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateMsgStatus(hev: Thevent);
|
||||
var
|
||||
Status: TMessageStatus;
|
||||
EvPic: TSprite;
|
||||
ffs: TFormatSettings;
|
||||
begin
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
Status.when := FloatToStr(hev.when, ffs);
|
||||
Status.msgid := UIntToStr(hev.ID);
|
||||
|
||||
EvPic := MakeSprite(hev.pic);
|
||||
Status.eventimg := UI.RecordToVar(EvPic);
|
||||
PageFire(hev.chat.UID, $105, UI.RecordToVar(Status));
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateStatusBar;
|
||||
var
|
||||
Trlt: Boolean;
|
||||
EncPic1, EncPic2: TPicName;
|
||||
EncHint: String;
|
||||
begin
|
||||
Trlt := Assigned(TranslitList) and (TranslitList.Count > 0) and Assigned(CurrentContact) and CurrentContact.SendTransl;
|
||||
|
||||
EncPic1 := '';
|
||||
EncPic2 := '';
|
||||
EncHint := GetTranslation('Encryption status for current contact');
|
||||
if Assigned(CurrentContact) then
|
||||
if Account.AccProto.UseCryptMsg and (
|
||||
(TICQContact(CurrentContact).crypt.SupportCryptMsg) or
|
||||
(TICQContact(CurrentContact).crypt.SupportEcc and Account.AccProto.UseEccCryptMsg)) then
|
||||
begin
|
||||
if TICQContact(CurrentContact).crypt.SupportEcc then
|
||||
begin
|
||||
EncPic1 := PIC_KEY;
|
||||
EncPic2 := PIC_CLI_RNQ;
|
||||
EncHint := EncHint + ' [ECDH & AES 256-bit]';
|
||||
end else if TICQContact(CurrentContact).crypt.SupportCryptMsg then
|
||||
begin
|
||||
EncPic1 := PIC_KEY;
|
||||
EncPic2 := PIC_CLI_RNQ;
|
||||
EncHint := EncHint + ' [AES 256-bit]';
|
||||
end else if CAPS_big_QIP_Secure in TICQContact(CurrentContact).CapabilitiesBig then
|
||||
begin
|
||||
// if TICQContact(CurrentContact).crypt.qippwd > 0 then
|
||||
// EncPic1 := PIC_KEY;
|
||||
// EncPic2 := PIC_CLI_QIP;
|
||||
// EncHint := EncHint + ' [QIP]';
|
||||
end;
|
||||
end;
|
||||
|
||||
Call('updateStatusBar', [Account.outbox.stFor(CurrentContact), Trlt, EncPic1, EncPic2, EncHint]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateRelTimes;
|
||||
begin
|
||||
Call('updateRelTimes', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetStatusBarHint(const hint: String);
|
||||
begin
|
||||
Call('setStatusBarHint', [hint]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetSmartReplies(Contact: TICQCOntact; const suggests: TArray |
||||
begin
|
||||
Call('setSmartReplies', [Contact.UID, suggests]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ScrollEvent(d: Integer);
|
||||
begin
|
||||
PageCall('', 'scrollEvent', [d]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ScrollLine(d: Integer);
|
||||
begin
|
||||
PageCall('', 'scrollLine', [d]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ScrollWheel(d: Integer);
|
||||
begin
|
||||
PageCall('', 'scrollWheel', [d]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ScrollToTop(animate: Boolean);
|
||||
begin
|
||||
PageCall('', 'scrollToTop', [animate]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.Resize;
|
||||
//var
|
||||
// ch: TchatInfo;
|
||||
begin
|
||||
UpdateChatPreviewArea;
|
||||
// ch := ThisChat;
|
||||
// if ch = nil then
|
||||
// Exit;
|
||||
// if ch.chatType = CT_PLUGING then
|
||||
// plugins.castEv(PE_SELECTTAB, ch.ID)
|
||||
end;
|
||||
|
||||
procedure UpdateChatXY(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Rect: Variant;
|
||||
begin
|
||||
S2V(argv, Rect);
|
||||
ChatXY.Left := Rect[0];
|
||||
ChatXY.Top := Rect[1];
|
||||
ChatXY.Width := Rect[2];
|
||||
ChatXY.Height := Rect[3];
|
||||
end;
|
||||
|
||||
procedure AttachWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
B: PByte;
|
||||
Pb: Cardinal;
|
||||
Page: Integer;
|
||||
begin
|
||||
B := nil;
|
||||
API.ValueBinaryData(argv, B, Pb);
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, Page);
|
||||
API.SciterAttachHwndToElement(B, Page);
|
||||
end;
|
||||
|
||||
procedure DetachWindow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
B: PByte;
|
||||
Pb: Cardinal;
|
||||
begin
|
||||
B := nil;
|
||||
API.ValueBinaryData(argv, B, Pb);
|
||||
API.SciterAttachHwndToElement(B, 0);
|
||||
end;
|
||||
|
||||
procedure OnChatShow(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
with UI.Chat do
|
||||
if Assigned(TaskBar) then
|
||||
begin
|
||||
if Assigned(TaskBar.TaskBarButtons) and (TaskBar.TaskBarButtons.Count = 0) then
|
||||
for I := 0 to 6 do
|
||||
TaskBar.TaskbarButtons.Add;
|
||||
TaskBar.Initialize;
|
||||
TaskBar.CheckApplyChanges;
|
||||
RefreshTaskbarButtons;
|
||||
UpdateChatPreviewArea;
|
||||
UpdateContactStatus;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure OnChatHide(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if Assigned(UI.Chat.TaskBar) then
|
||||
UI.Chat.TaskBar.UnregisterTab;
|
||||
TabsIconCache.Clear;
|
||||
if UI.Chat.Chats.Count = 0 then
|
||||
EmbeddedImgs.Clear;
|
||||
end;
|
||||
|
||||
procedure OnChatResize(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if Assigned(UI) and Assigned(UI.Chat) then
|
||||
UI.Chat.Resize;
|
||||
end;
|
||||
|
||||
procedure LoadHistory(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
offset, msgs, evId, evCnt: Integer;
|
||||
// topTime: Double;
|
||||
params: TParams;
|
||||
noMoreMessages: Boolean;
|
||||
events: Thevents;
|
||||
history: Thistory;
|
||||
MsgDatas: array of TMessageData;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
|
||||
msgs := 1;
|
||||
if argc = 3 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, offset);
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, msgs);
|
||||
end;
|
||||
|
||||
with UI.Chat do
|
||||
begin
|
||||
history := GetHistory(UID);
|
||||
if not Assigned(history) then
|
||||
Exit;
|
||||
|
||||
events := history.getLastEvents(offset, msgs, noMoreMessages);
|
||||
evCnt := Length(events);
|
||||
SetLength(MsgDatas, evCnt);
|
||||
|
||||
if evCnt > 0 then
|
||||
for evId := 0 to evCnt - 1 do
|
||||
if Assigned(events[evId]) then
|
||||
begin
|
||||
AddChatItem(params, MsgDatas[evId], events[evId], False);
|
||||
FreeAndNil(events[evId]);
|
||||
end;
|
||||
SetLength(events, 0);
|
||||
|
||||
if Length(params) > 0 then
|
||||
SendChatItems(UID, params, SA_PREPEND);
|
||||
|
||||
SetLength(MsgDatas, 0);
|
||||
if noMoreMessages then
|
||||
HideHistory(UID);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure UpdateSelection(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
text, sOfs, eOfs: String;
|
||||
sOfsT, eOfsT: TDateTime;
|
||||
isWhole: Bool;
|
||||
ffs: TFormatSettings;
|
||||
tmpInt: Integer;
|
||||
begin
|
||||
if argc < 4 then
|
||||
Exit;
|
||||
|
||||
text := SciterVarToString(argv);
|
||||
UI.Chat.selectedText := text;
|
||||
|
||||
Inc(argv);
|
||||
sOfs := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
eOfs := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, tmpInt);
|
||||
isWhole := tmpInt = 1;
|
||||
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
sOfsT := StrToFloat(sOfs, ffs);
|
||||
eOfsT := StrToFloat(eOfs, ffs);
|
||||
|
||||
with UI.Chat do
|
||||
if (sOfsT <= 0) or (eOfsT <= 0) then
|
||||
begin
|
||||
StartSel := 0;
|
||||
EndSel := 0;
|
||||
IsWholeEvents := False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
StartSel := sOfsT;
|
||||
EndSel := eOfsT;
|
||||
IsWholeEvents := isWhole;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetSnapshotExt: String;
|
||||
begin
|
||||
if ScreenshotFormat = 2 then
|
||||
Result := 'webp'
|
||||
else if ScreenshotFormat = 1 then
|
||||
Result := 'jpg'
|
||||
else
|
||||
Result := 'png'
|
||||
end;
|
||||
|
||||
function GetSnapshotFilename: String;
|
||||
begin
|
||||
Result := 'snapshot.' + GetSnapshotExt;
|
||||
end;
|
||||
|
||||
procedure UploadLastSnapshot(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
with UI.Chat do
|
||||
begin
|
||||
AddToCurrentInput(FileUpload(False, CacheDir + GetSnapshotFilename));
|
||||
DeleteFile(CacheDir + GetSnapshotFilename);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DeleteSnapshot(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
DeleteFile(CacheDir + GetSnapshotFilename);
|
||||
end;
|
||||
|
||||
procedure UploadFiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
I: Integer;
|
||||
Files: String;
|
||||
begin
|
||||
with UI.Chat do
|
||||
begin
|
||||
I := 0;
|
||||
API.ValueIntData(argv, I);
|
||||
Inc(argv);
|
||||
Files := SciterVarToString(argv);
|
||||
AddToCurrentInput(FileUpload(I = 1, Files));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CreateMessageRegex;
|
||||
var
|
||||
emailRegex, protocolRegex, wwwRegex, domainNameRegex, tldRegex, urlSuffixRegex: String;
|
||||
|
||||
function FindWordExp(const n, w: String; const m: String = ''): String;
|
||||
begin
|
||||
Result := '((?<=^|\s)' + m + '(?<' + n + '>' + w + ')' + m + '(?=$|\s))';
|
||||
end;
|
||||
|
||||
begin
|
||||
emailRegex := '[\-;:&=\+\$,\w\.]+@';
|
||||
protocolRegex := '[a-z][-.+a-z0-9]*:(?![a-z][-.+a-z0-9]*:\/\/)(?!\d+\/?)(\/\/)?';
|
||||
wwwRegex := 'www\.';
|
||||
domainNameRegex := '[а-яА-ЯёЁa-z0-9\.\-]*[а-яА-ЯёЁa-z0-9\-]';
|
||||
tldRegex := '\.[а-яА-ЯёЁa-z]{2,63}';
|
||||
urlSuffixRegex := '[\—\-а-яА-ЯёЁa-z0-9+&@#\/%=~_()|''$*\[\]?!:,.;]*[\—\-а-яА-ЯёЁa-z0-9+&@#\/%=~_()|''$*\[\]]';
|
||||
|
||||
msgRegex := TPerlRegEx.Create;
|
||||
msgRegex.RegEx :=
|
||||
FindWordExp('mail', emailRegex + domainNameRegex + tldRegex) +
|
||||
'|' + FindWordExp('url',
|
||||
'((' + protocolRegex + domainNameRegex + tldRegex + ')' +
|
||||
'|' +
|
||||
'((.?//)?' + wwwRegex + domainNameRegex + tldRegex + '))' +
|
||||
'(' + urlSuffixRegex + ')?') +
|
||||
'|' + FindWordExp('uin', '\d{5,9}') +
|
||||
'|' + '(\[code=?(? |
||||
'|' + FindWordExp('bold', '\S.+?\S', '\*') +
|
||||
'|' + FindWordExp('underline', '\S.+?\S', '_') +
|
||||
'|' + '((?m-s)^\>\; (? |
||||
msgRegex.State := [preNotEmpty];
|
||||
msgRegex.Options := [preCaseLess, preSingleLine, preNoAutoCapture];
|
||||
msgRegex.Study;
|
||||
|
||||
youtubeRegex := TPerlRegEx.Create;
|
||||
youtubeRegex.RegEx := '(www\.)?(youtube\.com\/watch|youtu.be\/).+';
|
||||
youtubeRegex.State := [preNotEmpty];
|
||||
youtubeRegex.Options := [preCaseLess];
|
||||
youtubeRegex.Study;
|
||||
|
||||
vimeoRegex := TPerlRegEx.Create;
|
||||
vimeoRegex.RegEx := '(www\.)?(vimeo\.com\/).+';
|
||||
vimeoRegex.State := [preNotEmpty];
|
||||
vimeoRegex.Options := [preCaseLess];
|
||||
vimeoRegex.Study;
|
||||
end;
|
||||
|
||||
procedure FreeMessageRegex;
|
||||
begin
|
||||
msgRegex.Free;
|
||||
youtubeRegex.Free;
|
||||
vimeoRegex.Free;
|
||||
end;
|
||||
|
||||
function TChatBox.GetReplacement(args: TArray |
||||
|
||||
procedure AppendImage(const URL: String; ImgWidth, ImgHeight: Integer; Cached: Boolean);
|
||||
var
|
||||
DataLink, Display, Action: PCREString;
|
||||
Ratio: Extended;
|
||||
Lottie: Boolean;
|
||||
begin
|
||||
DataLink := 'data-link="' + THTMLEncoding.HTML.Encode(URL) + '" ';
|
||||
Action := 'check';
|
||||
Display := ' hidden';
|
||||
|
||||
if Cached then
|
||||
begin
|
||||
Action := 'download';
|
||||
Display := '';
|
||||
end;
|
||||
|
||||
Lottie := IsLottieMime(URL);
|
||||
Ratio := ImgHeight / ImgWidth;
|
||||
|
||||
if LimitMaxChatImgWidth and (MaxChatImgWidthVal > 0) then
|
||||
begin
|
||||
if (ImgWidth > MaxChatImgWidthVal) then
|
||||
begin
|
||||
ImgWidth := MaxChatImgWidthVal;
|
||||
ImgHeight := Floor(MaxChatImgWidthVal * Ratio);
|
||||
end;
|
||||
end else if (ImgWidth > Self.GetWidth) then
|
||||
begin
|
||||
ImgWidth := Self.GetWidth;
|
||||
ImgHeight := Floor(Self.GetWidth * Ratio);
|
||||
end;
|
||||
|
||||
if LimitMaxChatImgHeight and (MaxChatImgHeightVal > 0) and (ImgHeight > MaxChatImgHeightVal) then
|
||||
begin
|
||||
ImgWidth := Floor(MaxChatImgHeightVal / Ratio);
|
||||
ImgHeight := MaxChatImgHeightVal;
|
||||
end;
|
||||
|
||||
Result := Result + ' |
||||
if Lottie then
|
||||
Result := Result + ' |
||||
else
|
||||
Result := Result + '';
|
||||
Result := Result + '';
|
||||
end;
|
||||
|
||||
var
|
||||
match, mail, url, uin, srcLang, srcCode, bold, underlined, comment,
|
||||
videoHref, srcCodeHTML: String;
|
||||
srcCodeArr: TStringList;
|
||||
IsVideoLink: Boolean;
|
||||
i: Integer;
|
||||
begin
|
||||
match := args[0];
|
||||
mail := args[1];
|
||||
url := args[2];
|
||||
uin := args[3];
|
||||
srcLang := args[4];
|
||||
srcCode := args[5];
|
||||
bold := args[6];
|
||||
underlined := args[7];
|
||||
comment := args[8];
|
||||
|
||||
if not (mail = '') then
|
||||
Result := '' + mail + ''
|
||||
else if not (url = '') then
|
||||
begin
|
||||
Result := '' + url + '';
|
||||
videoHref := ' |
||||
IsVideoLink := False;
|
||||
youtubeRegex.Subject := url;
|
||||
vimeoRegex.Subject := url;
|
||||
if youtubeRegex.Match then
|
||||
begin
|
||||
Result := Result + videoHref + ' kind="youtube">';
|
||||
IsVideoLink := True;
|
||||
end else if vimeoRegex.Match then
|
||||
begin
|
||||
Result := Result + videoHref + ' kind="vimeo">';
|
||||
IsVideoLink := True;
|
||||
end else
|
||||
Result := Result + '';
|
||||
|
||||
if (not IsLastParsedEventMine and EnableImgLinksIn) or (IsLastParsedEventMine and EnableImgLinksOut) then
|
||||
if (not IsVideoLink) or (IsVideoLink and EnableVideoLinks) then
|
||||
if ImgCacheInfo.ValueExists(url, 'hash') then
|
||||
AppendImage(url, ImgCacheInfo.ReadInteger(url, 'width', 50), ImgCacheInfo.ReadInteger(url, 'height', 50), True)
|
||||
else
|
||||
AppendImage(url, 50, 50, False);
|
||||
end else if not (uin = '') then
|
||||
Result := '' + uin + ''
|
||||
else if not (srcCode = '') then
|
||||
begin
|
||||
if not (Root = nil) and (GetStyleAttr(Select('body'), '-syntax-highlight') = 'on') then
|
||||
begin
|
||||
srcCodeArr := TStringList.Create;
|
||||
if TrimMsgNewLines then
|
||||
srcCodeArr.Text := srcCode.Trim([#13, #10])
|
||||
else
|
||||
srcCodeArr.Text := srcCode;
|
||||
|
||||
srcCodeHTML := '';
|
||||
for i := 0 to srcCodeArr.Count - 1 do
|
||||
srcCodeHTML := srcCodeHTML + ' |
||||
srcCodeArr.Free;
|
||||
|
||||
Result := ' |
||||
' |
||||
' |
||||
end else
|
||||
Result := match;
|
||||
end else if not (bold = '') then
|
||||
Result := '' + bold + ''
|
||||
else if not (underlined = '') then
|
||||
Result := '' + underlined + ''
|
||||
else if not (comment = '') then
|
||||
Result := '> ' + comment + ''
|
||||
else
|
||||
Result := match;
|
||||
end;
|
||||
|
||||
procedure TChatBox.ReplaceOtherMatch(Sender: TObject; var ReplaceWith: PCREString);
|
||||
var
|
||||
args: TArray |
||||
i: Integer;
|
||||
begin
|
||||
SetLength(args, 9);
|
||||
for i := 0 to msgRegex.GroupCount do // +1 for total match
|
||||
args[i] := msgRegex.Groups[i];
|
||||
ReplaceWith := GetReplacement(args);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ReplaceSmileMatch(Sender: TObject; var ReplaceWith: PCREString);
|
||||
var
|
||||
smileData: TPair |
||||
smile: String;
|
||||
begin
|
||||
if (theme.smileRegEx.GroupCount > 0) and theme.smileArray.TryGetValue(theme.smileRegEx.Groups[1], smileData) then
|
||||
begin
|
||||
smile := THTMLEncoding.HTML.Encode(theme.smileRegEx.Groups[1]);
|
||||
ReplaceWith := ' |
IntToStr(smileData.Value.Width) + 'px; height: ' + IntToStr(smileData.Value.Height) + 'px;">' + smile + '' +
|
|||
'' + smile + ''
|
||||
end else
|
||||
ReplaceWith := theme.smileRegEx.Groups[0];
|
||||
end;
|
||||
|
||||
function TChatBox.ReplaceEmoji(const msg: String): String;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
procedure GetReplacedEmoji(cp1, cp2: Cardinal; const emoji: String);
|
||||
var
|
||||
pos: Integer;
|
||||
begin
|
||||
if theme.HasOrigPic('emoji.sprite') and emojis.TryGetValue(TPair |
||||
Result := Result + ' |
IntToStr(emojiSize) + 'px; background-position: ' + IntToStr(-(pos mod emojisInARow) * emojiSize) + ' ' +
|
|||
IntToStr(-floor(pos / emojisInARow) * emojiSize) + ';">' + emoji + '' + emoji + ''
|
||||
else
|
||||
Result := Result + emoji;
|
||||
inc(i, Length(emoji));
|
||||
end;
|
||||
|
||||
function IsSingle(const num: Integer): Boolean;
|
||||
var
|
||||
c: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
for c := Low(singles) to High(singles) do
|
||||
if num = singles[c] then
|
||||
Exit(True);
|
||||
end;
|
||||
|
||||
begin
|
||||
i := 1;
|
||||
Result := '';
|
||||
|
||||
while i <= Length(msg) do
|
||||
if IsSurrogate(msg, i) and IsSurrogatePair(msg, i) then
|
||||
begin
|
||||
if (i+2 < Length(msg)) and IsSurrogate(msg, i+2) and IsSurrogatePair(msg, i+2)
|
||||
and (IsHighSurrogate(msg, i+2)) and (IsLowSurrogate(msg, i+3))
|
||||
and ((InRange(ord(ConvertToUtf32(msg, i)), $1f100, $1f1ff) and InRange(ord(ConvertToUtf32(msg, i+2)), $1f100, $1f1ff))
|
||||
or (ord(ConvertToUtf32(msg, i+2)) = $1f5e8))
|
||||
then
|
||||
GetReplacedEmoji(ConvertToUtf32(msg, i), ConvertToUtf32(msg, i+2), Copy(msg, i, 4))
|
||||
else if (IsHighSurrogate(msg, i)) and (IsLowSurrogate(msg, i+1)) then
|
||||
GetReplacedEmoji(ConvertToUtf32(msg, i), 0, Copy(msg, i, 2))
|
||||
end else if (i+1 < Length(msg)) and (CharInSet(msg[i], ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '#', '*']) and (ord(msg[i+1]) = $20E3)) then
|
||||
GetReplacedEmoji(ord(msg[i]), ord(msg[i+1]), Copy(msg, i, 2))
|
||||
else if IsSingle(ord(msg[i])) then
|
||||
GetReplacedEmoji(ord(msg[i]), 0, msg[i])
|
||||
else
|
||||
begin
|
||||
Result := Result + msg[i];
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatBox.ParseMessageBody(const body: String): String;
|
||||
|
||||
function FastReplaceAll(const text, searchExp, rep: PCREString): PCREString;
|
||||
var
|
||||
theRegex: TPerlRegEx;
|
||||
begin
|
||||
theRegex := TPerlRegEx.Create;
|
||||
theRegex.RegEx := searchExp;
|
||||
theRegex.State := [preNotEmpty];
|
||||
theRegex.Subject := text;
|
||||
theRegex.Replacement := rep;
|
||||
if theRegex.ReplaceAll then
|
||||
Result := theRegex.Subject
|
||||
else
|
||||
Result := text;
|
||||
theRegex.Free;
|
||||
end;
|
||||
|
||||
var
|
||||
Res: PCREString;
|
||||
begin
|
||||
if body = '' then
|
||||
Exit('');
|
||||
|
||||
Res := THTMLEncoding.HTML.Encode(body);
|
||||
Res := FastReplaceAll(Res, '\x{0000}', '');
|
||||
|
||||
if theme.smileArray.Count > 0 then
|
||||
begin
|
||||
theme.smileRegEx.Subject := Res;
|
||||
theme.smileRegEx.OnReplace := ReplaceSmileMatch;
|
||||
if theme.smileRegEx.ReplaceAll then
|
||||
Res := theme.smileRegEx.Subject;
|
||||
end;
|
||||
|
||||
msgRegex.Subject := Res;
|
||||
msgRegex.OnReplace := ReplaceOtherMatch;
|
||||
if msgRegex.ReplaceAll then
|
||||
Res := msgRegex.Subject;
|
||||
|
||||
Result := ReplaceEmoji(Res);
|
||||
end;
|
||||
|
||||
procedure GetLinkInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Link, FileId, Contact, ViralClass, Transcript: String;
|
||||
LinkInfo: TLinkInfo;
|
||||
FileInfo: TICQFileInfo;
|
||||
Infos: TArray |
||||
Params: TParams;
|
||||
Anketa: TAnketa;
|
||||
I: Integer;
|
||||
begin
|
||||
Link := SciterVarToString(argv);
|
||||
SetLength(Infos, 0);
|
||||
|
||||
if ContainsText(Link, 'files.icq.net/') then
|
||||
begin
|
||||
FileInfo := GetICQFileLinkInfoPublic(Link);
|
||||
if not (FileInfo.filename = '') then
|
||||
begin
|
||||
SetLength(Infos, 4);
|
||||
Infos[0].param := GetTranslation('Filename');
|
||||
Infos[0].value := FileInfo.filename;
|
||||
Infos[1].param := GetTranslation('Type');
|
||||
Infos[1].value := FileInfo.mime;
|
||||
Infos[2].param := GetTranslation('Size');
|
||||
Infos[2].value := HumanReadableSize(FileInfo.filesize);
|
||||
if FileInfo.avstatus = '' then
|
||||
FileInfo.avstatus := 'no data';
|
||||
ViralClass := IfThen((FileInfo.avstatus = 'healthy') or (FileInfo.avstatus = 'safe'), 'safe', 'unsafe');
|
||||
Infos[3].param := GetTranslation('Viral status');
|
||||
Infos[3].value := '' + GetTranslation(FileInfo.avstatus) + '';
|
||||
if FileInfo.recognized then
|
||||
begin
|
||||
FileId := ReplaceText(Trim(Link), 'https://files.icq.net/get/', '');
|
||||
FileId := ReplaceText(FileId, 'https://files.icq.net/files/get?fileId=', '');
|
||||
Transcript := Account.AccProto.GetSpeechToText(FileId);
|
||||
if not (Transcript = '') then
|
||||
begin
|
||||
SetLength(Infos, 5);
|
||||
Infos[4].param := 'TRANSCRIPTION';
|
||||
Infos[4].value := Transcript;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end else if Account.AccProto.IsOnline and ContainsText(Link, 'icq.im/') then
|
||||
begin
|
||||
Contact := Link.Substring(Link.LastIndexOf('icq.im/') + 7, Length(Link));
|
||||
if Account.AccProto.SearchContact(Contact, Anketa) then
|
||||
begin
|
||||
SetLength(Infos, 4);
|
||||
Infos[0].param := 'UIN';
|
||||
Infos[0].value := Anketa.UID;
|
||||
Infos[1].param := GetTranslation('Nick');
|
||||
Infos[1].value := Anketa.Nick;
|
||||
Infos[2].param := GetTranslation('Name');
|
||||
Infos[2].value := Anketa.Friendly;
|
||||
Infos[3].param := 'AVATAR';
|
||||
Infos[3].value := Anketa.AvatarURL;
|
||||
if Anketa.Bot then
|
||||
begin
|
||||
SetLength(Infos, 5);
|
||||
Infos[4].param := GetTranslation('Bot contact');
|
||||
Infos[4].value := '';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Length(Infos) = 0 then
|
||||
begin
|
||||
LinkInfo := InfoFromURL(Link);
|
||||
SetLength(Infos, 3);
|
||||
Infos[0].param := GetTranslation('Response code');
|
||||
Infos[0].value := IntToStr(LinkInfo.code) + ' ' + StatusText(LinkInfo.code);
|
||||
Infos[1].param := GetTranslation('Type');
|
||||
Infos[1].value := LinkInfo.mime;
|
||||
Infos[2].param := GetTranslation('Size');
|
||||
Infos[2].value := IfThen(LinkInfo.size < 0, '-', HumanReadableSize(LinkInfo.size));
|
||||
// if LinkInfo.redirects > 0 then
|
||||
// begin
|
||||
// SetLength(Infos, 4);
|
||||
// Infos[3].param := GetTranslation('Redirects');
|
||||
// Infos[3].value := IntToStr(LinkInfo.redirects);
|
||||
// end;
|
||||
end;
|
||||
|
||||
SetLength(Params, Length(Infos));
|
||||
for I := 0 to Length(Infos) - 1 do
|
||||
Params[I] := UI.RecordToVar(Infos[I]);
|
||||
|
||||
V2S(Params, retval);
|
||||
SetLength(Infos, 0);
|
||||
end;
|
||||
|
||||
function DecodeFormat(format: String): String;
|
||||
begin
|
||||
Result := '';
|
||||
format := DecodeURL(format);
|
||||
if format.ToLower.Contains('video/mp4') then
|
||||
Result := 'MP4'
|
||||
else if format.ToLower.Contains('video/webm') then
|
||||
Result := 'WEBM'
|
||||
else if format.ToLower.Contains('video/x-flv') then
|
||||
Result := 'FLV'
|
||||
else if format.ToLower.Contains('video/3gpp') then
|
||||
Result := '3GPP'
|
||||
end;
|
||||
|
||||
procedure GetYoutubeLinks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
ytlink: String;
|
||||
ytpage, ytjson, yttitle, anchor: RawByteString;
|
||||
ytmap: TJSONArray;
|
||||
ytitem: TStringList;
|
||||
ytfmts: TDictionary |
||||
ytfmt: TVideoFormat;
|
||||
fs: TMemoryStream;
|
||||
i, j, p, arrsize: Integer;
|
||||
ignore3GPP: Boolean;
|
||||
mimeType: String;
|
||||
tmpVal: TSciterValue;
|
||||
JSONObject: TJSONObject;
|
||||
begin
|
||||
arrsize := 0;
|
||||
ytlink := '';
|
||||
|
||||
if argc > 0 then
|
||||
ytlink := SciterVarToString(argv);
|
||||
|
||||
if ytlink = '' then
|
||||
Exit;
|
||||
|
||||
fs := TMemoryStream.Create;
|
||||
LoadFromURLAsStream(ytlink, fs);
|
||||
SetLength(ytpage, fs.Size);
|
||||
fs.ReadBuffer(ytpage[1], fs.Size);
|
||||
fs.Free;
|
||||
|
||||
anchor := 'ytplayer.config =';
|
||||
i := pos(anchor, ytpage);
|
||||
if i = 0 then
|
||||
Exit;
|
||||
ytjson := copy(ytpage, i + length(anchor));
|
||||
ytjson := copy(ytjson, 1, pos('};', ytjson));
|
||||
|
||||
JSONObject := TJSONObject.ParseJSONValue(Trim(ytjson)) as TJSONObject;
|
||||
if Assigned(JSONObject) then
|
||||
try
|
||||
ytjson := (JSONObject.GetValue('args') as TJSONObject).GetValue('player_response').Value;
|
||||
JSONObject := TJSONObject.ParseJSONValue(ytjson) as TJSONObject;
|
||||
if Assigned(JSONObject) then
|
||||
begin
|
||||
ytfmts := TDictionary |
||||
ytmap := (JSONObject.GetValue('streamingData') as TJSONObject).GetValue('formats') as TJSONArray;
|
||||
for i := 0 to ytmap.Count - 1 do
|
||||
begin
|
||||
ytfmt := Default(TVideoFormat);
|
||||
ytfmt.url := (ytmap.Items[i] as TJSONObject).GetValue('url').Value;
|
||||
ytfmt.quality := (ytmap.Items[i] as TJSONObject).GetValue('quality').Value;
|
||||
|
||||
mimeType := (ytmap.Items[i] as TJSONObject).GetValue('mimeType').Value;
|
||||
p := pos(';', mimeType);
|
||||
if p > 0 then
|
||||
begin
|
||||
ytfmt.format := copy(mimeType, 1, p - 1);
|
||||
p := pos('codecs=', mimeType);
|
||||
ytfmt.codecs := copy(mimeType, p + 7).Replace('"', '');
|
||||
end else
|
||||
ytfmt.format := mimeType;
|
||||
|
||||
ytfmts.Add(i, ytfmt);
|
||||
end;
|
||||
end;
|
||||
except end;
|
||||
|
||||
if not Assigned(ytfmts) then
|
||||
Exit;
|
||||
|
||||
anchor := 'property="og:title" content="';
|
||||
yttitle := copy(ytpage, pos(anchor, ytpage) + length(anchor));
|
||||
yttitle := copy(yttitle, 1, pos('"', yttitle) - 1);
|
||||
yttitle := DecodeURL(UnUTF(yttitle));
|
||||
|
||||
ytitem := TStringList.Create;
|
||||
ytitem.Delimiter := '|';
|
||||
ytitem.StrictDelimiter := true;
|
||||
ytitem.Sorted := False;
|
||||
|
||||
ignore3GPP := False;
|
||||
for i := 0 to ytfmts.Count - 1 do
|
||||
begin
|
||||
ytfmts.TryGetValue(i, ytfmt);
|
||||
if ((PreferredResolution = 0) and ytfmt.quality.Contains('1080'))
|
||||
or ((PreferredResolution = 1) and (ytfmt.quality.Contains('720') or ytfmt.quality.ToLower.Contains('hd')))
|
||||
or ((PreferredResolution = 2) and ytfmt.quality.ToLower.Contains('medium'))
|
||||
or ((PreferredResolution = 3) and ytfmt.quality.ToLower.Contains('small')) then
|
||||
begin
|
||||
if ytfmt.format.ToLower.Contains('video/3gpp') and ignore3GPP then
|
||||
Continue;
|
||||
//OutputDebugString(PChar('Preferred: ' + ytfmt.quality + ', ' + ytfmt.format));
|
||||
ytlink := '{"format":"' + DecodeFormat(ytfmt.format) + '","codecs":"' + DecodeURL(ytfmt.codecs) + '","title":"' + yttitle + '","url":"' + DecodeURL(ytfmt.url) + '"}';
|
||||
|
||||
API.ValueInit(@tmpVal);
|
||||
API.ValueStringDataSet(@tmpVal, PWideChar(ytlink), Length(ytlink), 0);
|
||||
API.ValueNthElementValueSet(retval, arrsize, @tmpVal);
|
||||
API.ValueClear(@tmpVal);
|
||||
Inc(arrsize);
|
||||
|
||||
if ytfmt.format.ToLower.Contains('video/3gpp') then
|
||||
ignore3GPP := True;
|
||||
end;
|
||||
end;
|
||||
if arrsize = 0 then
|
||||
begin
|
||||
ytfmts.TryGetValue(ytfmts.Count - 1, ytfmt);
|
||||
//OutputDebugString(PChar('No preferred: ' + ytfmt.quality + ', ' + ytfmt.format));
|
||||
ytlink := '{"format":"' + DecodeFormat(ytfmt.format) + '","codecs":"' + DecodeURL(ytfmt.codecs) + '","title":"' + yttitle + '","url":"' + DecodeURL(ytfmt.url) + '"}';
|
||||
API.ValueInit(@tmpVal);
|
||||
API.ValueStringDataSet(@tmpVal, PWideChar(ytlink), Length(ytlink), 0);
|
||||
API.ValueNthElementValueSet(retval, 0, @tmpVal);
|
||||
API.ValueClear(@tmpVal);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetVimeoLinks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
vmlink: String;
|
||||
vmpage, vmurl, vmtitle, anchor: RawByteString;
|
||||
vmmap: TJSONArray;
|
||||
vmfmts: TDictionary |
||||
vmfmt: TVideoFormat;
|
||||
fs: TMemoryStream;
|
||||
i, arrsize: Integer;
|
||||
JSONObject: TJSONObject;
|
||||
tmpVal: TSciterValue;
|
||||
begin
|
||||
arrsize := 0;
|
||||
vmlink := '';
|
||||
|
||||
if argc > 0 then
|
||||
vmlink := SciterVarToString(argv);
|
||||
|
||||
if vmlink = '' then
|
||||
Exit;
|
||||
|
||||
fs := TMemoryStream.Create;
|
||||
LoadFromURLAsStream(vmlink, fs);
|
||||
SetLength(vmpage, fs.Size);
|
||||
fs.ReadBuffer(vmpage[1], fs.Size);
|
||||
|
||||
anchor := 'config_url":"';
|
||||
i := pos(anchor, vmpage);
|
||||
if i = 0 then
|
||||
Exit;
|
||||
vmurl := copy(vmpage, i + Length(anchor));
|
||||
vmurl := copy(vmurl, 1, pos('"', vmurl) - 1);
|
||||
vmurl := String(vmurl).Replace('\/', '/');
|
||||
|
||||
anchor := 'property="og:title" content="';
|
||||
vmtitle := copy(vmpage, pos(anchor, vmpage) + Length(anchor));
|
||||
vmtitle := copy(vmtitle, 1, pos('"', vmtitle) - 1);
|
||||
vmtitle := DecodeURL(UnUTF(vmtitle));
|
||||
|
||||
fs.Clear;
|
||||
LoadFromURLAsStream(vmurl, fs);
|
||||
SetLength(vmpage, fs.Size);
|
||||
fs.ReadBuffer(vmpage[1], fs.Size);
|
||||
fs.Free;
|
||||
|
||||
vmfmts := TDictionary |
||||
JSONObject := TJSONObject.ParseJSONValue(vmpage) as TJSONObject;
|
||||
if Assigned(JSONObject) then
|
||||
try
|
||||
vmmap := (((JSONObject.GetValue('request') as TJSONObject).GetValue('files') as TJSONObject).GetValue('progressive') as TJSONArray);
|
||||
for i := 0 to vmmap.Count - 1 do
|
||||
begin
|
||||
vmfmt.url := (vmmap.Items[i] as TJSONObject).GetValue('url').Value;
|
||||
vmfmt.quality := (vmmap.Items[i] as TJSONObject).GetValue('quality').Value;
|
||||
vmfmt.format := (vmmap.Items[i] as TJSONObject).GetValue('mime').Value;
|
||||
vmfmts.Add(i, vmfmt);
|
||||
end;
|
||||
except end;
|
||||
|
||||
for i := 0 to vmfmts.Count - 1 do
|
||||
begin
|
||||
vmfmts.TryGetValue(i, vmfmt);
|
||||
if ((PreferredResolution = 0) and (vmfmt.quality = '1080p'))
|
||||
or ((PreferredResolution = 1) and (vmfmt.quality = '720p'))
|
||||
or ((PreferredResolution = 2) and (vmfmt.quality = '540p'))
|
||||
or ((PreferredResolution = 3) and (vmfmt.quality = '360p')) then
|
||||
begin
|
||||
//OutputDebugString(PChar('Preferred: ' + vmfmt.quality + ', ' + vmfmt.format));
|
||||
vmlink := '{"format":"' + DecodeFormat(vmfmt.format) + '","codecs":"","title":"' + vmtitle + '","url":"' + vmfmt.url + '"}';
|
||||
API.ValueInit(@tmpVal);
|
||||
API.ValueStringDataSet(@tmpVal, PWideChar(vmlink), Length(vmlink), 0);
|
||||
API.ValueNthElementValueSet(retval, arrsize, @tmpVal);
|
||||
API.ValueClear(@tmpVal);
|
||||
Inc(arrsize);
|
||||
end;
|
||||
end;
|
||||
if arrsize = 0 then
|
||||
begin
|
||||
vmfmts.TryGetValue(0, vmfmt);
|
||||
//OutputDebugString(PChar('No preferred: ' + vmfmt.quality + ', ' + vmfmt.format));
|
||||
vmlink := '{"format":"' + DecodeFormat(vmfmt.format) + '","codecs":"","title":"' + vmtitle + '","url":"' + vmfmt.url + '"}';
|
||||
API.ValueInit(@tmpVal);
|
||||
API.ValueStringDataSet(@tmpVal, PWideChar(vmlink), Length(vmlink), 0);
|
||||
API.ValueNthElementValueSet(retval, 0, @tmpVal);
|
||||
API.ValueClear(@tmpVal);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetVolumeLevel(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
level: String;
|
||||
leveldb: Double;
|
||||
begin
|
||||
MainPrefs.getPrefStr('chat-video-volume-level', level);
|
||||
if TryStrToFloat(level, leveldb) then
|
||||
API.ValueFloatDataSet(retval, leveldb, T_FLOAT, 0)
|
||||
else
|
||||
API.ValueFloatDataSet(retval, 0.85, T_FLOAT, 0); // Volume 50%
|
||||
end;
|
||||
|
||||
procedure SaveVolumeLevel(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
leveldb: Double;
|
||||
begin
|
||||
leveldb := 0.85;
|
||||
if argc > 0 then
|
||||
API.ValueFloatData(argv, leveldb);
|
||||
MainPrefs.addPrefStr('chat-video-volume-level', FloatToStr(leveldb));
|
||||
end;
|
||||
|
||||
procedure ChatPageSelected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
uid: TUID;
|
||||
txt: String;
|
||||
ch: TChatInfo;
|
||||
begin
|
||||
if argc < 2 then
|
||||
Exit;
|
||||
|
||||
uid := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
txt := SciterVarToString(argv);
|
||||
|
||||
with UI.Chat do
|
||||
if not (uid = '') and Assigned(chats) and not (chats.Count = 0) then
|
||||
begin
|
||||
ch := chats.byUIN(uid);
|
||||
CurrentContact := ch.who;
|
||||
|
||||
if AutoConsumeEvents and IsVisible then
|
||||
SawAllHere;
|
||||
|
||||
if autoSwitchKL and Assigned(LastContact) and not (LastContact = CurrentContact) and (pTCE(CurrentContact.data).keylay <> 0) then
|
||||
ActivateKeyboardLayout(pTCE(CurrentContact.data).keylay, 0);
|
||||
LastContact := nil;
|
||||
|
||||
if Running and EnableSpellCheck then
|
||||
begin
|
||||
SetSpellText(txt);
|
||||
DoSpellCheck;
|
||||
end;
|
||||
UpdateGraphics;
|
||||
|
||||
SetupStickersBtn(EnableStickers);
|
||||
SetupBuzzBtn(CurrentContact.CanBuzz);
|
||||
plugins.castEv(PE_SELECTPAGE, CurrentContact.UID);
|
||||
end else
|
||||
begin
|
||||
CurrentContact := nil;
|
||||
OutputDebugString(PChar('CurrentContact is nil'));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ChatPageDeselected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
Ch: TChatInfo;
|
||||
begin
|
||||
UID := SciterVarToString(argv);
|
||||
with UI.Chat do
|
||||
if not (UID = '') and Assigned(chats) and not (chats.count = 0) then
|
||||
begin
|
||||
LastContact := nil;
|
||||
Ch := chats.byUIN(UID);
|
||||
if Assigned(Ch) then
|
||||
with Ch do
|
||||
begin
|
||||
LastContact := who;
|
||||
if Assigned(who) then
|
||||
begin
|
||||
pTCE(who.data).keylay := GetKeyboardLayout(0);
|
||||
plugins.castEv(PE_DESELECTPAGE, who.UID);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PluginPageSelected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
id: Integer;
|
||||
ch: TChatInfo;
|
||||
begin
|
||||
API.ValueIntData(argv, id);
|
||||
|
||||
with UI.Chat do
|
||||
if not (id = 0) and Assigned(chats) and not (chats.count = 0) then
|
||||
begin
|
||||
ch := chats.byID(id);
|
||||
CurrentContact := nil;
|
||||
|
||||
SetupBuzzBtn(False);
|
||||
SetupStickersBtn(False);
|
||||
plugins.castEv(PE_SELECTTAB, ch.ID);
|
||||
end else
|
||||
CurrentContact := nil;
|
||||
end;
|
||||
|
||||
procedure PluginPageDeselected(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
id: Integer;
|
||||
ch: TChatInfo;
|
||||
begin
|
||||
API.ValueIntData(argv, id);
|
||||
|
||||
with UI.Chat do
|
||||
if not (id = 0) and Assigned(chats) and not (chats.count = 0) then
|
||||
begin
|
||||
LastContact := nil;
|
||||
ch := chats.byID(id);
|
||||
if Assigned(ch) then
|
||||
plugins.castEv(PE_DESELECTTAB, ch.ID);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetTabDragging(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
tmpInt: Integer;
|
||||
begin
|
||||
if (argc = 0) or not Assigned(UI.Chat) then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, tmpInt);
|
||||
UI.Chat.DraggingTab := tmpInt = 1;
|
||||
end;
|
||||
|
||||
procedure CloseChatPage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
begin
|
||||
if (argc = 0) or not Assigned(UI.Chat) then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
UI.Chat.CloseChatUID(UID);
|
||||
end;
|
||||
|
||||
procedure ClosePluginPage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
id: Integer;
|
||||
begin
|
||||
if (argc = 0) or not Assigned(UI.Chat) then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, id);
|
||||
UI.Chat.CloseChatID(id);
|
||||
end;
|
||||
|
||||
procedure AddUIN2CL(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
uid: TUID;
|
||||
MTag: String;
|
||||
_MTag: Integer;
|
||||
Contact: TICQContact;
|
||||
begin
|
||||
if argc < 2 then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
MTag := SciterVarToString(argv);
|
||||
|
||||
Contact := UI.Chat.CurrentContact;
|
||||
if Assigned(Contact) then
|
||||
Contact := Account.AccProto.GetContact(UID);
|
||||
if Assigned(Contact) and TryStrToInt(MTag, _MTag) then
|
||||
utilLib.AddToRoster(Contact, _MTag, Contact.CntIsLocal)
|
||||
end;
|
||||
|
||||
function StripProtocol(const StringData: String): String;
|
||||
begin
|
||||
if StartsText('uin:', StringData) then
|
||||
Result := copy(StringData, 5, length(StringData))
|
||||
else if StartsText('link:', stringData) then
|
||||
Result := copy(StringData, 6, length(StringData))
|
||||
else if StartsText('mailto:', stringData) then
|
||||
Result := copy(StringData, 8, length(StringData))
|
||||
else
|
||||
Result := stringData;
|
||||
end;
|
||||
|
||||
procedure CopyLink(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if argc > 0 then
|
||||
Clipboard.AsText := StripProtocol(SciterVarToString(argv));
|
||||
end;
|
||||
|
||||
procedure SavePicture(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
str: String;
|
||||
fs: TFileStream;
|
||||
img: TBytes;
|
||||
pic: TMemoryStream;
|
||||
hash: LongWord;
|
||||
realurl, fn, fmt: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
str := SciterVarToString(argv);
|
||||
|
||||
if Assigned(UI.Chat.CurrentContact) then
|
||||
with UI.Chat.CurrentContact do
|
||||
if StartsText('download:', str) then
|
||||
begin
|
||||
realurl := Copy(str, 10, Length(str));
|
||||
fn := myPath + 'Cache\Images\' + ImgCacheInfo.ReadString(realurl, 'hash', '0') + '.' + ImgCacheInfo.ReadString(realurl, 'ext', 'jpg');
|
||||
if FileExists(fn) then
|
||||
begin
|
||||
fs := TFileStream.Create(fn, fmOpenRead);
|
||||
pic := TMemoryStream.Create;
|
||||
pic.LoadFromStream(fs);
|
||||
fmt := PAFormat[DetectFileFormatStream(pic)];
|
||||
Delete(fmt, 1, 1);
|
||||
fmt := openSaveDlg(nil, '', false, fmt);
|
||||
if fmt > '' then
|
||||
pic.SaveToFile(fmt);
|
||||
pic.free;
|
||||
if Assigned(fs) then
|
||||
fs.Free;
|
||||
end;
|
||||
end else if StartsText('embedded:', str) then
|
||||
begin
|
||||
realurl := copy(str, 10, length(str));
|
||||
if TryStrToLongWord(realurl, hash) and Assigned(embeddedImgs) and embeddedImgs.TryGetValue(hash, img) then
|
||||
begin
|
||||
pic := TMemoryStream.Create;
|
||||
pic.Write(img, Length(img));
|
||||
fmt := PAFormat[DetectFileFormatStream(pic)];
|
||||
Delete(fmt, 1, 1);
|
||||
fmt := openSaveDlg(nil, '', false, fmt);
|
||||
if fmt > '' then
|
||||
pic.SaveToFile(fmt);
|
||||
pic.free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetEvent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
uid: TUID;
|
||||
clickedTime: String;
|
||||
time: TDateTime;
|
||||
ev: Thevent;
|
||||
hdr: THeader;
|
||||
MessageHeader: TMessageHeader;
|
||||
// imgList: TImgBytes;
|
||||
// imgcnt: Integer;
|
||||
// imgs,
|
||||
ffs: TFormatSettings;
|
||||
history: Thistory;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
ev := nil;
|
||||
uid := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
clickedTime := SciterVarToString(argv);
|
||||
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
time := StrToFloat(clickedTime, ffs);
|
||||
|
||||
if uid = '' then
|
||||
Exit;
|
||||
|
||||
history := UI.Chat.GetHistory(uid);
|
||||
if Assigned(history) then
|
||||
ev := history.getByTime(time);
|
||||
if ev = nil then
|
||||
Exit;
|
||||
{
|
||||
if (ev.kind = EK_msg) and (Length(ev.getBodyBin) > 0) then
|
||||
begin
|
||||
getMsgImages(ev.getBodyBin, imgList);
|
||||
imgs := VarArrayCreate([0, Length(imgList) - 1], varByte);
|
||||
for imgcnt := 0 to Length(imgList) - 1 do
|
||||
imgs[imgcnt] := imgList[imgcnt];
|
||||
SetLength(imgList, 0);
|
||||
end;
|
||||
}
|
||||
hdr := ev.getHeaderTexts;
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
|
||||
MessageHeader.caption := hdr.prefix + hdr.date + ', ' + hdr.what;
|
||||
MessageHeader.text := ev.getBodyText;
|
||||
MessageHeader.when := FloatToStr(ev.when, ffs);
|
||||
MessageHeader.img := ev.pic;
|
||||
|
||||
V2S(UI.RecordToVar(MessageHeader), retval);
|
||||
|
||||
ev.Free;
|
||||
end;
|
||||
|
||||
procedure SaveAs(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
format: Integer;
|
||||
fn, caption, ext: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, format);
|
||||
|
||||
if format = 0 then
|
||||
begin
|
||||
caption := 'Save text as UTF-8 file';
|
||||
ext := 'txt';
|
||||
end else if format = 1 then
|
||||
begin
|
||||
caption := 'Save as HTML';
|
||||
ext := 'html';
|
||||
end else if format = 2 then
|
||||
begin
|
||||
caption := 'Save screenshot as file';
|
||||
ext := GetSnapshotExt;
|
||||
end;
|
||||
|
||||
fn := openSavedlg(nil, GetTranslation(caption), False, ext);
|
||||
if not (fn = '') then
|
||||
if format = 0 then
|
||||
saveTextFile(fn, UI.Chat.selectedText)
|
||||
else if format = 1 then
|
||||
saveTextFile(fn, UI.Chat.getSelHtml(False))
|
||||
else if format = 2 then
|
||||
if not MoveFileEx(PWideChar(CacheDir + GetSnapshotFilename), PWideChar(fn), MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED) then
|
||||
begin
|
||||
MsgDlg(GetTranslation('Failed to save screenshot\n[%d] %s', [GetLastError, SysErrorMessage(GetLastError)]), True, mtWarning);
|
||||
DeleteFile(CacheDir + GetSnapshotFilename);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddLinkToFav(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if argc > 0 then
|
||||
AddLinkToFavorites(StripProtocol(SciterVarToString(argv)));
|
||||
end;
|
||||
|
||||
procedure DeleteMessages(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
Option: String;
|
||||
History: Thistory;
|
||||
IDs: Variant;
|
||||
MsgIDs: TArray |
||||
MsgID: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
Option := SciterVarToString(argv);
|
||||
|
||||
with UI.Chat do
|
||||
begin
|
||||
if not WholeEventsAreSelected then
|
||||
Exit;
|
||||
|
||||
if Option = 'local' then
|
||||
begin
|
||||
if MessageDlg(GetTranslation('All messages between first and last selected will be removed! Are you sure you want to proceed?'), mtConfirmation, [mbYes, mbNo]) = mrNo then
|
||||
Exit;
|
||||
|
||||
if StartSel > EndSel then
|
||||
swap4(StartSel, EndSel);
|
||||
|
||||
History := GetHistory(UID);
|
||||
if Assigned(History) then
|
||||
begin
|
||||
History.DeleteFromToTime(StartSel, EndSel);
|
||||
DeleteEvents(UID, StartSel, EndSel);
|
||||
ClearSelection(UID);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(argv);
|
||||
S2V(argv, IDs);
|
||||
|
||||
if (Length(TArray |
||||
Exit;
|
||||
|
||||
if MessageDlg(GetTranslation('Selected messages will be removed permanently!\nAre you sure you want to proceed?'), mtConfirmation, [mbYes, mbNo]) = mrNo then
|
||||
Exit;
|
||||
|
||||
MsgIDs := IDs;
|
||||
Account.AccProto.DeleteMessages(UID, MsgIDs, Option = 'forall');
|
||||
|
||||
History := GetHistory(UID);
|
||||
if Assigned(History) then
|
||||
for MsgID in MsgIDs do
|
||||
begin
|
||||
History.DeleteByMsgID(StrToUInt64(MsgID));
|
||||
DeleteEvent(UID, StrToUInt64(MsgID));
|
||||
end;
|
||||
ClearSelection(UID);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddToAntispam(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if not (spamfilter.badwords = '') and not (spamfilter.badwords[Length(spamfilter.badwords)] = ';') then
|
||||
spamfilter.badwords := spamfilter.badwords + ';';
|
||||
spamfilter.badwords := spamfilter.badwords + UI.Chat.selectedText;
|
||||
end;
|
||||
|
||||
procedure ToggleSmiles(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
UseSmiles := not UseSmiles;
|
||||
UI.Chat.InitSettings;
|
||||
UI.Chat.UpdateSmiles;
|
||||
end;
|
||||
|
||||
procedure ToggleRelTimes(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
RelativeTimeInChat := not RelativeTimeInChat;
|
||||
end;
|
||||
|
||||
procedure RealizeEvents(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
Ev: Thevent;
|
||||
Res: Boolean;
|
||||
begin
|
||||
Res := False;
|
||||
|
||||
if argc > 0 then
|
||||
begin
|
||||
UID := SciterVarToString(argv);
|
||||
Ev := eventQ.firstEventFor(Account.AccProto.GetContact(UID));
|
||||
if Assigned(Ev) then
|
||||
begin
|
||||
eventQ.Remove(Ev);
|
||||
realizeEvent(Ev);
|
||||
Res := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
API.ValueIntDataSet(retval, RDUtils.IfThen(Res, 1), T_BOOL, 0);
|
||||
end;
|
||||
|
||||
procedure StoreSplit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
t, val: Integer;
|
||||
begin
|
||||
if argc < 2 then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, t);
|
||||
Inc(argv);
|
||||
val := 150;
|
||||
API.ValueIntData(argv, val);
|
||||
if val > 0 then
|
||||
if t = 0 then
|
||||
SplitX := val
|
||||
else
|
||||
SplitY := val;
|
||||
end;
|
||||
|
||||
procedure InputChangedFor(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
Txt: String;
|
||||
TxtLen: Integer;
|
||||
begin
|
||||
if argc < 2 then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
Txt := SciterVarToString(argv);
|
||||
TxtLen := Length(Txt);
|
||||
|
||||
if EnableSpellCheck and SpellTextChanged(Txt) then
|
||||
begin
|
||||
SetSpellText(Txt);
|
||||
DoSpellCheck;
|
||||
end;
|
||||
|
||||
// Send typing notify
|
||||
Account.AccProto.InputChangedFor(Account.AccProto.GetContact(UID), TxtLen = 0);
|
||||
end;
|
||||
|
||||
procedure GetMessageByIdx(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
he: Thevent;
|
||||
history: Thistory;
|
||||
pQuoteIdx: Integer;
|
||||
res: TParams;
|
||||
quote: String;
|
||||
begin
|
||||
if argc < 2 then
|
||||
Exit;
|
||||
|
||||
UID := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, pQuoteIdx);
|
||||
|
||||
quote := '';
|
||||
history := UI.Chat.GetHistory(UID);
|
||||
if Assigned(history) then
|
||||
with history do
|
||||
begin
|
||||
// search for a msg to quote
|
||||
he := nil;
|
||||
if pQuoteIdx > 0 then
|
||||
begin
|
||||
Inc(pQuoteIdx);
|
||||
he := getLastEvent(pQuoteIdx);
|
||||
while Assigned(he) and (Account.AccProto.IsMyAcc(he.who) or not (he.kind in [EK_msg])) do
|
||||
begin
|
||||
Inc(pQuoteIdx);
|
||||
he.Free;
|
||||
he := getLastEvent(pQuoteIdx);
|
||||
end;
|
||||
if he = nil then
|
||||
pQuoteIdx := 0;
|
||||
end;
|
||||
if pQuoteIdx = 0 then // nothing found, try restarting search from the end
|
||||
begin
|
||||
pQuoteIdx := 1;
|
||||
he := getLastEvent(pQuoteIdx);
|
||||
while Assigned(he) and (Account.AccProto.IsMyAcc(he.who) or not (he.kind in [EK_msg])) do
|
||||
begin
|
||||
Inc(pQuoteIdx);
|
||||
he.Free;
|
||||
he := getLastEvent(pQuoteIdx);
|
||||
end;
|
||||
if he = nil then
|
||||
pQuoteIdx := 0;
|
||||
end;
|
||||
if pQuoteIdx = 0 then
|
||||
begin
|
||||
API.ValueIntDataSet(retval, 0, T_BOOL, 0);
|
||||
Exit; // nothing found, really
|
||||
end;
|
||||
if Assigned(he) then
|
||||
begin
|
||||
quote := he.getBodyText();
|
||||
FreeAndNil(he);
|
||||
end;
|
||||
end;
|
||||
|
||||
SetLength(res, 2);
|
||||
res[0] := pQuoteIdx;
|
||||
res[1] := quote;
|
||||
|
||||
V2S(res, retval);
|
||||
end;
|
||||
|
||||
procedure WrapText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
str: String;
|
||||
WrappedStr: String;
|
||||
Limit: Integer;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
Str := SciterVarToString(argv);
|
||||
if argc > 1 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, Limit);
|
||||
end else
|
||||
Limit := 50;
|
||||
|
||||
WrappedStr := System.SysUtils.WrapText(Str, Limit);
|
||||
API.ValueStringDataSet(retval, PWideChar(WrappedStr), Length(WrappedStr), 0);
|
||||
end;
|
||||
|
||||
procedure Send(ch: TChatInfo; flags_: Integer; const msg: String = '');
|
||||
begin
|
||||
if Trim(msg) = '' then
|
||||
begin
|
||||
MsgDlg('Can''t send an empty message', True, mtWarning);
|
||||
Exit;
|
||||
end;
|
||||
if Assigned(UI.Chat) then
|
||||
with UI.Chat do
|
||||
begin
|
||||
SawAllHere;
|
||||
OutboxAdd(OE_msg, ch.who, flags_, msg);
|
||||
if ch.single then
|
||||
begin
|
||||
if ClosePageOnSingle then
|
||||
CloseChat(ch)
|
||||
else
|
||||
Hide;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SendChatMessage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
UID: TUID;
|
||||
Msg: String;
|
||||
opt, flag: Integer;
|
||||
ch: TChatInfo;
|
||||
lShouldEncr, isBin: Boolean;
|
||||
s, s1: String;
|
||||
Max, i: Integer;
|
||||
UINs: Variant;
|
||||
begin
|
||||
if argc < 3 then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, opt);
|
||||
Inc(argv);
|
||||
UID := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
Msg := SciterVarToString(argv);
|
||||
|
||||
flag := 0;
|
||||
ch := UI.Chat.chats.byUIN(uid);
|
||||
if (ch = nil) or (ch.chatType = CT_PLUGING) or (ch.who = nil) then
|
||||
Exit;
|
||||
|
||||
case opt of
|
||||
0:
|
||||
begin
|
||||
isBin := (Pos(RnQImageTag, msg) > 0) or ((Pos(RnQImageExTag, msg) > 0)) or (IF_Bin and flag > 0);
|
||||
lShouldEncr := (Account.AccProto.UseCryptMsg and (TICQContact(ch.who).Crypt.supportCryptMsg or
|
||||
(Account.AccProto.fECCKeys.generated and Account.AccProto.UseEccCryptMsg and TICQContact(ch.who).crypt.supportEcc)))
|
||||
and not isBin;
|
||||
if lShouldEncr and ch.who.isOffline then
|
||||
begin
|
||||
if MessageDlg(GetTranslation('Encrypted messages cannot be delivered to offline contacts. Send without encryption?'), mtConfirmation, [mbYes, mbNo]) = mrYes then
|
||||
begin
|
||||
TICQContact(ch.who).Crypt.supportCryptMsg := False;
|
||||
TICQContact(ch.who).Crypt.supportEcc := False;
|
||||
end else
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Max := Account.AccProto.MaxCharsFor(ch.who);
|
||||
if Length(msg) > Max then
|
||||
begin
|
||||
if MessageDlg(getTranslation('Your message is too long. Max %d characters.\nSplit the message?',
|
||||
[Max]), mtInformation, [mbYes, mbNo]) = mrYes then
|
||||
begin
|
||||
s := msg;
|
||||
repeat
|
||||
s1 := Copy(s, 1, Max - 1);
|
||||
Delete(s, 1, Max - 1);
|
||||
Send(ch, flag, s1);
|
||||
until Length(s) < Max;
|
||||
Send(ch, flag, s);
|
||||
V2S(True, retval);
|
||||
Exit;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Trim(msg) = '' then
|
||||
begin
|
||||
V2S(False, retval);
|
||||
if closeChatOnSend then
|
||||
UI.Chat.Hide
|
||||
end else
|
||||
Send(ch, flag, msg);
|
||||
V2S(True, retval);
|
||||
end;
|
||||
end;
|
||||
1:
|
||||
begin
|
||||
Inc(argv);
|
||||
S2V(argv, UINs);
|
||||
for I := VarArrayLowBound(UINs, 1) to VarArrayHighBound(UINs, 1) do
|
||||
OutboxAdd(OE_msg, Account.AccProto.GetContact(TUID(UINs[I])), IF_multiple, msg);
|
||||
|
||||
V2S(True, retval);
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
with UI.Chat do
|
||||
for i := 0 to chats.count - 1 do
|
||||
if chats.byIdx(i).chatType = CT_IM then
|
||||
OutboxAdd(OE_msg, chats.byIdx(i).who, IF_multiple, msg);
|
||||
|
||||
V2S(True, retval);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure EditChatMessage(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Chat: TUID;
|
||||
ID, Text: String;
|
||||
MsgID: TMsgID;
|
||||
begin
|
||||
Chat := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
ID := SciterVarToString(argv);
|
||||
if not TryStrToUInt64(ID, MsgID) then
|
||||
Exit;
|
||||
Inc(argv);
|
||||
Text := SciterVarToString(argv);
|
||||
|
||||
Account.AccProto.SendMsg(Account.AccProto.GetContact(Chat), EK_Msg, 0, '', Text, MsgID);
|
||||
end;
|
||||
|
||||
procedure GetChatMessageText(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Chat: TUID;
|
||||
ID: String;
|
||||
MsgID: TMsgID;
|
||||
Event: Thevent;
|
||||
begin
|
||||
Chat := SciterVarToString(argv);
|
||||
Inc(argv);
|
||||
ID := SciterVarToString(argv);
|
||||
if not TryStrToUInt64(ID, MsgID) then
|
||||
Exit;
|
||||
|
||||
Event := SQLDB.GetByMsgID(Chat, MsgID, False);
|
||||
if Event = nil then
|
||||
Exit;
|
||||
|
||||
V2S(Event.textData, retval);
|
||||
end;
|
||||
|
||||
procedure ClosePages(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
opt, i: Integer;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
opt := -1;
|
||||
API.ValueIntData(argv, opt);
|
||||
|
||||
with UI.Chat do
|
||||
case opt of
|
||||
0:
|
||||
begin
|
||||
SawAllHere;
|
||||
CloseThisPage;
|
||||
end;
|
||||
1: CloseAllPages;
|
||||
2:
|
||||
begin
|
||||
for i := chats.Count - 1 downto 0 do
|
||||
if not (chats.byIdx(i).who.equals(UI.Chat.CurrentContact)) then
|
||||
ClosePageAt(i);
|
||||
end;
|
||||
3:
|
||||
try
|
||||
for i := chats.count - 1 downto 0 do
|
||||
if chats.byIdx(i).chatType = CT_IM then
|
||||
if chats.byIdx(i).who.isOffline then
|
||||
ClosePageAt(i);
|
||||
except end;
|
||||
4:
|
||||
begin
|
||||
SawAllHere;
|
||||
addToIgnoreList(UI.Chat.CurrentContact);
|
||||
if MessageDlg(GetTranslation('Do you want to remove %s from your contact list?', [UI.Chat.CurrentContact.displayed]), mtConfirmation,
|
||||
[mbYes, mbNo]) = mrYes then
|
||||
removeFromRoster(UI.Chat.CurrentContact);
|
||||
CloseThisPage;
|
||||
end;
|
||||
5:
|
||||
begin
|
||||
if MessageDlg(GetTranslation('Are you sure you want to ignore multiple contacts?'), mtConfirmation, [mbYes, mbNo]) <> mrYes then
|
||||
Exit;
|
||||
for i := chats.count - 1 downto 0 do
|
||||
if chats.byIdx(i).chatType = CT_IM then
|
||||
if notInList.exists(chats.byIdx(i).who) then
|
||||
begin
|
||||
addToIgnoreList(chats.byIdx(i).who);
|
||||
removeFromRoster(chats.byIdx(i).who);
|
||||
ClosePageAt(i);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure UploadFile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
opt: Integer;
|
||||
url: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
API.ValueIntData(argv, opt);
|
||||
url := UI.Chat.FileUpload(opt = 2);
|
||||
V2S(url, retval);
|
||||
end;
|
||||
|
||||
procedure SaveEmbeddedFile(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Pic: TMemoryStream;
|
||||
StrUrl: String;
|
||||
Hash: LongWord;
|
||||
Img: TBytes;
|
||||
Fmt: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
StrUrl := SciterVarToString(argv);
|
||||
if TryStrToLongWord(Copy(StrUrl, 10, Length(StrUrl)), Hash) and Assigned(EmbeddedImgs) and EmbeddedImgs.TryGetValue(Hash, Img) then
|
||||
begin
|
||||
Pic := TMemoryStream.Create;
|
||||
Pic.Write(Img, Length(Img));
|
||||
Fmt := PAFormat[DetectFileFormatStream(Pic)];
|
||||
Delete(Fmt, 1, 1);
|
||||
Fmt := OpenSaveDlg(nil, '', False, Fmt);
|
||||
if Fmt > '' then
|
||||
Pic.SaveToFile(Fmt);
|
||||
Pic.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ChatButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
ID: String;
|
||||
right: Boolean;
|
||||
r, x, y, PicMaxSize: Integer;
|
||||
page, fn, sU: String;
|
||||
s: RawByteString;
|
||||
fs: TFileStream;
|
||||
isRnQPic: Boolean;
|
||||
ev: THevent;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
ID := SciterVarToString(argv);
|
||||
r := 0;
|
||||
if argc > 1 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, r);
|
||||
end;
|
||||
right := r = 1;
|
||||
x := 0;
|
||||
if argc > 2 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, x);
|
||||
end;
|
||||
y := 0;
|
||||
if argc > 3 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, y);
|
||||
end;
|
||||
|
||||
with UI.Chat do
|
||||
if ID = 'prefBtn' then
|
||||
begin
|
||||
if right then
|
||||
Page := 'Plugins'
|
||||
else
|
||||
Page := 'Chat';
|
||||
showForm(WF_SHEET, Page, vmShort)
|
||||
end else if ID = 'infoBtn' then
|
||||
CurrentContact.ViewInfo
|
||||
else if ID = 'quoteBtn' then
|
||||
begin
|
||||
if right then
|
||||
Quote(clipboard.asText, x = 1)
|
||||
else
|
||||
Quote
|
||||
end else if ID = 'singleBtn' then
|
||||
UI.Chat.chats.byContact(CurrentContact).single := right
|
||||
else if ID = 'picsBtn' then
|
||||
begin
|
||||
if not OnlFeature(Account.AccProto) then Exit;
|
||||
|
||||
if OpenSaveFileDialog(Application.Handle, '*', getSupPicExts, //+ ';'#0 + 'R&Q Pics Files (wbmp)|*.wbmp'
|
||||
'', 'Select R&Q Pic File', fn, True) then
|
||||
begin
|
||||
if not FileExists(fn) then
|
||||
begin
|
||||
MsgDlg('File doesn''t exist', true, mtError);
|
||||
Exit;
|
||||
end;
|
||||
if not isSupportedPicFile(fn) then
|
||||
begin
|
||||
MsgDlg('This picture format is not supported', True, mtError);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
PicMaxSize := Round(Account.AccProto.MaxCharsFor(CurrentContact, True) * 3 / 4 ) - 100;
|
||||
|
||||
fs := TFileStream.Create(fn, fmOpenRead or fmShareDenyNone);
|
||||
sU := ExtractFileExt(fn);
|
||||
isRnQPic := (sU = '.wbmp') or (sU = '.wbm');
|
||||
|
||||
if (not isRnQPic and (fs.Size > PicMaxSize)) or (fs.Size < 4) then
|
||||
begin
|
||||
MsgDlg('Max ' + IntToStr(PicMaxSize) + ' bytes', true, mtError);
|
||||
MsgDlg('This file is too big', true, mtError);
|
||||
fs.Free;
|
||||
Exit;
|
||||
end;
|
||||
if (isRnQPic and (fs.Size > 0)) or (fs.Size < 4) then
|
||||
begin
|
||||
// Unsupported for now!
|
||||
MsgDlg('This picture format is not supported', True, mtError);
|
||||
fs.Free;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SetLength(s, fs.Size);
|
||||
if fs.Size > 1 then
|
||||
fs.Read(s[1], Length(s))
|
||||
else
|
||||
s := '';
|
||||
fs.Free;
|
||||
OutboxAdd(OE_msg, CurrentContact, IF_Bin, RnQImageExTag + Base64EncodeString(s) + RnQImageExUnTag);
|
||||
s := '';
|
||||
end;
|
||||
end else if ID = 'fileBtn' then
|
||||
begin
|
||||
if right then
|
||||
showForm(WF_SHEET, 'Other', vmShort)
|
||||
end else if ID = 'buzzBtn' then
|
||||
begin
|
||||
if not OnlFeature(Account.AccProto) then Exit;
|
||||
|
||||
if Account.AccProto.SendBuzz(CurrentContact) then
|
||||
begin
|
||||
ev := THevent.new(EK_buzz, nil, Account.AccProto.getMyInfo, Now, '', [], 0);
|
||||
ev.outgoing := True;
|
||||
UI.Chat.AddEvent(CurrentContact, ev);
|
||||
end else
|
||||
MsgDlg('Wait at least 15 seconds before buzzing again', True, mtBuzz)
|
||||
|
||||
// Test SMS sending
|
||||
|
||||
// senderName := Account.AccProto.getMyInfo.fDisplay;
|
||||
// if Trim(senderName) = '' then
|
||||
// senderName := Account.AccProto.getMyInfo.nick;
|
||||
// if Trim(senderName) = '' then
|
||||
// senderName := Account.AccProto.getMyInfo.first;
|
||||
//'(' + senderName + ', ICQ) ' +
|
||||
// TICQSession(Account.AccProto.ProtoElem).sendSMS2('+79020000000', grabThisText, True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PluginButtonClick(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
title: String;
|
||||
id, mbtn: Integer;
|
||||
pr: procedure(Button: integer);
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
id := 0;
|
||||
API.ValueIntData(argv, id);
|
||||
mbtn := 0;
|
||||
Inc(argv);
|
||||
title := SciterVarToString(argv);
|
||||
if argc > 2 then
|
||||
begin
|
||||
Inc(argv);
|
||||
API.ValueIntData(argv, mbtn);
|
||||
if mbtn = 1 then mbtn := 0
|
||||
else if mbtn = 2 then mbtn := 1
|
||||
else if mbtn = 4 then mbtn := 2;
|
||||
end;
|
||||
if (id > 0) then
|
||||
try
|
||||
pr := Pointer(id);
|
||||
pr(mbtn);
|
||||
except
|
||||
MsgDlg(GetTranslation('Error at plugin "%s"', [title]), False, mtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ToggleTranslit(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
with UI.Chat do
|
||||
if Assigned(TranslitList) and (TranslitList.Count > 0) and Assigned(CurrentContact) then
|
||||
begin
|
||||
CurrentContact.SendTransl := not CurrentContact.SendTransl;
|
||||
UpdateStatusBar;
|
||||
UpdateViewInfo(CurrentContact);
|
||||
end;
|
||||
end;
|
||||
|
||||
//procedure QIPPwd(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
//var
|
||||
// opt: Integer;
|
||||
// pwd: String;
|
||||
//begin
|
||||
// if argc = 0 then
|
||||
// Exit;
|
||||
//
|
||||
// opt := 0;
|
||||
// API.ValueIntData(argv, opt);
|
||||
//
|
||||
// with UI.Chat do
|
||||
// begin
|
||||
// if (CurrentContact = nil) or not (CurrentContact is TICQContact) then
|
||||
// Exit;
|
||||
//
|
||||
// if opt = 1 then
|
||||
// begin
|
||||
// pwd := UI.EnterPassword(GetTranslation('Enter password for %s', [CurrentContact.displayed]), 32);
|
||||
// if not (pwd = '') then
|
||||
// TICQContact(CurrentContact).crypt.qippwd := qip_str2pass(pwd);
|
||||
// end else if opt = 2 then
|
||||
// TICQContact(CurrentContact).crypt.qippwd := 0;
|
||||
// UI.Chat.UpdateContactStatus(CurrentContact);
|
||||
// end;
|
||||
//end;
|
||||
|
||||
procedure SendStickerToCurrent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
ext, sticker: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
sticker := SciterVarToString(argv);
|
||||
|
||||
with UI.Chat do
|
||||
if OnlFeature(Account.AccProto) then
|
||||
begin
|
||||
UI.Chat.SawAllHere;
|
||||
OutboxAdd(OE_msg, CurrentContact, 0, GET_FILES_HOST + sticker);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetStoreStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
Account.AccProto.GetStoreStickerPacks;
|
||||
end;
|
||||
|
||||
procedure GetStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
StickerPacks: TStickerPacks;
|
||||
StickerPacksVar: TParams;
|
||||
I: Integer;
|
||||
begin
|
||||
StickerPacks := SQLDB.GetStickerPacks;
|
||||
SetLength(StickerPacksVar, Length(StickerPacks));
|
||||
for I := 0 to Length(StickerPacks) - 1 do
|
||||
begin
|
||||
if (Length(StickerPacks[I].Content) = 0) and (StickerPacks[I].ListIconLink = '') then
|
||||
StickerPacks[I].ListIconLink := 'listicon:n' + IntToStr(StickerPacks[I].Id);
|
||||
StickerPacksVar[I] := UI.RecordToVar(StickerPacks[I]);
|
||||
end;
|
||||
V2S(StickerPacksVar, retval);
|
||||
SetLength(StickerPacks, 0);
|
||||
end;
|
||||
|
||||
procedure SearchStickerPacks(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Qry: String;
|
||||
begin
|
||||
if argc = 0 then
|
||||
Exit;
|
||||
|
||||
Qry := Trim(SciterVarToString(argv));
|
||||
if Qry = '' then
|
||||
Exit;
|
||||
|
||||
if Qry.StartsWith('storeid:') then
|
||||
Account.AccProto.SearchStoreStickerPack(Qry.Replace('storeid:', ''))
|
||||
else
|
||||
Account.AccProto.SearchStoreStickerPacks(Qry);
|
||||
end;
|
||||
|
||||
procedure BuyStickerPack(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if argc > 0 then
|
||||
Account.AccProto.BuyStickerPack(SciterVarToString(argv));
|
||||
end;
|
||||
|
||||
procedure RemoveStickerPack(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if argc > 0 then
|
||||
Account.AccProto.RemoveStickerPack(SciterVarToString(argv));
|
||||
end;
|
||||
|
||||
procedure GetStickerPackContent(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
Content: TArray |
||||
begin
|
||||
if argc > 0 then
|
||||
try
|
||||
Content := Stickers.GetStickerPackContent(SciterVarToString(argv));
|
||||
V2S(Content, retval);
|
||||
finally
|
||||
SetLength(Content, 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetSpellingSuggestions(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
begin
|
||||
if EnableSpellCheck and (argc > 0) then
|
||||
V2S(GetSuggestions(SciterVarToString(argv)), retval);
|
||||
end;
|
||||
|
||||
procedure TChatBox.Show;
|
||||
begin
|
||||
Call('show');
|
||||
end;
|
||||
|
||||
procedure TChatBox.Hide;
|
||||
begin
|
||||
Call('hide');
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateCaption(const Caption: String);
|
||||
begin
|
||||
Call('updateCaption', [Caption]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.InitPage(cnt: TICQContact);
|
||||
var
|
||||
UIDBG, GrpBG: TPicName;
|
||||
IsUseCntThemes: Boolean;
|
||||
Settings: TPageSettings;
|
||||
begin
|
||||
IsUseCntThemes := UseContactThemes and Assigned(ContactsTheme) and Assigned(cnt);
|
||||
if IsUseCntThemes then
|
||||
begin
|
||||
UIDBG := TPicName(AnsiLowerCase(cnt.UID)) + '.' + PIC_CHAT_BG;
|
||||
GrpBG := TPicName('group.') + TPicName(AnsiLowerCase(groups.id2name(cnt.group))) + '.' + PIC_CHAT_BG;
|
||||
end;
|
||||
|
||||
Settings.splitX := SplitX;
|
||||
Settings.splitY := SplitY;
|
||||
|
||||
// Tiled background image
|
||||
Settings.tiled := '';
|
||||
if IsUseCntThemes and (ContactsTheme.GetPicSize(RQteDefault, UIDBG + '5').cx > 0) then
|
||||
Settings.tiled := 'contactpic:' + UIDBG + '5'
|
||||
else if IsUseCntThemes and (ContactsTheme.GetPicSize(RQteDefault, GrpBG + '5').cx > 0) then
|
||||
Settings.tiled := 'contactpic:' + GrpBG + '5'
|
||||
else if theme.GetPicSize(RQteDefault, PIC_CHAT_BG + '5').cx > 0 then
|
||||
Settings.tiled := 'themepic:' + PIC_CHAT_BG + '5';
|
||||
|
||||
// Positioned background image
|
||||
Settings.positioned := '';
|
||||
if IsUseCntThemes then
|
||||
if ContactsTheme.GetPicSize(RQteDefault, UIDBG + '1').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + UIDBG + '1'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, UIDBG + '2').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + UIDBG + '2'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, UIDBG + '3').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + UIDBG + '3'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, UIDBG + '4').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + UIDBG + '4';
|
||||
|
||||
if IsUseCntThemes and (Settings.positioned = '') then
|
||||
if ContactsTheme.GetPicSize(RQteDefault, GrpBG + '1').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + GrpBG + '1'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, GrpBG + '2').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + GrpBG + '2'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, GrpBG + '3').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + GrpBG + '3'
|
||||
else if ContactsTheme.GetPicSize(RQteDefault, GrpBG + '4').cx > 0 then
|
||||
Settings.positioned := 'contactpic:' + GrpBG + '4';
|
||||
|
||||
if Settings.positioned = '' then
|
||||
if theme.GetPicSize(RQteDefault, PIC_CHAT_BG + '1').cx > 0 then
|
||||
Settings.positioned := 'themepic:' + PIC_CHAT_BG + '1'
|
||||
else if theme.GetPicSize(RQteDefault, PIC_CHAT_BG + '2').cx > 0 then
|
||||
Settings.positioned := 'themepic:' + PIC_CHAT_BG + '2'
|
||||
else if theme.GetPicSize(RQteDefault, PIC_CHAT_BG + '3').cx > 0 then
|
||||
Settings.positioned := 'themepic:' + PIC_CHAT_BG + '3'
|
||||
else if theme.GetPicSize(RQteDefault, PIC_CHAT_BG + '4').cx > 0 then
|
||||
Settings.positioned := 'themepic:' + PIC_CHAT_BG + '4';
|
||||
|
||||
try
|
||||
PageCall(cnt.UID, 'init', [UI.RecordToVar(Settings)]);
|
||||
except
|
||||
on e: ESciterCallException do
|
||||
MsgDlg('Error in init: ' + e.Message, False, mtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.OpenPage(cnt: TICQContact; focused: Boolean = False);
|
||||
begin
|
||||
if not Assigned(cnt) then
|
||||
Exit;
|
||||
|
||||
if not histories.ContainsKey(cnt.UID) then
|
||||
histories.Add(cnt.UID, Thistory.Create(cnt.UID));
|
||||
|
||||
if Preview then
|
||||
InitMsgPreview;
|
||||
Call('openChatPage', [cnt.UID, cnt.displayed, focused]);
|
||||
InitPage(cnt);
|
||||
end;
|
||||
|
||||
procedure TChatBox.OpenPage(ID: Integer; const Caption: String);
|
||||
begin
|
||||
Call('openPluginPage', [ID, Caption]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClosePage(uid: TUID = '');
|
||||
var
|
||||
h: Thistory;
|
||||
el: HELEMENT;
|
||||
begin
|
||||
el := GetPage(uid);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
begin
|
||||
if uid = '' then
|
||||
uid := UI.CallOnElement(el, 'getChatId', [], True);
|
||||
|
||||
if histories.TryGetValue(uid, h) then
|
||||
histories.Remove(uid);
|
||||
|
||||
UI.CallOnElement(el, 'close', [], True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClosePage(id: Integer);
|
||||
begin
|
||||
PageCall(id, 'close', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SwitchToPage(const uid: TUID);
|
||||
begin
|
||||
PageFire(uid, $106, Null);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SwitchToPage(id: Integer);
|
||||
begin
|
||||
PageFire(id, $106, Null);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SwitchToNextPage;
|
||||
begin
|
||||
Call('setCurrentPage', [1]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SwitchToPrevPage;
|
||||
begin
|
||||
Call('setCurrentPage', [-1]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateSpelling(data: Variant);
|
||||
begin
|
||||
PageFire('', $107, data);
|
||||
end;
|
||||
|
||||
procedure TChatBox.RedrawTabs;
|
||||
var
|
||||
i: Integer;
|
||||
ch: TchatInfo;
|
||||
begin
|
||||
for i := 0 to chats.Count - 1 do
|
||||
begin
|
||||
ch := chats.byIdx(i);
|
||||
if Assigned(ch) and Assigned(ch.who) then
|
||||
RedrawTab(ch.who);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.RedrawTab(c: TICQContact);
|
||||
var
|
||||
ci: TchatInfo;
|
||||
ev: Thevent;
|
||||
tabPic, add: TPicName;
|
||||
png, pngadd: TPNGImage;
|
||||
hash, hashadd: LongWord;
|
||||
mem: TMemoryStream;
|
||||
begin
|
||||
ci := chats.byContact(c);
|
||||
if ci = nil then
|
||||
Exit;
|
||||
|
||||
tabPic := '';
|
||||
ev := eventQ.firstEventFor(c);
|
||||
if Assigned(ev) and not (ev.pic = '') then
|
||||
tabPic := ev.pic
|
||||
else if c.typing.bIsTyping then
|
||||
tabPic := PIC_TYPING
|
||||
else if showStatusOnTabs then
|
||||
tabPic := c.StatusImg
|
||||
else
|
||||
tabPic := '';
|
||||
|
||||
add := '';
|
||||
if TICQContact(c).Official then
|
||||
add := PIC_OFFICIAL
|
||||
else if TICQContact(c).Bot then
|
||||
add := PIC_BOT;
|
||||
|
||||
hash := 0;
|
||||
hashadd := 0;
|
||||
if not (tabPic = '') then
|
||||
begin
|
||||
// Main icon
|
||||
if theme.Pic2PNG(tabPic, png) then
|
||||
if Assigned(png) then
|
||||
begin
|
||||
mem := TMemoryStream.Create;
|
||||
try
|
||||
png.SaveToStream(mem);
|
||||
hash := CalcMurmur2(mem);
|
||||
finally
|
||||
FreeAndNil(mem);
|
||||
end;
|
||||
end;
|
||||
|
||||
if not (hash = 0) then
|
||||
if TabsIconCache.ContainsKey(hash) then
|
||||
FreeAndNil(png)
|
||||
else if Assigned(png) then
|
||||
TabsIconCache.AddOrSetValue(hash, png);
|
||||
|
||||
// Additional icon in the bottom right corner
|
||||
if not (add = '') then
|
||||
begin
|
||||
if theme.Pic2PNG(add, pngadd) then
|
||||
if Assigned(pngadd) then
|
||||
begin
|
||||
mem := TMemoryStream.Create;
|
||||
try
|
||||
pngadd.SaveToStream(mem);
|
||||
hashadd := CalcMurmur2(mem);
|
||||
finally
|
||||
FreeAndNil(mem);
|
||||
end;
|
||||
end;
|
||||
|
||||
if not (hashadd = 0) then
|
||||
if TabsIconCache.ContainsKey(hashadd) then
|
||||
FreeAndNil(pngadd)
|
||||
else if Assigned(pngadd) then
|
||||
TabsIconCache.AddOrSetValue(hashadd, pngadd);
|
||||
end;
|
||||
end;
|
||||
RedrawTab(c, hash, hashadd);
|
||||
end;
|
||||
|
||||
procedure TChatBox.RedrawPluginTab(ci: TchatInfo);
|
||||
var
|
||||
tabPic: TPicName;
|
||||
png: TPNGImage;
|
||||
hash: LongWord;
|
||||
mem: TMemoryStream;
|
||||
begin
|
||||
if ci = nil then
|
||||
Exit;
|
||||
|
||||
hash := 0;
|
||||
tabPic := 'plugintab' + IntToStr(ci.ID);
|
||||
if theme.Pic2PNG(tabPic, png) then
|
||||
if Assigned(png) then
|
||||
begin
|
||||
mem := TMemoryStream.Create;
|
||||
try
|
||||
png.SaveToStream(mem);
|
||||
hash := CalcMurmur2(mem);
|
||||
finally
|
||||
FreeAndNil(mem);
|
||||
end;
|
||||
end;
|
||||
|
||||
if not (hash = 0) then
|
||||
if TabsIconCache.ContainsKey(hash) then
|
||||
FreeAndNil(png)
|
||||
else if Assigned(png) then
|
||||
TabsIconCache.AddOrSetValue(hash, png);
|
||||
|
||||
RedrawTab(ci.ID, ci.lastInputText, hash);
|
||||
end;
|
||||
|
||||
procedure TChatBox.RedrawTab(c: TICQContact; hash, hashadd: LongWord);
|
||||
begin
|
||||
//OutputDebugString(PChar('redraw chat tab: ' + inttostr(hash) + ' | ' + c.displayed));
|
||||
PageCall(c.UID, 'redrawTab', [c.displayed, hash, hashadd]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.RedrawTab(id: Integer; const caption: String; hash: LongWord);
|
||||
begin
|
||||
//OutputDebugString(PChar('redraw plugin tab: ' + inttostr(hash) + ' | ' + caption));
|
||||
PageCall(id, 'redrawTab', [caption, hash]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClearEvents(const UID: TUID = '');
|
||||
begin
|
||||
PageCall(UID, 'clearEvents', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.DeleteEvent(const UID: TUID; MsgID: TMsgID);
|
||||
begin
|
||||
PageCall(UID, 'deleteEvent', [UIntToStr(MsgID)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.DeleteEvents(const UID: TUID; st, en: TDateTime);
|
||||
var
|
||||
ffs: TFormatSettings;
|
||||
begin
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
PageCall(UID, 'deleteEvents', [FloatToStr(st, ffs), FloatToStr(en, ffs)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.InitSettings;
|
||||
var
|
||||
Settings: TChatSettings;
|
||||
begin
|
||||
Settings.showSmiles := useSmiles;
|
||||
Settings.showAvatar := avatarShowInChat;
|
||||
Settings.showSmileCaption := ShowSmileCaption;
|
||||
Settings.showHintsInChat := ShowHintsInChat;
|
||||
Settings.showSmartReplies := ShowSmartReplies;
|
||||
Settings.autoCopy := autocopyHist;
|
||||
Settings.wheelVelocity := wheelVelocity;
|
||||
Settings.imageQuality := ChatImageQuality;
|
||||
Settings.smoothFontRendering := ChatSmoothFontRendering;
|
||||
Settings.maxImgWidth := RDUtils.IfThen(LimitMaxChatImgWidth, MaxChatImgWidthVal);
|
||||
Settings.maxImgHeight := RDUtils.IfThen(LimitMaxChatImgHeight, MaxChatImgHeightVal);
|
||||
Settings.fontCodes := FontStyleCodes.Enabled;
|
||||
Settings.showRelTimes := RelativeTimeInChat;
|
||||
Settings.cachePath := UI.FilePathToURL(CacheDir);
|
||||
Settings.viewTextWrap := bViewTextWrap;
|
||||
Settings.animatedScroll := AnimatedScroll;
|
||||
Settings.sendOnEnter := sendOnEnter;
|
||||
Settings.quoteSelected := quoting.quoteselected;
|
||||
Settings.cursorBelow := quoting.cursorBelow;
|
||||
Settings.spellErrorStyle := spellErrorStyle;
|
||||
Settings.spellErrorColor := color2html(spellErrorColor);
|
||||
Settings.screenshotFormat := ScreenshotFormat;
|
||||
Settings.screenshotFilename := GetSnapshotFilename;
|
||||
Settings.chatCSS := ChatCSS;
|
||||
Settings.msgBuffer := ChatLoadBuffer;
|
||||
Settings.alwaysOnTop := ChatAlwaysOnTop;
|
||||
|
||||
try
|
||||
Call('initSettings', [UI.RecordToVar(Settings)]);
|
||||
except
|
||||
on e: ESciterCallException do
|
||||
MsgDlg('Error in InitSettings: ' + e.Message, False, mtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TChatBox.InitMsgPreview;
|
||||
begin
|
||||
try
|
||||
Call('initMsgPreview', [GetTranslation('Select message to render its full version here')]);
|
||||
except
|
||||
on e: ESciterCallException do
|
||||
MsgDlg('Error in InitSettingsMsgPreview: ' + e.Message, false, mtError);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatBox.GetPluginBounds: TRect;
|
||||
var
|
||||
bounds: Variant;
|
||||
begin
|
||||
bounds := Call('getPluginBounds', []);
|
||||
Result.Left := bounds[0];
|
||||
Result.Top := bounds[1];
|
||||
Result.Right := bounds[2];
|
||||
Result.Bottom := bounds[3];
|
||||
end;
|
||||
|
||||
procedure TChatBox.AddPluginButton(i: Integer);
|
||||
begin
|
||||
with UI.Chat.plugBtns do
|
||||
Call('addPluginButton', [NativeInt(btns[i].proc)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.DelPluginButton(i: Integer);
|
||||
begin
|
||||
with UI.Chat.plugBtns do
|
||||
Call('delPluginButton', [NativeInt(btns[i].proc)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ModifyPluginButton(i: Integer);
|
||||
begin
|
||||
with UI.Chat.plugBtns do
|
||||
Call('modifyPluginButton', [NativeInt(btns[i].proc), btns[i].hint, btns[i].pic]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetSendBtnImage(const pic: TPicName);
|
||||
var
|
||||
Sprite: TSprite;
|
||||
begin
|
||||
if pic = '' then
|
||||
Exit;
|
||||
|
||||
Sprite := MakeSprite(pic);
|
||||
Call('setSendBtnImage', [UI.RecordToVar(Sprite)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ClearAvatar(const uid: TUID);
|
||||
begin
|
||||
PageCall(uid, 'clearAvatar', [])
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateAvatar(const uid: TUID);
|
||||
begin
|
||||
PageCall(uid, 'updateAvatar', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupChatButtons;
|
||||
begin
|
||||
Call('setupChatButtons', [not Assigned(CurrentContact)]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupSingleBtn(status: Boolean);
|
||||
begin
|
||||
Call('setupSingleBtn', [status]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupFileBtn(status: Boolean);
|
||||
begin
|
||||
Call('setupFileBtn', [status]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupStickersBtn(status: Boolean);
|
||||
begin
|
||||
Call('setupStickersBtn', [status]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SetupBuzzBtn(status: Boolean);
|
||||
begin
|
||||
Call('setupBuzzBtn', [status]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ResetHistory;
|
||||
var
|
||||
i: Integer;
|
||||
elc: TArray |
||||
begin
|
||||
elc := SelectAll('#pages > .page');
|
||||
for i := 0 to Length(elc) - 1 do
|
||||
UI.CallOnElement(elc[i], 'resetHistory', [], True);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ApplyTheme;
|
||||
var
|
||||
i: Integer;
|
||||
elc: TArray |
||||
begin
|
||||
Call('applyTheme', []);
|
||||
elc := SelectAll('#pages > .page');
|
||||
for i := 0 to Length(elc) - 1 do
|
||||
InitPage(Account.AccProto.GetContact(TUID(UI.CallOnElement(elc[i], 'getChatId', [], True))));
|
||||
end;
|
||||
|
||||
procedure TChatBox.UpdateSmiles;
|
||||
begin
|
||||
Fire($101);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ReloadSmiles;
|
||||
|
||||
function GetOffset(num: Integer): TPoint;
|
||||
var
|
||||
row, column: Integer;
|
||||
begin
|
||||
column := num mod emojisInARow;
|
||||
row := floor(num / emojisInARow);
|
||||
Result.X := column * emojiSize;
|
||||
Result.Y := row * emojiSize;
|
||||
end;
|
||||
|
||||
function GetEmoji(num: Integer): String;
|
||||
var
|
||||
i: Integer;
|
||||
vals: TArray |
||||
keys: TArray |
||||
begin
|
||||
Result := '';
|
||||
vals := emojis.Values.ToArray;
|
||||
keys := emojis.Keys.ToArray;
|
||||
for i := 0 to Length(vals) - 1 do
|
||||
begin
|
||||
if vals[i] = num then
|
||||
begin
|
||||
Result := Char.ConvertFromUtf32(keys[i].Key);
|
||||
if not (keys[i].Value = 0) then
|
||||
Result := Result + Char.ConvertFromUtf32(keys[i].Value);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
i, j: Integer;
|
||||
arr: TArray |
||||
em: Variant;
|
||||
smiles, emoji, emojiNums: TParams;
|
||||
smileData: TPair |
||||
sm: String;
|
||||
p: TPoint;
|
||||
hasEmoji: Boolean;
|
||||
begin
|
||||
if not TryStrToInt(theme.GetString('emoji.size'), emojiSize) then
|
||||
emojiSize := 22;
|
||||
if not TryStrToInt(theme.GetString('emoji.inarow'), emojisInARow) then
|
||||
emojisInARow := 36;
|
||||
|
||||
SetLength(smiles, theme.SmilesCount);
|
||||
if theme.SmilesCount > 0 then
|
||||
for i := 0 to theme.SmilesCount - 1 do
|
||||
begin
|
||||
sm := theme.GetSmileObj(i).SmlStr.Strings[0];
|
||||
theme.smileArray.TryGetValue(sm, smileData);
|
||||
if (smileData.Value.Width > 0) and (smileData.Value.Height > 0) then
|
||||
begin
|
||||
smiles[i] := VarArrayCreate([0, 3], varVariant);
|
||||
smiles[i][0] := smileData.Key;
|
||||
smiles[i][1] := sm;
|
||||
smiles[i][2] := smileData.Value.Width;
|
||||
smiles[i][3] := smileData.Value.Height;
|
||||
end else
|
||||
smiles[i] := False;
|
||||
end;
|
||||
|
||||
hasEmoji := theme.HasOrigPic('emoji.sprite');
|
||||
SetLength(emoji, 8);
|
||||
SetLength(emojiNums, 8);
|
||||
|
||||
if hasEmoji then
|
||||
for i := 0 to 7 do
|
||||
begin
|
||||
emojiContents.TryGetValue(i, arr);
|
||||
emoji[i] := VarArrayCreate([0, Length(arr) - 1], varVariant);
|
||||
for j := 0 to Length(arr) - 1 do
|
||||
begin
|
||||
p := GetOffset(arr[j]);
|
||||
em := VarArrayCreate([0, 2], varVariant);
|
||||
em[0] := GetEmoji(arr[j]);
|
||||
em[1] := -p.X;
|
||||
em[2] := -p.Y;
|
||||
emoji[i][j] := em;
|
||||
end;
|
||||
p := GetOffset(emojiExtNumbers[i]);
|
||||
emojiNums[i] := VarArrayCreate([0, 2], varVariant);
|
||||
emojiNums[i][0] := emojiExtHints[i];
|
||||
emojiNums[i][1] := -p.X;
|
||||
emojiNums[i][2] := -p.Y;
|
||||
end;
|
||||
|
||||
Call('reloadSmiles', [smiles, hasEmoji, emojiSize, emoji, emojiNums]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.PreloadPickers;
|
||||
var
|
||||
LinkList: String;
|
||||
begin
|
||||
LinkList := GetCachedPickers;
|
||||
if not (LinkList = '') then
|
||||
Call('preloadImages', [LinkList]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.LoadStickers;
|
||||
var
|
||||
StickerPacks: TStickerPacks;
|
||||
StickerPacksVar: TParams;
|
||||
I: Integer;
|
||||
begin
|
||||
StickerPacks := SQLDB.GetStickerPacks(True);
|
||||
SetLength(StickerPacksVar, Length(StickerPacks));
|
||||
for I := 0 to Length(StickerPacks) - 1 do
|
||||
StickerPacksVar[I] := UI.RecordToVar(StickerPacks[I]);
|
||||
Call('loadStickers', [StickerPacksVar]);
|
||||
SetLength(StickerPacks, 0);
|
||||
end;
|
||||
|
||||
procedure TChatBox.LoadSearchResults;
|
||||
var
|
||||
StickerPacksVar: TParams;
|
||||
I: Integer;
|
||||
begin
|
||||
with Account.AccProto do
|
||||
begin
|
||||
SetLength(StickerPacksVar, Length(LastSearchPacks));
|
||||
for I := 0 to Length(LastSearchPacks) - 1 do
|
||||
StickerPacksVar[I] := UI.RecordToVar(LastSearchPacks[I]);
|
||||
end;
|
||||
Call('updateSearchResults', [StickerPacksVar]);
|
||||
SetLength(Account.AccProto.LastSearchPacks, 0);
|
||||
end;
|
||||
|
||||
function GetHeaderTime(Time: TDateTime; Preview: Boolean = False): String;
|
||||
var
|
||||
Days, Hours, TMinutes, Minutes: Int64;
|
||||
begin
|
||||
if not Preview and RelativeTimeInChat then
|
||||
begin
|
||||
TMinutes := MinutesBetween(Now, Time);
|
||||
if TMinutes < 1 then
|
||||
Exit(GetTranslation('Just now'));
|
||||
Days := TMinutes div 60 div 24;
|
||||
Minutes := TMinutes - Days * 24 * 60;
|
||||
Hours := Minutes div 60;
|
||||
Minutes := Minutes mod 60;
|
||||
if Days > RelativeTimeInChatDays then // Absolute date/time
|
||||
Result := FormatDateTime(timeformat.chat, Time)
|
||||
else if IsSameDay(Time, Yesterday) then // Yesterday, absolute time
|
||||
Result := Format(GetTranslation('Yesterday at') + ' %.2d:%.2d', [HourOfTheDay(Time), MinuteOfTheHour(Time)])
|
||||
else if IsToday(Time) then // Today
|
||||
begin
|
||||
if Hours >= RelativeTimeInChatHours then // Absolute time
|
||||
Result := Format(GetTranslation('Today at') + ' %.2d:%.2d', [HourOfTheDay(Time), MinuteOfTheHour(Time)])
|
||||
else if Hours > 0 then // Relative time
|
||||
Result := Format('%d ' + GetHoursWord(Hours) + ' %d ' + GetMinutesWord(Minutes, True) + ' ' + GetTranslation('ago'), [Hours, Minutes])
|
||||
else // Relative minutes
|
||||
Result := Format('%d ' + GetMinutesWord(Minutes, True) + ' ' + GetTranslation('ago'), [Minutes]);
|
||||
end else // Relative days, absolute time
|
||||
Result := Format('%d ' + GetDaysWord(Days) + ' ' + GetTranslation('ago at') + ' %.2d:%.2d', [Days, HourOfTheDay(Time), MinuteOfTheHour(Time)])
|
||||
end else
|
||||
Result := FormatDateTime(timeformat.chat, Time);
|
||||
end;
|
||||
|
||||
procedure GetEventHeaderTime(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
|
||||
var
|
||||
When: Double;
|
||||
Val: Variant;
|
||||
begin
|
||||
API.ValueFloatData(argv, When);
|
||||
Val := GetHeaderTime(When);
|
||||
V2S(Val, retval);
|
||||
end;
|
||||
|
||||
procedure TChatBox.AddChatItem(var Params: TParams; var MsgData: TMessageData; Evt: Thevent; Animate: Boolean);
|
||||
var
|
||||
msgText, msgCls, prefixCls: String;
|
||||
statusImg1Rect, statusImg2Rect: TGPRect;
|
||||
statusImg1PicName, statusImg2PicName: TPicName;
|
||||
hdr: THeader;
|
||||
st: Integer;
|
||||
b: Byte;
|
||||
sA: TBytes;
|
||||
inv: Boolean;
|
||||
imgList: TArray |
||||
bodyImages: TArray |
||||
bodyBin: TBytes;
|
||||
i: Integer;
|
||||
hash: LongWord;
|
||||
ffs: TFormatSettings;
|
||||
ExtSticker: TArray |
||||
Patch: TPatch;
|
||||
Patches: TArray |
||||
Deleted, Updated: Boolean;
|
||||
Actions: TArray |
||||
begin
|
||||
if Evt = nil then
|
||||
Exit;
|
||||
|
||||
IsLastParsedEventMine := Evt.outgoing;
|
||||
hdr := Evt.GetHeaderTexts;
|
||||
msgText := Evt.GetBodyText;
|
||||
if TrimMsgNewLines then
|
||||
msgText := msgText.Trim([#13, #10]);
|
||||
|
||||
msgCls := 'msgFull';
|
||||
if Animate then
|
||||
msgCls := msgCls + ' hidden';
|
||||
if IsLastParsedEventMine then
|
||||
msgCls := msgCls + ' my';
|
||||
MsgData.cls := msgCls;
|
||||
|
||||
ffs := TFormatSettings.Create(LOCALE_USER_DEFAULT);
|
||||
ffs.DecimalSeparator := '.';
|
||||
MsgData.time := FloatToStr(Evt.when, ffs);
|
||||
MsgData.msgid := UIntToStr(Evt.ID);
|
||||
MsgData.eventImg := Evt.pic;
|
||||
MsgData.encrypted := IF_Encrypt and Evt.flags > 0;
|
||||
MsgData.what := hdr.what;
|
||||
|
||||
case Evt.kind of
|
||||
EK_INCOMING, EK_STATUSCHANGE:
|
||||
begin
|
||||
sA := Evt.GetBodyBin;
|
||||
if length(sA) >= 4 then
|
||||
begin
|
||||
st := str2int(sA);
|
||||
if st in [Byte(Low(Account.AccProto.statuses)) .. Byte(High(Account.AccProto.statuses))] then
|
||||
begin
|
||||
b := binToXStatus(sA);
|
||||
if (st <> Byte(SC_ONLINE)) or (b = 0) then
|
||||
begin
|
||||
inv := (length(sA) > 4) and boolean(sA[4]);
|
||||
statusImg1PicName := status2imgName(st, inv);
|
||||
end;
|
||||
|
||||
if (b > 0) then
|
||||
statusImg2PicName := XStatusArray[b].Status;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
EK_XstatusMsg:
|
||||
begin
|
||||
sA := Evt.GetBodyBin;
|
||||
if length(sA) >= 1 then
|
||||
if (Byte(sA[0]) <= High(XStatusArray)) then
|
||||
statusImg1PicName := XStatusArray[Byte(sA[0])].Status;
|
||||
end;
|
||||
EK_OUTGOING:
|
||||
begin
|
||||
statusImg1PicName := status2imgName(Byte(SC_OFFLINE), False);
|
||||
end;
|
||||
end;
|
||||
|
||||
MsgData.statusImg := statusImg1PicName;
|
||||
MsgData.statusImgExt := statusImg2PicName;
|
||||
MsgData.when := GetHeaderTime(Evt.when, Preview);
|
||||
MsgData.prefix := hdr.prefix;
|
||||
|
||||
SetLength(imgList, 0);
|
||||
bodyBin := Evt.GetBodyBin;
|
||||
if (Evt.kind = EK_msg) then
|
||||
begin
|
||||
if Length(bodyBin) > 4 then
|
||||
begin
|
||||
getMsgImages(bodyBin, imgList);
|
||||
if Assigned(embeddedImgs) and (Length(imgList) > 0) then
|
||||
for i := 0 to Length(imgList) - 1 do
|
||||
begin
|
||||
SetLength(bodyImages, Length(bodyImages) + 1);
|
||||
hash := CalcMurmur2(imgList[i]);
|
||||
if not embeddedImgs.ContainsKey(hash) then
|
||||
embeddedImgs.Add(hash, imgList[i]);
|
||||
bodyImages[High(bodyImages)] := IntToStr(hash);
|
||||
end;
|
||||
SetLength(imgList, 0);
|
||||
// end else if Evt.flags and IF_sticker > 0 then
|
||||
// begin
|
||||
// ExtSticker := SplitString(msgText, ':');
|
||||
// if (Length(ExtSticker) >= 4) then
|
||||
// begin
|
||||
// sA := GetSticker(ExtSticker[1], ExtSticker[3]);
|
||||
// SetLength(bodyImages, Length(bodyImages) + 1);
|
||||
// hash := CalcMurmur2(sA);
|
||||
// if not embeddedImgs.ContainsKey(hash) then
|
||||
// embeddedImgs.Add(hash, sA);
|
||||
// bodyImages[High(bodyImages)] := IntToStr(hash);
|
||||
// msgText := '';
|
||||
// end;
|
||||
end;
|
||||
end;
|
||||
|
||||
MsgData.msg := ParseMessageBody(msgText);
|
||||
if Length(bodyImages) > 0 then
|
||||
begin
|
||||
MsgData.cls := MsgData.cls + ' binary';
|
||||
MsgData.embedded := ' |
||||
for i := 0 to Length(bodyImages) - 1 do
|
||||
MsgData.embedded := MsgData.embedded + '';
|
||||
MsgData.embedded := MsgData.embedded + '';
|
||||
end;
|
||||
MsgData.writeHist := logpref.writehistory and (BE_save in behaviour[Evt.kind].trig);
|
||||
|
||||
prefixCls := 'msgMulti';
|
||||
if Evt.flags and IF_Patched > 0 then
|
||||
begin
|
||||
Updated := False;
|
||||
Deleted := False;
|
||||
Patches := SQLDB.GetPatches(Evt.ID);
|
||||
SetLength(MsgData.patches, Length(Patches));
|
||||
for I := Low(Patches) to High(Patches) do
|
||||
begin
|
||||
MsgData.patches[I] := VarArrayCreate([0, 1], varVariant);
|
||||
MsgData.patches[I][0] := Patches[I].PatchType;
|
||||
MsgData.patches[I][1] := Patches[I].PatchedText;
|
||||
if (Patches[I].PatchType = 'delete') or (Patches[I].PatchType = 'modify') then
|
||||
Deleted := True
|
||||
else
|
||||
Updated := True;
|
||||
end;
|
||||
|
||||
SetLength(Actions, 0);
|
||||
|
||||
if Updated then
|
||||
begin
|
||||
SetLength(Actions, Length(Actions) + 1);
|
||||
Actions[High(Actions)] := GetTranslation('modified');
|
||||
end;
|
||||
|
||||
if Deleted then
|
||||
begin
|
||||
SetLength(Actions, Length(Actions) + 1);
|
||||
Actions[High(Actions)] := GetTranslation('deleted');
|
||||
end;
|
||||
|
||||
if Length(Actions) > 0 then
|
||||
begin
|
||||
MsgData.prefix := Trim(MsgData.prefix + ' (' + String.Join(', ', Actions) + ')');
|
||||
prefixCls := prefixCls + ' updated';
|
||||
end;
|
||||
end;
|
||||
MsgData.prefixCls := prefixCls;
|
||||
|
||||
SetLength(Params, Length(Params) + 1);
|
||||
Params[High(Params)] := UI.RecordToVar(MsgData);
|
||||
end;
|
||||
|
||||
function TChatBox.GetPage(const UID: TUID): HELEMENT;
|
||||
var
|
||||
i: Integer;
|
||||
elc: TArray |
||||
begin
|
||||
Result := nil;
|
||||
if not (UID = '') then
|
||||
begin
|
||||
elc := SelectAll('#pages > .page');
|
||||
for i := 0 to Length(elc) - 1 do
|
||||
if UI.CallOnElement(elc[i], 'getChatId', [], True) = UID then
|
||||
begin
|
||||
Result := elc[i];
|
||||
Break;
|
||||
end;
|
||||
end else
|
||||
Result := Select('#pages > .page:current');
|
||||
end;
|
||||
|
||||
function TChatBox.GetPage(id: Integer): HELEMENT;
|
||||
var
|
||||
i: Integer;
|
||||
elc: TArray |
||||
begin
|
||||
Result := nil;
|
||||
if not (id = 0) then
|
||||
begin
|
||||
elc := SelectAll('#pages > .page');
|
||||
for i := 0 to Length(elc) - 1 do
|
||||
if UI.CallOnElement(elc[i], 'getPlugId', [], True) = id then
|
||||
begin
|
||||
Result := elc[i];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChatBox.GetLastEventTime(const UID: TUID): TDateTime;
|
||||
var
|
||||
el: HELEMENT;
|
||||
begin
|
||||
Result := 0;
|
||||
el := GetPage(UID);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
Result := StrToFloat(UI.CallOnElement(el, 'getLastEventTime', [], True));
|
||||
end;
|
||||
|
||||
function TChatBox.GetHistory(const UID: TUID): Thistory;
|
||||
begin
|
||||
if not histories.TryGetValue(UID, Result) then
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TChatBox.PageFire(const UID: TUID; cmd: UINT; data: Variant);
|
||||
var
|
||||
el: HELEMENT;
|
||||
begin
|
||||
el := GetPage(UID);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
UI.FireOnElement(el, cmd, data, False); // TODO: Sciter post bug? Wait for a fix
|
||||
end;
|
||||
|
||||
procedure TChatBox.PageFire(id: Integer; cmd: UINT; data: Variant);
|
||||
var
|
||||
el: HELEMENT;
|
||||
begin
|
||||
el := GetPage(id);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
UI.FireOnElement(el, cmd, data, False)
|
||||
end;
|
||||
|
||||
procedure TChatBox.PageCall(const UID: TUID; const method: AnsiString; const args: TParams);
|
||||
var
|
||||
el: HELEMENT;
|
||||
begin
|
||||
el := GetPage(UID);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
UI.CallOnElement(el, method, args, True)
|
||||
end;
|
||||
|
||||
procedure TChatBox.PageCall(id: Integer; const method: AnsiString; const args: TParams);
|
||||
var
|
||||
el: HELEMENT;
|
||||
begin
|
||||
el := GetPage(id);
|
||||
if Assigned(el) and IsValid(el) then
|
||||
UI.CallOnElement(el, method, args, True);
|
||||
end;
|
||||
|
||||
procedure TChatBox.SendChatItems(const UID: TUID; var Params: TParams; Action: TSendAction = SA_APPEND);
|
||||
var
|
||||
Event: Integer;
|
||||
begin
|
||||
Event := 0;
|
||||
if action = SA_APPEND then
|
||||
Event := $1000
|
||||
else if action = SA_PREPEND then
|
||||
Event := $1001
|
||||
else if action = SA_UPDATE then
|
||||
Event := $1002;
|
||||
PageFire(UID, Event, Params);
|
||||
end;
|
||||
|
||||
procedure TChatBox.HideHistory(const UID: TUID);
|
||||
begin
|
||||
PageCall(UID, 'hideHistory', []);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ViewInWindow(const title, body: String; const when: String; const formicon: String = '');
|
||||
begin
|
||||
Call('viewInWindow', [title, body, when, formicon]);
|
||||
end;
|
||||
|
||||
procedure TChatBox.AddToCurrentInput(const s: String);
|
||||
begin
|
||||
if not (s = '') then
|
||||
PageCall('', 'addToInput', [s]);
|
||||
end;
|
||||
|
||||
function TChatBox.FileUpload(Compress: Boolean; fn: String = ''): String;
|
||||
var
|
||||
url: String;
|
||||
str: TStringList;
|
||||
fs: TStream;
|
||||
begin
|
||||
Result := '';
|
||||
if not Assigned(CurrentContact) then
|
||||
Exit;
|
||||
|
||||
if (ServerToUpload = 0) and not OnlFeature(Account.AccProto) then
|
||||
Exit;
|
||||
|
||||
if fn = '' then
|
||||
fn := openSaveDlg(nil, 'Select file to transfer', True, '', '', '', Compress);
|
||||
if fn = '' then
|
||||
Exit;
|
||||
|
||||
str := TStringList.Create;
|
||||
str.StrictDelimiter := True;
|
||||
str.Delimiter := ';';
|
||||
str.DelimitedText := fn;
|
||||
|
||||
if (str.Count = 1) and not FileExists(str.Strings[0]) then
|
||||
begin
|
||||
Application.BringToFront;
|
||||
MsgDlg('File doesn''t exist', True, mtError);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Compress then
|
||||
begin
|
||||
fs := CreateZip(str);
|
||||
fn := 'files.zip';
|
||||
end
|
||||
else
|
||||
begin
|
||||
fs := TFileStream.Create(fn, fmOpenRead);
|
||||
fn := ExtractFileName(fn);
|
||||
end;
|
||||
str.Free;
|
||||
|
||||
SetupFileBtn(False);
|
||||
try
|
||||
if ServerToUpload = 0 then
|
||||
url := UploadFileICQ(fs, fn, UploadCallbacks)
|
||||
else if ServerToUpload = 1 then
|
||||
url := UploadFileMikanoshi(fs, fn, UploadCallbacks)
|
||||
else
|
||||
url := UploadFileRnQ(fs, fn, UploadCallbacks);
|
||||
finally
|
||||
SetupFileBtn(True);
|
||||
FreeAndNil(fs);
|
||||
end;
|
||||
|
||||
Result := Trim(url);
|
||||
end;
|
||||
|
||||
(*
|
||||
function WTFisit(vm: HVM; val: tiscript_value): String;
|
||||
begin
|
||||
if NI.is_int(val) then Result := Result + ' is_int';
|
||||
if NI.is_float(val) then Result := Result + ' is_float';
|
||||
if NI.is_symbol(val) then Result := Result + ' is_symbol';
|
||||
if NI.is_string(val) then Result := Result + ' is_string';
|
||||
if NI.is_array(val) then Result := Result + ' is_array';
|
||||
if NI.is_object(val) then Result := Result + ' is_object';
|
||||
if NI.is_native_object(val) then Result := Result + ' is_native_object';
|
||||
if NI.is_function(val) then Result := Result + ' is_function';
|
||||
if NI.is_native_function(val) then Result := Result + ' is_native_function';
|
||||
// if NI.is_instance_of : function(v: tiscript_value; cls: tiscript_value): Boolean; cdecl;
|
||||
if NI.is_undefined(val) then Result := Result + ' is_undefined';
|
||||
if NI.is_nothing(val) then Result := Result + ' is_nothing';
|
||||
if NI.is_null(val) then Result := Result + ' is_null';
|
||||
if NI.is_true(val) then Result := Result + ' is_true';
|
||||
if NI.is_false(val) then Result := Result + ' is_false';
|
||||
if NI.is_class(vm, val) then Result := Result + ' is_class';
|
||||
if NI.is_error(val) then Result := Result + ' is_error';
|
||||
if NI.is_bytes(val) then Result := Result + ' is_bytes';
|
||||
if NI.is_datetime(vm, val) then Result := Result + ' is_datetime';
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure TChatBox.ShowServerHistoryNotif(const UID: TUID);
|
||||
begin
|
||||
PageFire(UID, $102, Null);
|
||||
end;
|
||||
|
||||
procedure TChatBox.ShowSearchHere;
|
||||
begin
|
||||
Fire($104);
|
||||
end;
|
||||
|
||||
procedure TChatBox.FinishImage(const link: String);
|
||||
begin
|
||||
Call('finishImagesByLink', [link]);
|
||||
end;
|
||||
|
||||
constructor TChatBox.Create(MsgPreview: Boolean = False);
|
||||
begin
|
||||
Preview := MsgPreview;
|
||||
if not Preview then
|
||||
begin
|
||||
TaskBar := TTaskBarEx.Create(Hidden);
|
||||
TaskBar.ProgressMaxValue := 100;
|
||||
TaskBar.OnThumbButtonClick := TaskBarThumbButtonClick;
|
||||
end else
|
||||
TaskBar := nil;
|
||||
|
||||
DraggingTab := False;
|
||||
LastContact := nil;
|
||||
chats := Tchats.Create;
|
||||
plugBtns := TPlugButtons.Create;
|
||||
histories := TObjectDictionary |
||||
|
||||
UploadCallbacks.OnSendDataCallback := procedure(const Sender: TObject; AContentLength: Int64; AWriteCount: Int64; var AAbort: Boolean)
|
||||
begin
|
||||
TThread.Queue(nil, procedure
|
||||
begin
|
||||
UploadSize := AContentLength;
|
||||
UploadedSize := AWriteCount;
|
||||
if Assigned(UI.Chat) and UI.Chat.Visible then
|
||||
SetStatusbar('');
|
||||
end);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TChatBox.Destroy;
|
||||
begin
|
||||
histories.Clear;
|
||||
FreeAndNil(histories);
|
||||
FreeAndNil(plugBtns);
|
||||
FreeAndNil(chats);
|
||||
TabsIconCache.Clear;
|
||||
EmbeddedImgs.Clear;
|
||||
if not Preview then
|
||||
begin
|
||||
FreeAndNil(TaskBar);
|
||||
ReleaseThreading;
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TChatBox.ChatWndProc(var Message: TMessage): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
// Not working
|
||||
if Message.Msg = WM_COMMAND then
|
||||
ODS('WM_COMMAND: ' + inttostr(TWMCommand(Message).NotifyCode) + ', ' + inttostr(TWMCommand(Message).ItemID));
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
vKeyPicElm.ThemeToken := -1;
|
||||
vKeyPicElm.picName := PIC_KEY;
|
||||
vKeyPicElm.Element := RQteDefault;
|
||||
vKeyPicElm.pEnabled := True;
|
||||
CreateMessageRegex;
|
||||
|
||||
UploadCallbacks := TCallbacks.Create;
|
||||
TabsIconCache := TObjectDictionary |
||||
EmbeddedImgs := TDictionary |
||||
|
||||
emojiContents := TDictionary |
||||
emojiContents.Add(0, TArray |
||||
emojiContents.Add(1, TArray |
||||
emojiContents.Add(2, TArray |
||||
emojiContents.Add(3, TArray |
||||
emojiContents.Add(4, TArray |
||||
emojiContents.Add(5, TArray |
||||
emojiContents.Add(6, TArray |
||||
833, 832, 835, 477, 478, 1272, 1261, 1240, 803, 1257, 1258, 1259, 1241, 723, 722, 12, 13, 1117, 826, 825, 827, 829, 828, 1159, 824, 1203, 1204, 852, 853, 856, 857, 854, 855, 858, 1145, 1146, 1268, 1269, 859, 1150, 1149, 1152, 1151, 850, 851, 808, 809, 810, 807, 772, 771, 820, 821, 15, 14, 1186, 1187, 1188, 1189, 476, 718, 925, 717, 868, 869, 870, 871, 872, 873, 874, 875, 876, 877, 878, 879, 880, 881, 882, 883, 884, 885, 886, 887, 888, 889, 890, 891, 610));
|
||||
emojiContents.Add(7, TArray |
||||
112, 270, 277, 271, 272, 279, 273, 275, 278, 280, 100, 283, 286, 287, 224, 46, 250, 142, 61, 86, 70, 116, 140, 284, 199, 217, 57, 216, 125, 257, 65, 131, 237, 269, 136, 96, 81, 90, 42, 40, 276, 76, 85, 104, 115, 253, 122, 186, 185, 247, 244, 251, 177));
|
||||
|
||||
finalization
|
||||
|
||||
FreeMessageRegex;
|
||||
emojiContents.Free;
|
||||
UploadCallbacks.Free;
|
||||
TabsIconCache.Free;
|
||||
EmbeddedImgs.Free;
|
||||
|
||||
end.
|