Browse Source

- Заменена библиотека, отвечающая за все сетевые соединения

- Меньше размер, потенциально выше скорость выполнения запросов
	- Поскольку библиотека полностью основана на возможностях ОС, включая SSL, файлы libcrypto*.dll и libssl*.dll больше не нужны, их можно удалить из папки с модулями
	- По умолчанию используется указанный в системе прокси, изменение поддерживается только на прокси HTTPS типа
	- На Windows 7 желательны последние обновления системы и патч для активации TLS 1.1/1.2, но некоторые функции HTTP протокола всё равно будут недоступны, например получение данных в сжатом виде
- Исправлено неверное определение исходящей попытки пробуждения как входящей при загрузке сообщений из серверной истории
- Изменено сохранение параметров конфигурации типа float/date в базу для избежания ошибок в ОС с разными региональными настройками
master 1130v82
Mikanoshi 7 months ago
parent
commit
9f0ef63ae0
38 changed files with 914 additions and 1848 deletions
  1. +9
    -0
      CHANGELOG
  2. BIN
      Distro/Modules/32/libcrypto-1_1.dll
  3. BIN
      Distro/Modules/32/libssl-1_1.dll
  4. BIN
      Distro/Modules/64/libcrypto-1_1-x64.dll
  5. BIN
      Distro/Modules/64/libssl-1_1-x64.dll
  6. +4
    -2
      Distro/RnQ1124_rus.utflng
  7. +0
    -4
      Distro/Template/about.htm
  8. +1
    -0
      Distro/Template/alert.css
  9. +7
    -5
      Distro/Template/preferences.htm
  10. +1
    -1
      Distro/Template/tips.css
  11. BIN
      Distro/template.zip.sample
  12. +2
    -2
      README.html
  13. +0
    -4
      Requirements.txt
  14. +1
    -2
      RnQ/CLBox.pas
  15. +25
    -48
      RnQ/ChatBox.pas
  16. +1
    -1
      RnQ/ICQ/ICQCommon.pas
  17. +34
    -135
      RnQ/ICQ/ICQSession.pas
  18. +1
    -1
      RnQ/ICQ/Protocol_ICQ.pas
  19. +1
    -1
      RnQ/ICQ/Stickers.pas
  20. +22
    -22
      RnQ/ICQ/viewinfoDlg.pas
  21. +1
    -1
      RnQ/Protocols_all.pas
  22. +2
    -2
      RnQ/RnQBuiltTime.inc
  23. +27
    -53
      RnQ/RnQ_Avatars.pas
  24. +2
    -2
      RnQ/RnQx64.dproj
  25. +32
    -9
      RnQ/SQLiteDB.pas
  26. +0
    -3
      RnQ/SciterLib.pas
  27. +1
    -4
      RnQ/aboutDlg.pas
  28. +1
    -1
      RnQ/globalLib.pas
  29. BIN
      RnQ/images.res
  30. +4
    -6
      RnQ/iniLib.pas
  31. +1
    -1
      RnQ/pluginLib.pas
  32. +1
    -5
      RnQ/prefSheet.pas
  33. +18
    -20
      RnQ/utilLib.pas
  34. +1
    -1
      for.RnQ/RQUtil.pas
  35. +1
    -2
      for.RnQ/RTL/RDUtils.pas
  36. +76
    -991
      for.RnQ/RTL/RnQBinUtils.pas
  37. +636
    -518
      for.RnQ/RnQNet.pas
  38. +1
    -1
      for.RnQ/incapsulate.pas

+ 9
- 0
CHANGELOG View File

@ -1,3 +1,12 @@
Изменения в сборке 82 beta
- Заменена библиотека, отвечающая за все сетевые соединения
- Меньше размер, потенциально выше скорость выполнения запросов
- Поскольку библиотека полностью основана на возможностях ОС, включая SSL, файлы libcrypto*.dll и libssl*.dll больше не нужны, их можно удалить из папки с модулями
- По умолчанию используется указанный в системе прокси, изменение поддерживается только на прокси HTTPS типа
- На Windows 7 желательны последние обновления системы и патч для активации TLS 1.1/1.2, но некоторые функции HTTP протокола всё равно будут недоступны, например получение данных в сжатом виде
- Исправлено неверное определение исходящей попытки пробуждения как входящей при загрузке сообщений из серверной истории
- Изменено сохранение параметров конфигурации типа float/date в базу для избежания ошибок в ОС с разными региональными настройками
Изменения в сборке 81
- Удалена загрузка файлов на rghost.net, добавлена загрузка на сервер ICQ (files.icq.net)
- Добавлен выбор контактов для отправки собеседнику (создаёт список ссылок вида https://icq.im/230490, оф клиент отображает их как карточки профилей)


BIN
Distro/Modules/32/libcrypto-1_1.dll View File


BIN
Distro/Modules/32/libssl-1_1.dll View File


BIN
Distro/Modules/64/libcrypto-1_1-x64.dll View File


BIN
Distro/Modules/64/libssl-1_1-x64.dll View File


+ 4
- 2
Distro/RnQ1124_rus.utflng View File

@ -4075,8 +4075,10 @@ _________
Очередь запросов на сервере заполнена
[Not while on AOL]
Не на AOL
[OpenSSL libs are not found\n%s]
Не найдены библиотеки OpenSSL\n%s
[SSL certificate error\n%s\n[%d] %s]
Ошибка SSL сертификата\n%s\n[%d] %s
[Request is redirecting too many times\n%s\n[%d] %s]
Запрос выполнил слишком много перенаправлений\n%s\n[%d] %s
[Message was encrypted using another public key]
Сообщение было зашифровано с использованием другого публичного ключа
[Zero length message]


+ 0
- 4
Distro/Template/about.htm View File

@ -70,9 +70,7 @@
$(#ver).text = info.ver;
$(#build > a).text = info.build;
$(#sciterver).text = info.sciterver;
$(#opensslver).text = info.opensslver;
$(#bassver).text = info.bassver;
$(#icsver).text = info.icsver;
$(#synopsever).text = info.synopsever;
self.timer(35, animFunc);
$(#ok).state.focus = true;
@ -105,9 +103,7 @@
<div id="libs" class="hidden">
<div><div>Sciter</div><div id="sciterver">-</div></div>
<div><div>OpenSSL</div><div id="opensslver">-</div></div>
<div><div>Bass</div><div id="bassver">-</div></div>
<div><div>Overbyte ICS</div><div id="icsver">-</div></div>
<div><div>Synopse Framework</div><div id="synopsever">-</div></div>
</div>


+ 1
- 0
Distro/Template/alert.css View File

@ -48,6 +48,7 @@ select option {
width: *;
height: max-content;
white-space: pre-wrap;
word-wrap: break-word;
opacity: 0;
transform: translate(0, -10dip);
position: relative;


+ 7
- 5
Distro/Template/preferences.htm View File

@ -268,7 +268,7 @@
else
$(#profile_proxy_row).hide();
if (profileProxy.value >= 2) {
if (profileProxy.value >= 1) {
$(#profile_proxyauth_col).show();
$(#profile_proxyauth).postEvent("change");
} else {
@ -276,7 +276,7 @@
$(#profile_proxyauth_row).hide();
}
if (profileProxy.value < 3)
if (profileProxy.value < 1)
$(#profile_proxyntlm_row).hide();
}
@ -294,7 +294,7 @@
$(#profile_proxyauth).on("change", :e {
if ($(#profile_proxyauth).checked) {
$(#profile_proxyauth_row).show();
if ($(#profile_proxy).value == 3)
if ($(#profile_proxy).value == 1)
$(#profile_proxyntlm_row).show();
} else {
$(#profile_proxyauth_row).hide();
@ -1475,9 +1475,11 @@
<span>Proxy</span>
<select uwp name="profile_proxy" id="profile_proxy">
<option value="0" translate>None</option>
<!--
<option value="1">SOCKS4</option>
<option value="2">SOCKS5</option>
<option value="3">HTTP/S</option>
-->
<option value="1">HTTPS</option>
</select>
</div>
<div class="col limited" id="profile_proxyauth_col" hidden>
@ -2465,6 +2467,6 @@
<div id="buddy_actopacity" class="sliderhint"></div>
<div id="buddy_inactopacity" class="sliderhint"></div>
<div id="buddy_tipsopacity" class="sliderhint"></div>
<div id="buddy_volume" class="sliderhint"></div>
<div id="buddy_volume" class="sliderhint"></div>
</body>
</html>

+ 1
- 1
Distro/Template/tips.css View File

@ -14,7 +14,7 @@ img {
font-rendering-mode: snap-pixel;
size: max-content;
opacity: 0;
transition: opacity cubic-out 0.3s;
transition: opacity 0.3s cubic-out;
}
.tip.image {
padding: 0;


BIN
Distro/template.zip.sample View File


+ 2
- 2
README.html View File

@ -1,8 +1,8 @@
<div style="line-height: 150%;">
<h1>R&Q 1130 Кастомная сборка</h1>
Номер сборки: 81<br>
Последнее обновление: 23.07.2020<br><br>
Номер сборки: 82<br>
Последнее обновление: 29.07.2020<br><br>
<div style="width: 100%; height: 1px; border-top: #D3D3D3 solid 1px;"></div>
<h2>Особенности интерфейса</h2>
- Интерфейс частично переведён на <a target="_blank" href="http://sciter.com/">движок Sciter</a>, его шаблоны написаны на HTML/CSS/TIScript и могут быть отредактированы<br>


+ 0
- 4
Requirements.txt View File

@ -1,9 +1,5 @@
Используемые компоненты:
ICS v8
http://www.overbyte.be
В ICS\Source\Include\OverbyteIcsDefs.inc включить {$DEFINE USE_SSL}
SciDe
https://github.com/Mikanoshi/SciDe


+ 1
- 2
RnQ/CLBox.pas View File

@ -849,7 +849,6 @@ var
// TmpJSON: TJSONValue;
// ev: Thevent;
begin
if argc = 0 then
Exit;
@ -1616,7 +1615,7 @@ begin
// Wait for active window to switch
TTask.Run(procedure
begin
TThread.Synchronize(nil, procedure
TThread.Queue(nil, procedure
begin
ApplyTransparency(AW_CL);
end);


+ 25
- 48
RnQ/ChatBox.pas View File

@ -258,9 +258,6 @@ type
function GetReplacement(args: TArray<String>): PCREString;
function ReplaceEmoji(const msg: String): String;
procedure OnBeforeHeaderSend(Sender: TObject; const Method: String; Headers: TStrings);
procedure OnSendData(Sender: TObject; Buffer: Pointer; Len: Integer);
procedure OnHeaderEnd(Sender: TObject);
procedure DisplayHint(Sender: TObject);
procedure TaskBarThumbButtonClick(Sender: TObject; AButtonID: Integer);
end;
@ -344,7 +341,7 @@ uses
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,
OverbyteIcsHttpProt, HTTPStatus;
HTTPStatus;
const
emojiExtNumbers: array [0..7] of Integer = (984, 1110, 386, 507, 501, 822, 694, 227);
@ -1167,31 +1164,6 @@ end;
// inherited;
//end;
procedure TChatBox.OnBeforeHeaderSend(Sender: TObject; const Method: String; Headers: TStrings);
begin
Headers.Add('Pragma: no-cache');
Headers.Add('Cache-Control: no-cache');
end;
procedure TChatBox.OnSendData(Sender: TObject; Buffer: Pointer; Len: Integer);
begin
Inc(UploadedSize, Len);
if Assigned(UI.Chat) and UI.Chat.Visible then
SetStatusbar('');
end;
procedure TChatBox.OnHeaderEnd(Sender: TObject);
var
Code: Integer;
begin
with TSslHttpCli(Sender) do
begin
Tag := StatusCode;
if not ContainsText(RcvdHeader.Text, 'Location:') then
Abort;
end;
end;
procedure TChatBox.DisplayHint(Sender: TObject);
begin
if Assigned(UI.Chat) and UI.Chat.Visible then
@ -1304,7 +1276,7 @@ begin
// Wait for active window to switch
TTask.Run(procedure
begin
TThread.Synchronize(nil, procedure
TThread.Queue(nil, procedure
begin
ApplyTransparency(AW_CHAT);
end);
@ -2238,7 +2210,6 @@ var
FileInfo: TICQFileInfo;
Infos: TArray<TParamPair>;
Params: TParams;
Callbacks: TCallbacks;
Anketa: TAnketa;
I: Integer;
begin
@ -2288,9 +2259,7 @@ begin
if Length(Infos) = 0 then
begin
Callbacks := TCallbacks.Create;
Callbacks.OnHeaderEnd := UI.Chat.OnHeaderEnd;
LinkInfo := InfoFromURL(Link, Callbacks);
LinkInfo := InfoFromURL(Link);
SetLength(Infos, 3);
Infos[0].param := GetTranslation('Response code');
Infos[0].value := IntToStr(LinkInfo.code) + ' ' + StatusText(LinkInfo.code);
@ -2298,13 +2267,12 @@ begin
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;
Callbacks.Free;
// 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));
@ -2354,7 +2322,7 @@ begin
Exit;
fs := TMemoryStream.Create;
LoadFromUrl(ytlink, fs);
LoadFromURLAsStream(ytlink, fs);
SetLength(ytpage, fs.Size);
fs.ReadBuffer(ytpage[1], fs.Size);
fs.Free;
@ -2467,7 +2435,7 @@ begin
Exit;
fs := TMemoryStream.Create;
LoadFromUrl(vmlink, fs);
LoadFromURLAsStream(vmlink, fs);
SetLength(vmpage, fs.Size);
fs.ReadBuffer(vmpage[1], fs.Size);
@ -2485,7 +2453,7 @@ begin
vmtitle := DecodeURL(UnUTF(vmtitle));
fs.Clear;
LoadFromUrl(vmurl, fs);
LoadFromURLAsStream(vmurl, fs);
SetLength(vmpage, fs.Size);
fs.ReadBuffer(vmpage[1], fs.Size);
fs.Free;
@ -4656,13 +4624,22 @@ begin
end else
TaskBar := nil;
DraggingTab := False;
LastContact := nil;
chats := Tchats.Create;
plugBtns := TPlugButtons.Create;
DraggingTab := False;
histories := TObjectDictionary<TUID, THistory>.Create([doOwnsValues]);
LastContact := nil;
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;


+ 1
- 1
RnQ/ICQ/ICQCommon.pas View File

@ -94,7 +94,7 @@ uses
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF UNICODE}
RQLog, RDFileUtil, RnQBinUtils, RQUtil, RnQGlobal, RnQCrypt,
RQLog, RDFileUtil, RQUtil, RnQGlobal, RnQCrypt,
globalLib, utilLib, themesLib, mainDlg;
var


+ 34
- 135
RnQ/ICQ/ICQSession.pas View File

@ -8,10 +8,9 @@ unit ICQSession;
interface
uses
Windows, SysUtils, Classes, Types, JSON, Generics.Defaults, Generics.Collections, Threading, ExtCtrls,
RnQGlobal, RnQNet, RDGlobal, RQUtil, RnQPrefsLib, RnQBinUtils,
ICQCommon, ICQContacts, StrUtils, ICQConsts, OverbyteIcsHttpProt,
Math, SynEcc, Stickers;
Windows, SysUtils, Classes, Types, StrUtils, Math, Threading, JSON,
Net.HttpClient, Net.URLClient, Generics.Defaults, Generics.Collections,
RnQGlobal, RnQNet, RDGlobal, RQUtil, RnQPrefsLib, ICQCommon, ICQContacts, ICQConsts, SynEcc, Stickers;
{$I NoRTTI.inc}
@ -86,23 +85,6 @@ type
online_
);
THttpAsync = class(TSslHttpCli)
private
FTimeout: TTimer;
FOnRequestDone: THttpRequestDone;
public
Contact: TICQContact;
constructor Create(Timeout: Integer = 30; Callback: THttpRequestDone = nil);
destructor Destroy; override;
procedure Setup(Link: String; Data: Pointer = nil);
procedure SetTimeout(Timeout: Integer);
procedure StartTimeout;
procedure StopTimeout;
procedure TimedOut(Sender: TObject);
procedure OnRequestDoneTimed(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
end;
TICQSession = class;
TProtoNotify = procedure (Sender: TICQSession; event: Integer);
@ -276,7 +258,7 @@ type
procedure RestartPolling(Delay: Integer = 1);
procedure AbortPolling;
procedure PollURL(URL: String);
procedure PollRequestDone(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
procedure PollRequestDone(Sender: TObject; const Response: IHTTPResponse; Error: String = '');
procedure ProcessContactList(const CL: TJSONArray; Batch: Boolean = False);
function ProcessContact(const Buddy: TJSONObject; GroupToAddTo: Integer = -1; Batch: Boolean = False): TICQContact;
procedure ProcessNewStatus(var Cnt: TICQcontact; NewStatus: TICQstatus; XStatusStrChanged: Boolean = False; NoNotify: Boolean = False);
@ -463,65 +445,6 @@ uses
const
AESBLKSIZE = SizeOf(TAESBlock);
constructor THttpAsync.Create(Timeout: Integer = 30; Callback: THttpRequestDone = nil);
begin
inherited Create(nil);
FOnRequestDone := Callback;
OnRequestDone := OnRequestDoneTimed;
MultiThreaded := not (GetCurrentThreadID = MainThreadID);
FollowRelocation := True;
Connection := 'keep-alive';
// Agent := 'Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0';
FTimeout := TTimer.Create(nil);
FTimeout.Interval := Timeout * 1000;
FTimeout.OnTimer := TimedOut;
end;
procedure THttpAsync.Setup(Link: String; Data: Pointer = nil);
begin
URL := Link;
Contact := Data;
SetupProxy(TSslHttpCli(Self));
end;
destructor THttpAsync.Destroy;
begin
StopTimeout;
FreeAndNil(FTimeout);
inherited;
end;
procedure THttpAsync.SetTimeout(Timeout: Integer);
begin
FTimeout.Interval := Timeout * 1000;
end;
procedure THttpAsync.StartTimeout;
begin
FTimeout.Enabled := True;
end;
procedure THttpAsync.StopTimeout;
begin
FTimeout.Enabled := False;
end;
procedure THttpAsync.TimedOut(Sender: TObject);
begin
StopTimeout;
Abort;
end;
procedure THttpAsync.OnRequestDoneTimed(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
begin
StopTimeout;
if Assigned(FOnRequestDone) then
FOnRequestDone(Sender, RqType, ErrCode);
end;
function CheckResponseData(var JSON: TJSONObject; out ReqID: String): TPair<Integer, String>;
var
Tmp: TJSONValue;
@ -654,8 +577,8 @@ begin
fECCKeys.Generated := ecc_make_key(fECCKeys.PubEccKey, fECCKeys.PrivKey);
Pool := TThreadPool.Create;
HttpPoll := THttpAsync.Create(58, PollRequestDone);
HttpPoll.RcvdStream := TStringStream.Create('', TEncoding.UTF8);
HttpPoll := THttpAsync.Create(58);
HttpPoll.Callback := PollRequestDone;
end;
procedure TICQSession.ResetPrefs;
@ -890,7 +813,6 @@ begin
PollingTask.Cancel;
if Assigned(ReconnectTask) then
ReconnectTask.Cancel;
FreeAndNil(HttpPoll.RcvdStream);
FreeAndNil(HttpPoll);
FreeAndNil(Pool);
FreeAndNil(ContactsDB);
@ -1115,7 +1037,7 @@ begin
else
LoadFromURLAsString(BaseURL + '?' + Query, RespStr);
TThread.Synchronize(nil, procedure
TThread.Queue(nil, procedure
begin
if not Running then
Exit;
@ -1613,7 +1535,7 @@ begin
if Results.Count > 0 then
begin
Anketa.UID := '';
Contact := TJSONObject(Results.Get(0));
Contact := TJSONObject(Results.Items[0]);
if not Contact.TryGetValue('sn', Anketa.UID) or (Anketa.UID = '') then
Exit;
if not Contact.TryGetValue('bot', Anketa.Bot) then
@ -3274,13 +3196,13 @@ begin
begin
FatalErrorCount := 0;
MsgDlg(GetTranslation('Failed to start listening for events, disconnecting...') +
IfThen(ExtraError = '', '', #13#10 + '[' + ExtraError + ']'), False, mtError);
IfThen(ExtraError = '', '', #13#10 + ExtraError), False, mtError);
LogICQPacket(WL_disconnected, '', 'Encountered unrecoverable error, disconnecting...', ExtraError);
EndSession;
Exit;
end else if (not Silent) then
MsgDlg(GetTranslation('Failed to start listening for events, waiting %d sec before retry...', [Round(ICQErrorReconnectDelay / 1000)]) +
IfThen(ExtraError = '', '', #13#10 + '[' + ExtraError + ']'), False, mtError);
IfThen(ExtraError = '', '', #13#10 + ExtraError), False, mtError);
if Assigned(ReconnectTask) then
ReconnectTask.Cancel;
@ -3288,7 +3210,7 @@ begin
begin
Sleep(ICQErrorReconnectDelay);
if not (TTask.CurrentTask.Status = TTaskStatus.Canceled) then
TThread.Synchronize(nil, procedure
TThread.Queue(nil, procedure
begin
// Try to use existing session, get new initial fetch url and start polling again. Go offline if all fails.
if Running then
@ -3314,7 +3236,7 @@ begin
if not Assigned(HttpPoll) or (URL = '') then
begin
PollError('ERR_UNASSIGNED');
PollError('[ERR_UNASSIGNED]');
Exit;
end;
@ -3329,24 +3251,12 @@ begin
URL := URL + '&hidden=1';
HttpPoll.Setup(URL);
try
HttpPoll.GetAsync;
HttpPoll.StartTimeout;
except
on E: OverbyteIcsHttpProt.EHttpException do
begin
if E.ErrorCode = httperrBusy then
begin
HttpPoll.StopTimeout;
HttpPoll.Abort;
end;
HandleError(E, URL, '', False);
PollError('ERR_GETFAIL');
end;
end;
HttpPoll.SetLongPoll;
HttpPoll.GetAsync;
HttpPoll.StartTimeout;
end;
procedure TICQSession.PollRequestDone(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
procedure TICQSession.PollRequestDone(Sender: TObject; const Response: IHTTPResponse; Error: String = '');
var
t, ts, code: Integer;
RespStr, SReqID, ErrText: String;
@ -3370,43 +3280,32 @@ var
Freq, StartCount, StopCount: Int64;
TimingSeconds: Real;
begin
if not Assigned(Sender) then
begin
PollError('ERR_NOSENDER');
Exit;
end;
with Sender as TSslHttpCli do
begin
if Assigned(SendStream) then
SendStream.Free;
RespStr := TStringStream(HttpPoll.RcvdStream).DataString;
HttpPoll.CleanupRcvdStream;
end;
// Abort and request fetch URL again every <60 sec to stay online
if ErrCode = httperrAborted then
if not Assigned(Response) or (Response.StatusCode = 0) then
begin
RestartPolling(1000);
if Error = '' then
RestartPolling(1000)
else
PollError(Error);
Exit;
end;
RespStr := Response.ContentAsString(TEncoding.UTF8);
// 5 sec delay after HTTP error
if not (HttpPoll.StatusCode = 200) then
if not (Response.StatusCode = 200) then
begin
if ShowTempConnectErrors and not (HttpPoll.StatusCode = 0) then
if ShowTempConnectErrors {and not (Response.StatusCode = 0)} then
begin
ErrText := '';
if not (HttpPoll.RcvdHeader.Text = '') then
ErrText := ErrText + #13#10 + 'Header: ' + HttpPoll.RcvdHeader.Text;
ErrText := Error;
if not (RespStr = '') then
ErrText := ErrText + #13#10 + 'Response: ' + RespStr;
MsgDlg(GetTranslation('Server error during event fetch') + ': ' + IntToStr(HttpPoll.StatusCode) + ErrText, False, mtWarning);
MsgDlg(GetTranslation('Server error during event fetch') + ': ' + IntToStr(Response.StatusCode) + ErrText, False, mtWarning);
end;
if (HttpPoll.StatusCode >= 500) and (HttpPoll.StatusCode < 600) then
if (Response.StatusCode >= 500) and (Response.StatusCode < 600) then
RestartPolling(ICQErrorReconnectDelay)
else
PollError('ERR_HTTPCODE', not ShowTempConnectErrors and (HttpPoll.StatusCode = 0));
PollError('[ERR_HTTPCODE]', not ShowTempConnectErrors and (Response.StatusCode = 0));
Exit;
end;
@ -3418,7 +3317,7 @@ begin
if Trim(RespStr) = '' then
begin
// PollError('ERR_EMPTYRESP: ' + HttpPoll.URL);
// PollError('[ERR_EMPTYRESP]: ' + HttpPoll.URL);
RestartPolling(1000);
Exit;
end;
@ -3434,7 +3333,7 @@ begin
LastFetchBaseURL := '';
if not ParseJSON(RespStr, JSON) then
begin
PollError('ERR_NOTAJSON');
PollError('[ERR_NOTAJSON]');
Exit;
end;
FatalErrorCount := 0;
@ -3522,7 +3421,7 @@ end;
procedure TICQSession.RestartPolling(Delay: Integer = 1);
begin
if (LastFetchBaseURL = '') then
PollError('ERR_UNCLEAN')
PollError('[ERR_UNCLEAN]')
else
begin
if Assigned(PollingTask) then
@ -3531,7 +3430,7 @@ begin
begin
Sleep(Max(100, Delay)); // Min 100ms between fetches, just in case :)
if not (TTask.CurrentTask.Status = TTaskStatus.Canceled) then
TThread.Synchronize(nil, procedure
TThread.Queue(nil, procedure
begin
if Running then
PollURL(LastFetchBaseURL);
@ -4163,7 +4062,7 @@ var
Insert(TJSONString(RQCap).Value, Caps, High(Caps));
// Buzz
if MatchText(String2Hex(BigCapability[CAPS_big_Buzz].v), Caps) then
if MatchText(String2Hex(BigCapability[CAPS_big_Buzz].v), Caps) and not Outgoing then
begin
eventContact := Contact;
NotifyListeners(IE_buzz);


+ 1
- 1
RnQ/ICQ/Protocol_ICQ.pas View File

@ -36,7 +36,7 @@ uses
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF}
RnQBinUtils, RnQNet, RQUtil, RnQDialogs, RQlog,
RnQNet, RQUtil, RnQDialogs, RQlog,
rnqLangs, RnQStrings, RQThemes, RDFileUtil, RDUtils,
RnQTips, RnQTrayLib, RnQGlobal, RnQPics, RnQ_Avatars,
Protocols_all, ICQClients, history, mainDlg, ChatBox, SQLiteDB;


+ 1
- 1
RnQ/ICQ/Stickers.pas View File

@ -79,7 +79,7 @@ begin
begin
if not DirectoryExists(StickerPath) then
ForceDirectories(StickerPath);
LoadFromURL(URL, fn);
LoadFromURLAsFile(URL, fn);
end;
if FileExists(fn) then
fs.LoadFromFile(fn);


+ 22
- 22
RnQ/ICQ/viewinfoDlg.pas View File

@ -567,8 +567,8 @@ end;
procedure LoadThumb(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
s: String;
f: TMemoryStream;
FileName: String;
FileStr: TMemoryStream;
Contact: TICQContact;
begin
Contact := GetArgumentContact(argv);
@ -576,20 +576,20 @@ begin
Exit;
RemoveAllContactAorP(Contact, 1);
s := AccPath + avtPath + Contact.UID + '.photo.jpeg';
LoadFromURL(ICQ_THUMB_URL + Contact.UID, s, 0, True);
FileName := AccPath + avtPath + Contact.UID + '.photo.jpeg';
LoadFromURLAsFile(ICQ_THUMB_URL + Contact.UID, FileName, True);
if FileExists(s) then
if FileExists(FileName) then
begin
f := TMemoryStream.Create;
f.LoadFromFile(s);
if not IsSupportedPicFile(ExtractFileName(s)) or (DetectFileFormatStream(f) = PA_FORMAT_UNK) then
FileStr := TMemoryStream.Create;
FileStr.LoadFromFile(FileName);
if not IsSupportedPicFile(ExtractFileName(FileName)) or (DetectFileFormatStream(FileStr) = PA_FORMAT_UNK) then
begin
DeleteFile(s);
DeleteFile(FileName);
ShowAvatarError(Contact);
end else
FindAndSaveVibrantColors(1, f, Contact);
f.Free;
FindAndSaveVibrantColors(1, FileStr, Contact);
FileStr.Free;
end;
UpdateAnP(Contact);
@ -598,8 +598,8 @@ end;
procedure LoadPhoto(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
s: String;
f: TMemoryStream;
FileName: String;
FileStr: TMemoryStream;
Contact: TICQContact;
begin
Contact := GetArgumentContact(argv);
@ -607,20 +607,20 @@ begin
Exit;
RemoveAllContactAorP(Contact, 1);
s := AccPath + avtPath + Contact.UID + '.photo.jpeg';
LoadFromURL(Format(ICQ_PHOTO_AVATAR, [Contact.UID, Contact.gender]), s, 0, True);
FileName := AccPath + avtPath + Contact.UID + '.photo.jpeg';
LoadFromURLAsFile(Format(ICQ_PHOTO_AVATAR, [Contact.UID, Contact.gender]), FileName, True);
if FileExists(s) then
if FileExists(FileName) then
begin
f := TMemoryStream.Create;
f.LoadFromFile(s);
if not IsSupportedPicFile(ExtractFileName(s)) or (DetectFileFormatStream(f) = PA_FORMAT_UNK) then
FileStr := TMemoryStream.Create;
FileStr.LoadFromFile(FileName);
if not IsSupportedPicFile(ExtractFileName(FileName)) or (DetectFileFormatStream(FileStr) = PA_FORMAT_UNK) then
begin
DeleteFile(s);
DeleteFile(FileName);
ShowAvatarError(Contact);
end else
FindAndSaveVibrantColors(1, f, Contact);
f.Free;
FindAndSaveVibrantColors(1, FileStr, Contact);
FileStr.Free;
end;
UpdateAnP(Contact);


+ 1
- 1
RnQ/Protocols_all.pas View File

@ -72,7 +72,7 @@ implementation
uses
SysUtils, StrUtils, SciterLib,
RnQBinUtils, RQUtil, RnQDialogs, RnQLangs, RnQStrings,
RQUtil, RnQDialogs, RnQLangs, RnQStrings,
RDUtils, RnQSysUtils, RnQGlobal,
ICQCommon, ICQConsts,
pluginutil, pluginLib, history,


+ 2
- 2
RnQ/RnQBuiltTime.inc View File

@ -1,2 +1,2 @@
{ 23.07.2020 22:47:53 }
BuiltTime = 44035.9499299653;
{ 29.07.20 1:32:23 }
BuiltTime = 44041.0641612963;

+ 27
- 53
RnQ/RnQ_Avatars.pas View File

@ -8,8 +8,8 @@ unit RnQ_Avatars;
interface
uses
Windows, Forms, SysUtils, Classes, Graphics, Controls, ExtCtrls,
RnQGraphics32, RDGlobal, ICQCommon, ICQContacts, ICQSession, OverbyteIcsHttpProt;
Windows, Forms, System.Net.HttpClient, SysUtils, Classes, Graphics, Controls, ExtCtrls,
RnQGraphics32, RDGlobal, ICQCommon, ICQContacts, ICQSession;
{$I NoRTTI.inc}
// const
@ -60,13 +60,6 @@ type
Proc: TOnDownloadedProc;
end;
TDownloadObj = class
public
procedure OnAvatarDownloaded(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
end;
function LoadFromURL2(params: TLoadURLParams): Boolean;
implementation
uses
@ -320,42 +313,33 @@ begin
[IfThen(Cnt.displayed = '', Cnt.UID, Cnt.displayed)]), False, mtInformation);
end;
procedure TDownloadObj.OnAvatarDownloaded(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
var
Async: THttpAsync;
mem: TMemoryStream;
procedure DownloadAvtFromURL(Cnt: TICQContact);
begin
Async := (Sender as THttpAsync);
if not Assigned(Async) then
Exit;
mem := nil;
try
if (ErrCode = httperrNoError) and Assigned(Async.RcvdStream) and (Async.RcvdCount > 0) then
begin
Async.RcvdStream.Seek(0, soFromBeginning);
mem := TMemoryStream(Async.RcvdStream);
SaveAndLoadAvatar(Async.Contact, mem);
end else
ShowAvatarError(Async.Contact);
TryLoadAvatar(Async.Contact);
finally
FreeAndNil(mem);
if Assigned(Async.SendStream) then
Async.SendStream.Free;
//Async.RcvdStream.Free;
FreeAndNil(Async);
FreeAndNil(Self);
end;
end;
LoadFromURLAsync(ICQ_AVATAR_URL + Cnt.uid, procedure(Sender: TObject; const Response: IHTTPResponse; Error: String = '')
var
Mem: TMemoryStream;
Client: THttpAsync;
begin
Client := Sender as THttpAsync;
if not Assigned(Client) or not Assigned(Response) then
Exit;
procedure DownloadAvtFromURL(c: TICQContact);
var
DObj: TDownloadObj;
begin
DObj := TDownloadObj.Create;
LoadFromURLAsync(ICQ_AVATAR_URL + c.uid, DObj.OnAvatarDownloaded, c);
Mem := nil;
try
if HandleStatus(Response.StatusCode) and Assigned(Response.ContentStream) and (Response.ContentLength > 0) then
begin
Response.ContentStream.Seek(0, soFromBeginning);
Mem := TMemoryStream.Create;
Mem.CopyFrom(Response.ContentStream);
SaveAndLoadAvatar(Cnt, Mem);
end else
ShowAvatarError(Cnt);
TryLoadAvatar(Cnt);
finally
FreeAndNil(Mem);
FreeAndNil(Client);
end;
end);
end;
procedure DownloadAvatar(c: TICQContact);
@ -547,14 +531,4 @@ begin
FindClose(SR);
end;
function LoadFromURL2(params: TLoadURLParams): Boolean;
var
fn: String;
begin
fn := params.fn;
Result := LoadFromURL(params.url, fn, params.Treshold, params.ExtByContent);
if Result then
params.Proc(fn, 0, params.cnt);
end;
end.

+ 2
- 2
RnQ/RnQx64.dproj View File

@ -133,7 +133,7 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>vcl;ExceptionExpert16;vclx;OverbyteIcsD101Run;VirtualTreesR;GR32_DSGN_RS2009;for_rnq;DbxCommonDriver;dbrtl;DataSnapClient;DbxClientDriver;xmlrtl;vclactnband;SciDe;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_UsePackage>vcl;vclx;GR32_DSGN_RS2009;for_rnq;dbrtl;xmlrtl;vclactnband;SciDe;$(DCC_UsePackage)</DCC_UsePackage>
<Icon_MainIcon>Res\rnqold.ico</Icon_MainIcon>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
@ -142,7 +142,7 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>vcl;vclx;OverbyteIcsD101Run;VirtualTreesR;DbxCommonDriver;dbrtl;DataSnapClient;DbxClientDriver;xmlrtl;vclactnband;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_UsePackage>vcl;vclx;GR32_DSGN_RS2009;for_rnq;dbrtl;xmlrtl;vclactnband;SciDe;$(DCC_UsePackage)</DCC_UsePackage>
<Icon_MainIcon>Res\rnqold.ico</Icon_MainIcon>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>


+ 32
- 9
RnQ/SQLiteDB.pas View File

@ -208,6 +208,9 @@ uses
SciterLib, UtilLib, IOUtils, history, Base64,
RDGlobal, RDFileUtil, RDUtils, RnQGlobal, RnQDialogs, RnQLangs, RnQCrypt, RQLog, ICQSession, ICQConsts, Nodes;
var
FloatFormat: TFormatSettings;
procedure TSQLDatabase.ContainsFunc(AFunc: TSQLiteFunctionInstance; AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
var
CaseSensitive: Boolean;
@ -2566,6 +2569,10 @@ begin
end;
function TSQLDatabase.RecordToPrefElement(var qry: TFDQuery): TPrefElementRec;
var
StrVal: String;
FloatVal: Double;
DateTimeVal: TDateTime;
begin
Result.Key := qry.FieldByName('Key').AsString;
Result.Element := TPrefElement.Create;
@ -2579,12 +2586,25 @@ begin
else if Result.Element.ElType = ET_Blob64 then
Result.Element.elem.rVal := Base64DecodeString(qry.FieldByName('Value').AsAnsiString)
else if Result.Element.ElType = ET_Double then
Result.Element.elem.dVal := qry.FieldByName('Value').AsFloat
else if Result.Element.ElType = ET_Date then
Result.Element.elem.tVal := qry.FieldByName('Value').AsDateTime
else if Result.Element.ElType = ET_Time then
Result.Element.elem.dtVal := qry.FieldByName('Value').AsDateTime
else if Result.Element.ElType = ET_Bool then
begin
StrVal := qry.FieldByName('Value').AsString;
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
Result.Element.elem.dVal := FloatVal;
end else if Result.Element.ElType = ET_Date then
begin
StrVal := qry.FieldByName('Value').AsString;
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
Result.Element.elem.tVal := FloatVal
else if TryStrToDateTime(StrVal, DateTimeVal) then
Result.Element.elem.tVal := DateTimeVal
end else if Result.Element.ElType = ET_Time then
begin
StrVal := qry.FieldByName('Value').AsString;
if TryStrToFloat(StrVal, FloatVal, FloatFormat) then
Result.Element.elem.dtVal := FloatVal
else if TryStrToDateTime(StrVal, DateTimeVal) then
Result.Element.elem.dtVal := DateTimeVal
end else if Result.Element.ElType = ET_Bool then
Result.Element.elem.yVal := qry.FieldByName('Value').AsBoolean
else
OutputDebugString(PChar(Result.Key + ': ' + IntToStr(Integer(Result.Element.ElType))));
@ -2640,11 +2660,11 @@ begin
else if el.ElType = ET_Blob64 then
qry.ParamByName('val').AsAnsiStrings[I] := Base64EncodeString(el.elem.rVal)
else if el.ElType = ET_Double then
qry.ParamByName('val').AsFloats[I] := el.elem.dVal
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.dVal, FloatFormat)
else if el.ElType = ET_Date then
qry.ParamByName('val').AsDates[I] := el.elem.tVal
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.tVal, FloatFormat)
else if el.ElType = ET_Time then
qry.ParamByName('val').AsDateTimes[I] := el.elem.dtVal
qry.ParamByName('val').AsStrings[I] := FloatToStr(el.elem.dtVal, FloatFormat)
else if el.ElType = ET_Bool then
qry.ParamByName('val').AsBooleans[I] := el.elem.yVal
else
@ -2667,6 +2687,9 @@ initialization
FFDGUIxSilentMode := True;
FFDGUIxProvider := 'Console';
FloatFormat := TFormatSettings.Create(LOCALE_USER_DEFAULT);
FloatFormat.DecimalSeparator := '.';
sqldrv := TFDPhysSQLiteDriverLink.Create(nil);
sqldrv.EngineLinkage := slStatic;
// sqldrv.VendorHome := ModulesPath;


+ 0
- 3
RnQ/SciterLib.pas View File

@ -1422,9 +1422,6 @@ begin
// Do not repaint under child windows (plugin tabs)
SetWindowLongPtr(Chat.Window, GWL_STYLE, GetWindowLongPtr(Chat.Window, GWL_STYLE) or WS_CLIPCHILDREN);
UploadCallbacks.OnBeforeHeaderSend := Chat.OnBeforeHeaderSend;
UploadCallbacks.OnSendData := Chat.OnSendData;
end;
procedure TUI.CreateLog;


+ 1
- 4
RnQ/aboutDlg.pas View File

@ -24,8 +24,7 @@ type
implementation
uses
SciterLib, globalLib, RQUtil, RnQLangs, RnQGlobal, CLBox,
SynCommons, OverbyteIcsSSLEAY;
SciterLib, globalLib, RQUtil, RnQLangs, RnQGlobal, CLBox, SynCommons;
procedure GetAboutInfo(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
@ -37,9 +36,7 @@ begin
{$ENDIF CPUX64}
AboutInfo.build := GetTranslation('Built at') + ' ' + DateTimeToStr(builtTime) + ' [Mikanoshi]';
AboutInfo.sciterver := GetLibVersion(SCITER_DLL_DIR + 'sciter.dll');
AboutInfo.opensslver := GetLibVersion(GSSL_DLL_DIR + GSSLEAY_110DLL_Name);
AboutInfo.bassver := GetLibVersion(modulesPath + 'bass.dll');
AboutInfo.icsver := IntToStr(IcsSSLEAYVersion);
AboutInfo.synopsever := SYNOPSE_FRAMEWORK_VERSION;
V2S(UI.RecordToVar(AboutInfo), retval);
end;


+ 1
- 1
RnQ/globalLib.pas View File

@ -19,7 +19,7 @@ uses
const
RQversion: Longword = $000A01FF; // remember: it's hex
RnQBuild = 1130;
RnQBuildCustom = 81;
RnQBuildCustom = 82;
DevMode = {$IFDEF DEBUG}True{$ELSE}False{$ENDIF};
PIC_CLIENT_LOGO = TPicName('rnq');


BIN
RnQ/images.res View File


+ 4
- 6
RnQ/iniLib.pas View File

@ -48,7 +48,6 @@ uses
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF UNICODE}
OverbyteIcsSSLEAY,
Protocols_All, Protocol_ICQ,
ICQContacts, ICQConsts, ICQSession,
SpellCheck, HiddenForm, CLBox;
@ -912,10 +911,10 @@ begin
pp.getPrefStr('proxy-host', MainProxy.addr.host);
pp.getPrefInt('proxy-port', MainProxy.addr.port);
if pp.getPrefBoolDef('proxy-ver5', True) then
MainProxy.proto := PP_SOCKS5
else
MainProxy.proto := PP_SOCKS4;
// if pp.getPrefBoolDef('proxy-ver5', True) then
// MainProxy.proto := PP_SOCKS5
// else
// MainProxy.proto := PP_SOCKS4;
if not pp.getPrefBoolDef('proxy', False) then
MainProxy.proto := PP_NONE;
pp.getPrefStr('proxy-name', MainProxy.name);
@ -1956,7 +1955,6 @@ initialization
cacheDir := ExtractFilePath(paramStr(0)) + 'Cache\';
ForceDirectories(cacheDir);
imgCacheInfo := TMemIniFile.Create(cacheDir + 'Images.ini');
GSSL_DLL_DIR := ModulesPath;
SCITER_DLL_DIR := ModulesPath;
// SCITER_DLL_SKIP_FREE := True;


+ 1
- 1
RnQ/pluginLib.pas View File

@ -12,7 +12,7 @@ unit pluginLib;
interface
uses
Windows, Graphics, Classes, Controls, Types, StrUtils, SysUtils, RnQBinutils,
Windows, Graphics, Classes, Controls, Types, StrUtils, SysUtils,
events, RDGlobal, ICQCommon, ICQContacts, ICQConsts, ExtCtrls, RnQGraphics32, GR32;
{$I NoRTTI.inc}


+ 1
- 5
RnQ/prefSheet.pas View File

@ -1464,12 +1464,8 @@ end;
procedure TestTips(tag: Pointer; argc: UINT; argv: PSciterValue; retval: PSciterValue); cdecl;
var
e: Thevent;
i: Integer;
s: AnsiString;
begin
i := EK_msg;
s := '';
e := Thevent.new(i, nil, Account.AccProto.GetMyInfo, Now, s + GetTranslation('Testing') + CRLF + 'Second row ------- :)', [], 0);
e := Thevent.new(EK_msg, nil, Account.AccProto.GetMyInfo, Now, GetTranslation('Testing') + CRLF + 'Second row ------- :)', [], 0);
//e := SQLDB.GetByMsgID('230490', 6829340988138324771, False);
UI.Tips.Add(e);
e.Free;


+ 18
- 20
RnQ/utilLib.pas View File

@ -179,6 +179,7 @@ type
procedure ProcessICQLink(Data: String);
function AvatarUsePalette10: Boolean;
function IsTen: Boolean;
function IsEightOne: Boolean;
function IsElevated: Boolean;
function GetActiveMonitorCount: Integer;
procedure CloseAllChildWindows;
@ -297,20 +298,13 @@ uses
Base64, RQUtil, RDFileUtil, RDUtils, RnQSysUtils,
RQThemes, RQLog, RnQdbDlg, RnQDialogs,
RnQLangs, RnQBinUtils, RnQGlobal, RnQCrypt, RnQPics,
RnQTrayLib, RnQTips, Hook,
prefSheet, RnQPrefsLib,
RnQTrayLib, RnQTips, Hook, RnQPrefsLib, prefSheet,
mainDlg, roasterLib, iniLib, pluginutil,
selectContactsDlg, incapsulate,
pluginLib, authreqDlg,
langLib, groupsLib, outboxDlg, viewinfoDlg, // msgsDlg,
history,
RnQMacros, RnQ_Avatars,
usersDlg, ThemesLib, RnQStrings,
Protocols_All, Protocol_ICQ, // ICQClients,
RnQGraphics32, Stickers, Nodes, SQLiteDB, HiddenForm,
// AsyncCalls,
HistAllSearch, SynCrypto;
selectContactsDlg, incapsulate, pluginLib, authreqDlg,
langLib, groupsLib, outboxDlg, viewinfoDlg, history,
RnQMacros, RnQ_Avatars, RnQStrings, ThemesLib, usersDlg,
Protocols_All, Protocol_ICQ,
RnQGraphics32, Stickers, Nodes, SQLiteDB, HiddenForm, HistAllSearch;
var
SaveActions: TArray<TActionKind> = [AK_SAVEALL, AK_SAVECONFIG, AK_SAVEDB, AK_SAVEGROUPS, AK_SAVEUINLISTS, AK_SAVEINBOX, AK_SAVEOUTBOX, AK_SAVEXSTATUSES];
@ -520,13 +514,13 @@ begin
end
else if length(AllProxies) > 0 then
begin
if h = 'proxy-ver5' then
if yesno then
AllProxies[i].proto := PP_SOCKS5
else
AllProxies[i].proto := PP_SOCKS4
// if h = 'proxy-ver5' then
// if yesno then
// AllProxies[i].proto := PP_SOCKS5
// else
// AllProxies[i].proto := PP_SOCKS4
// else if h='proxy' then pProxys[i].enabled:=yesno
else if h = 'proxy-auth' then
if h = 'proxy-auth' then
AllProxies[i].auth := yesno
else if h = 'proxy-user' then
AllProxies[i].user := UnUTF(l)
@ -3059,6 +3053,11 @@ begin
Result := TOSVersion.Check(10)
end;
function IsEightOne: Boolean;
begin
Result := TOSVersion.Check(8, 1)
end;
function AvatarUsePalette10: Boolean;
begin
Result := AvatarUsePalette and IsTen;
@ -3234,7 +3233,6 @@ var
OE: TOEvent;
ReExecuteIn, Index: Integer;
SkipAction: Boolean;
IsSSRuning: BOOL;
begin
ReExecuteIn := 0;


+ 1
- 1
for.RnQ/RQUtil.pas View File

@ -67,7 +67,7 @@ uses
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF UNICODE}
RnQBinUtils, RDUtils, RnQGlobal,
RDUtils, RnQGlobal,
RDFileUtil,
{$IFDEF RNQ}
dynamic_bass,


+ 1
- 2
for.RnQ/RTL/RDUtils.pas View File

@ -149,11 +149,10 @@ var
implementation
uses
StrUtils, Math,
{$IFDEF UNICODE}
Character,
{$ENDIF UNICODE}
RnQBinUtils;
StrUtils, Math;
class function THelpers.IfThen<T>(AValue: Boolean; TrueVal, FalseVal: T): T;
begin


+ 76
- 991
for.RnQ/RTL/RnQBinUtils.pas View File

@ -4,122 +4,27 @@
}
unit RnQBinUtils;
{$I ForRnQConfig.inc}
{ $INLINE ON }
interface
uses
sysutils, types, RDGlobal;
SysUtils, Types, RDGlobal;
{$I NoRTTI.inc}
function dword_LE2ip(d: dword): AnsiString;
{$IFDEF UNICODE}
function dword_LE2ipU(d: dword): UnicodeString;
{$ENDIF UNICODE}
// function invert(d:integer):integer; OverLoad;
// function invert64(const d:int64):int64; OverLoad; inline;
// function BSwapInt(Value: LongWord): LongWord; assembler; register;
// procedure SwapShort(const P: PWord; const Count: Cardinal);
// procedure SwapLong(P: PInteger; Count: Cardinal);
// function SwapLong(Value: Cardinal): Cardinal; overload;
function incPtr(p: pointer; d: integer): pointer; inline;
function findTLV(idx: integer; const s: RawByteString; ofs: integer = 1): integer;
function existsTLV(idx: integer; const s: RawByteString; ofs: integer = 1): boolean; inline;
function deleteTLV(idx: integer; const s: RawByteString; ofs: integer = 1): RawByteString;
// build data
function qword_LEasStr(d: int64): RawByteString;
function qword_BEasStr(d: int64): RawByteString;
function dword_LEasStr(d: dword): RawByteString;
function dword_BEasStr(d: dword): RawByteString;
function word_BEasStr(w: word): RawByteString; inline;
function word_LEasStr(w: word): RawByteString; inline;
function TLV(t: word; v: dword): RawByteString; overload;
function TLV(t: word; v: word): RawByteString; overload;
function TLV(t: word; v: integer): RawByteString; overload;
function TLV(t: word; v: int64): RawByteString; overload;
function TLV(t: word; const v: RawByteString): RawByteString; overload;
function TLV_LE(t: word; const v: RawByteString): RawByteString;
function TLV2(code: integer; const data: RawByteString): RawByteString; overload;
function TLV2(code: integer; const data: TDateTime): RawByteString; overload;
function TLV2(code: integer; const data: integer): RawByteString; overload;
function TLV2(code: integer; const data: boolean): RawByteString; overload;
function TLV2_IFNN(code: integer; const data: RawByteString): RawByteString; overload; // if data not null
function TLV2_IFNN(code: integer; const data: TDateTime): RawByteString; overload; // if data not null
function TLV2_IFNN(code: integer; data: integer): RawByteString; overload; // if data not null
function TLV2U_IFNN(code: integer; const str: String): RawByteString; // overload; // if data not null. Unicode String
function TLV3(code: integer; const data: RawByteString): RawByteString;
function TLV3U(code: integer; const str: UnicodeString): RawByteString;
function Length_LE(const data: RawByteString): RawByteString;
function Length_BE(const data: RawByteString): RawByteString;
function Length_DLE(const data: RawByteString): RawByteString;
function Length_B(const data: RawByteString): RawByteString;
function WNTS(const s: RawByteString): RawByteString;
function WNTSU(const s: String): RawByteString;
// read data
function Qword_LEat(p: pointer): int64; inline; // inline;
function Qword_BEat(p: pointer): int64; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_BEat(const s: RawByteString; ofs: integer): integer; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_BEat(p: pointer): LongWord; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_LEat(p: Pointer): LongWord; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_LEat(const s: RawByteString; ofs: Integer): Integer; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function word_LEat(p: pointer): word; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function word_BEat(p: pointer): word; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function ptrWNTS(p: pointer): RawByteString;
function word_LEat(const s: RawByteString; ofs: integer): word; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function word_BEat(const s: RawByteString; ofs: integer): word; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
// function word_BEat(s:string; ofs:integer):word; overload;
function readQWORD(const snac: RawByteString; var ofs: integer): int64;
function readWORD(const snac: RawByteString; var ofs: integer): word;
function readBEWORD(const snac: RawByteString; var ofs: integer): word; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function readINT(const snac: RawByteString; var ofs: integer): integer; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function readDWORD(const snac: RawByteString; var ofs: integer): cardinal;
function readBEDWORD(const snac: RawByteString; var ofs: integer): cardinal;
function readBYTE(const snac: RawByteString; var ofs: integer): byte;
// function getBUIN2(const s:RawByteString; var ofs:integer): RawByteString;
// function getBUIN(const s:RawByteString; var ofs:integer): Integer;
function getDLS(const s: RawByteString; var ofs: integer): RawByteString;
function getWNTS(const s: RawByteString; var ofs: integer): RawByteString;
function getBEWNTS(const s: RawByteString; var ofs: integer): RawByteString;
function getTLV(p: pointer): RawByteString; overload;
function getTLVwordBE(p: pointer): word; overload;
function getTLVdwordBE(p: pointer): dword; overload;
function getTLV(const s: RawByteString; ofs: integer=1): RawByteString; INLINE; overload;
function getTLVwordBE(const s: RawByteString; ofs: integer=1): word; INLINE; overload;
function getTLVdwordBE(const s: RawByteString; ofs: integer=1): dword; INLINE; overload;
function TLV2(code: integer; const data: RawByteString): RawByteString; overload;
function TLV2(code: integer; const data: TDateTime): RawByteString; overload;
function TLV2(code: integer; const data: integer): RawByteString; overload;
function TLV2(code: integer; const data: boolean): RawByteString; overload;
function getTLV(idx: integer; const s: RawByteString; ofs: integer = 1): RawByteString; overload;
function getTLVwordBE(idx: integer; const s: RawByteString; ofs: integer = 1): word; overload;
function getTLVdwordBE(idx: integer; const s: RawByteString; ofs: integer = 1): dword; overload;
function getTLVqwordBE(idx: integer; const s: RawByteString; ofs: integer = 1): int64;
function dword_LEat(p: Pointer): LongWord; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_LEat(const s: RawByteString; ofs: Integer): Integer; overload; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function getTLVSafe(idx: integer; const s: RawByteString; ofs: integer = 1): RawByteString;
function getTLVSafeDelete(idx: integer; var s: RawByteString; ofs: integer = 1): RawByteString;
function replaceAddTLV(idx: integer; const s: RawByteString; ofs: integer = 1; const NewTLV: RawByteString = ''): RawByteString;
function int2str(i: integer): RawByteString;
function dt2str(dt: TDateTime): RawByteString;
// ----------------------------
function findTLV3(const idx: integer; const s: RawByteString; ofs: integer): integer;
function getTLV3Safe(const idx: integer; const s: RawByteString; const ofs: integer): RawByteString;
function getTLV3dwordBE(p: pointer): dword;
function getTLV3wordBE(p: pointer): dword;
function getwTLD(const s: RawByteString; var ofs: integer): RawByteString;
function getwTLD_DWORD(const s: RawByteString; var ofs: integer): LongWord;
/// //----------------------------
function int2str(i: integer): RawByteString;
function int2str64(i: int64): RawByteString;
function dt2str(dt: TDateTime): RawByteString;
function str2int(const s: RawByteString): integer; overload;
function str2int(p: pointer): integer; overload; inline;
function str2int(const s: RawByteString): integer; overload;
function str2int(p: pointer): integer; overload; inline;
implementation
@ -127,927 +32,107 @@ uses
{$IFDEF UNICODE}
AnsiStrings,
{$ENDIF UNICODE}
{$IFNDEF FPC}
OverbyteIcsUtils,
{$ENDIF ~FPC}
Windows,
RDUtils;
{$IFDEF Linux}
// Äëÿ Lazarus
// Function Swap (X : Integer) : Integer;{$ifdef SYSTEMINLINE}inline;{$endif}
Function Swap(X: word): word; {$IFDEF SYSTEMINLINE}inline; {$ENDIF}
Begin
{ the extra 'and $ff' in the right term is necessary because the }
{ 'X shr 8' is turned into "longint(X) shr 8", so if x < 0 then }
{ the sign bits from the upper 16 bits are shifted in rather than }
{ zeroes. Another bug for TP/Delphi compatibility... }
Swap := (X and $FF) shl 8 + ((X shr 8) and $FF)
End;
{$ENDIF Linux}
{$IFDEF FPC}
// From ICS!
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
function IcsSwap32(Value: LongWord): LongWord;
{$IFDEF PUREPASCAL}
begin
Result := word(((Value shr 16) shr 8) or ((Value shr 16) shl 8)) or word((word(Value) shr 8) or (word(Value) shl 8)) shl 16;
{$ELSE}
asm
{$IFDEF CPUX64}
MOV EAX, ECX
{$ENDIF}
BSWAP EAX
{$ENDIF}
end;
Windows, RDUtils;
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
function IcsSwap64(Value: int64): int64;
{$IFDEF PUREPASCAL}
function Int2Str(I: Integer): RawByteString;
var
H, L: LongWord;
begin
H := LongWord(Value shr 32);
L := LongWord(Value);
H := word(((H shr 16) shr 8) or ((H shr 16) shl 8)) or word((word(H) shr 8) or (word(H) shl 8)) shl 16;
L := word(((L shr 16) shr 8) or ((L shr 16) shl 8)) or word((word(L) shr 8) or (word(L) shl 8)) shl 16;
Result := int64(H) or int64(L) shl 32;
{$ELSE}
asm
{$IFDEF CPUX64}
MOV RAX, RCX
BSWAP RAX
{$ELSE}
MOV EDX, [EBP + $08]
MOV EAX, [EBP + $0C]
BSWAP EAX
BSWAP EDX
{$ENDIF}
{$ENDIF}
end;
{$ENDIF FPC}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{ function invert(d:integer):integer; assembler; register;
//begin
// result:=swap(d shr 16)+swap(d) shl 16
asm
BSWAP EAX
end; }
{
function BSwapInt(Value: LongWord): LongWord; assembler; register;
asm
BSWAP EAX
end;
function invert64(const d:int64):int64;
//var
// i : Int64Rec
begin
Int64Rec(result).Words[0] := Swap(Int64Rec(d).Words[3]);
Int64Rec(result).Words[1] := Swap(Int64Rec(d).Words[2]);
Int64Rec(result).Words[2] := Swap(Int64Rec(d).Words[1]);
Int64Rec(result).Words[3] := Swap(Int64Rec(d).Words[0]);
// result := swap(Word(d shr 48)) + swap(Word(d shr 32)) shl 16 +
// swap(word(d shr 16)) shl 32 + swap(word( d)) shl 48;
end;
}
{
Here's another one that uses the SSSE3 instruction PSHUFB:
function Swap(const X: Int64): Int64;
const
SHUFIDX: array [0..1] of Int64 = ($0001020304050607, 0);
asm
MOVQ XMM0,[X]
PSHUFB XMM0,SHUFIDX
MOVQ [Result],XMM0
end;
}
{ procedure SwapShort(const P: PWord; const Count: Cardinal);
asm
@@Loop:
MOV CX, [EAX]
XCHG CH, CL
MOV [EAX], CX
ADD EAX, 2
DEC EDX
JNZ @@Loop
end;
procedure SwapLong(P: PInteger; Count: Cardinal); overload;
asm
@@Loop:
MOV ECX, [EAX]
BSWAPl ECX
MOV [EAX], ECX
ADD EAX, 4
DEC EDX
JNZ @@Loop
end;
}
function int2str(i: integer): RawByteString;
var
v: RawByteString;
begin
setLength(v, 4);
move(i, pointer(v)^, 4);
Result := v;
end;
function incPtr(p: pointer; d: integer): pointer; inline;
V: RawByteString;
begin
Result := pointer(PtrInt(p) + d)
SetLength(V, 4);
Move(I, pointer(V)^, 4);
Result := V;
end;
function Qword_LEat(p: pointer): int64; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_LEat(P: Pointer): LongWord; overLoad; {$IFDEF HAS_INLINE}inline;{$ENDIF HAS_INLINE}
begin
Result := int64(p^)
Result := LongWord(P^)
end;
function Qword_BEat(p: pointer): int64; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
function dword_LEat(const S: RawByteString; Ofs: Integer): Integer; {$IFDEF HAS_INLINE}inline;{$ENDIF HAS_INLINE}
begin
// result:=invert64(int64(p^))
Result := IcsSwap64(int64(p^))
Result := Int32((@S[Ofs])^)
end;
function dword_BEat(p: pointer): LongWord; overLoad; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
// result:= BSwapInt(integer(p^))
Result := IcsSwap32(LongWord(p^))
end;
function dword_BEat(const s: RawByteString; ofs: integer): integer; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := dword_BEat(@s[ofs])
end;
function dword_LEat(p: pointer): LongWord; overLoad; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := LongWord(p^)
end;
function dword_LEat(const s: RawByteString; ofs: Integer): Integer; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := int32((@s[ofs])^)
end;
function word_LEat(const s: RawByteString; ofs: integer): word; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
result := word_LEat(@s[ofs])
end;
function word_LEat(p: pointer): word; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := word(p^)
end;
function word_BEat(p: pointer): word; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := Swap(word(p^))
end;
function word_BEat(const s: RawByteString; ofs: integer): word; {$IFDEF HAS_INLINE}inline; {$ENDIF HAS_INLINE}
begin
Result := word_BEat(@s[ofs])
end;
function ptrWNTS(p: pointer): RawByteString;
function TLV2(Code: Integer; const Data: RawByteString): RawByteString;
var
v: RawByteString;
S: RawByteString;
Ps: Pointer;
I: Integer;
begin
setLength(v, word(p^) - 1);
move(incPtr(p, 2)^, pointer(v)^, length(v));
Result := v;
end; // ptrWNTS
{
function getBUIN2(const s:RawByteString; var ofs:integer): RawByteString;
begin
//result:=strToInt(copy(s,ofs+1,ord(s[ofs])));
result:= copy(s,ofs+1,ord(s[ofs]));
inc(ofs, 1+ord(s[ofs]));
end; // getBUIN
function getBUIN(const s:RawByteString; var ofs:integer): Integer;
var
E: Integer;
// ss : AnsiString;
ss : String;
begin
// result:=strToInt(ss);
ss := copy(s, ofs+1, byte(s[ofs]));
Val(ss, Result, E);
if e <> 0 then
Result := 0;
//result:= copy(s,ofs+1,ord(s[ofs]));
inc(ofs, 1+ byte(s[ofs]));
end; // getBUIN
}
function getWNTS(const s: RawByteString; var ofs: integer): RawByteString;
var
i: integer;
begin
i := word((@s[ofs])^);
Result := copy(s, ofs + 2, i - 1);
inc(ofs, 2 + i);
end; // getWNTS
function getBEWNTS(const s: RawByteString; var ofs: integer): RawByteString;
var
i: integer;
begin
i := Swap(word((@s[ofs])^));
Result := copy(s, ofs + 2, i);
inc(ofs, 2 + i);
end; // getBEWNTS
function getDLS(const s: RawByteString; var ofs: integer): RawByteString;
var
i: integer;
begin
i := integer((@s[ofs])^);
if i > 100 * 1024 then
Result := ''
else
begin
Result := copy(s, ofs + 4, i);
inc(ofs, 4 + i);
end;
end; // getDLS
function existsTLV(idx: integer; const s: RawByteString; ofs: integer): boolean;
begin
Result := findTLV(idx, s, ofs) > 0
end;
function findTLV(idx: integer; const s: RawByteString; ofs: integer): integer;
var
L: integer;
begin
Result := -1;
{
l := length(s);
if (l >= 4)and(ofs < l) then
// if l > 2 then
begin
while word_BEat(@s[ofs])<>idx do
begin
inc(ofs, word_BEat(@s[ofs+2])+4);
if ofs >= l then
exit;
end;
result:=ofs;
end; }
L := length(s) - 2;
if (L >= 2) and (ofs < L) then
// if l > 2 then
begin
while word_BEat(@s[ofs]) <> idx do
begin
inc(ofs, word_BEat(@s[ofs + 2]) + 4);
if ofs >= L then
exit;
end;
Result := ofs;
end;
end; // findTLV
function deleteTLV(idx: integer; const s: RawByteString; ofs: integer = 1): RawByteString;
var
i, L: integer;
begin
i := findTLV(idx, s, ofs);