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.
1028 lines
33 KiB
Plaintext
1028 lines
33 KiB
Plaintext
unit RnQNet;
|
|
{$I forRnQConfig.inc}
|
|
{ $I RnQConfig.inc }
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Generics.Collections, Classes, Forms, JSON, NetEncoding, OverbyteIcsHttpProt, OverbyteIcsWSocket,
|
|
RDGlobal, RnQGlobal;
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
type
|
|
TProxyProto = (PP_NONE = 0, PP_SOCKS4 = 1, PP_SOCKS5 = 2, PP_HTTPS = 3);
|
|
|
|
THostPort = record
|
|
host: String;
|
|
port: Integer;
|
|
end;
|
|
|
|
PProxy = ^TProxy;
|
|
TProxy = record
|
|
name: String;
|
|
user: String;
|
|
pwd: String;
|
|
auth: Boolean;
|
|
NTLM: Boolean;
|
|
proto: TProxyProto;
|
|
addr: THostPort;
|
|
end;
|
|
|
|
TLinkInfo = record
|
|
code: Integer;
|
|
size: Int64;
|
|
mime: String;
|
|
redirects: Integer;
|
|
end;
|
|
|
|
TICQFileInfo = record
|
|
jsonlink: String;
|
|
dlink: String;
|
|
mime: String;
|
|
filename: String;
|
|
is_previewable: Boolean;
|
|
preview: String;
|
|
avstatus: String;
|
|
filesize: Int64;
|
|
end;
|
|
|
|
TProxies = TArray |
|
|
|
const
|
|
ProxyProto2Str: array [TProxyProto] of String = ('NONE', 'SOCKS4', 'SOCKS5', 'HTTP/S');
|
|
|
|
procedure CopyProxy(var pTo: Tproxy; const pFrom: Tproxy);
|
|
procedure ClearProxy(var p1: Tproxy);
|
|
procedure CopyProxyArr(var pATo: TProxies; const pAFrom: TProxies);
|
|
procedure ClearProxyArr(var pa: TProxies);
|
|
|
|
type
|
|
TDataReceived = procedure(Sender: TObject; ErrCode: Word; pkt: RawByteString) of object;
|
|
TProxyLogData = procedure(Sender: TObject; isReceive: boolean; Data: RawByteString) of object;
|
|
(*
|
|
TRnQSocket = class(TSslWSocket)
|
|
private
|
|
FSocksConnected: boolean;
|
|
FOldOnSessionConnected: TSessionConnected;
|
|
FOldOnDataAvailable: TDataAvailable;
|
|
FServerAddr: String;
|
|
FServerPort: AnsiString;
|
|
FMyBeautifulSocketBuffer: RawByteString;
|
|
FOnDataReceived: TDataReceived;
|
|
FOnProxyTalk: TProxyLogData;
|
|
|
|
procedure myOnConnected(Sender: TObject; Error: Word);
|
|
procedure myOnReceived(Sender: TObject; Error: Word);
|
|
procedure ClientConnected(Sender: TObject; Error: Word);
|
|
procedure ClientConnected2(Sender: TObject; Error: Word);
|
|
public
|
|
fAccIDX: Integer;
|
|
isSSL: boolean;
|
|
procedure StartTLS;
|
|
protected
|
|
SslCtxt: TSslContext;
|
|
procedure SockSslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: boolean);
|
|
procedure TriggerSessionClosed(Error: Word); override;
|
|
function GetAddr1: String;
|
|
function GetAddr2: String;
|
|
procedure TriggerProxyData(isReceive: boolean; Data: RawByteString);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Connect; override;
|
|
procedure Close; override;
|
|
// procedure CloseDelayed; override;
|
|
|
|
procedure DisableProxy();
|
|
procedure getFreePort;
|
|
|
|
// function RealSend(Data : Pointer; Len : Integer) : Integer; override;
|
|
// function RealSend(var Data : TWSocketData; Len : Integer) : Integer; override;
|
|
// function Send(Data: Pointer; Len: Integer): Integer; override;
|
|
// function Send(const Data : TWSocketData; Len : Integer) : Integer; override;
|
|
|
|
// function SendStr(const Str : String) : Integer; override;
|
|
// function Receive(Buffer: Pointer; BufferSize: Integer): Integer; override;
|
|
// function Receive(Buffer : TWSocketData; BufferSize: Integer) : Integer; {overload; } override;
|
|
// function ReceiveStr: string; override;
|
|
property addr: String read GetAddr1 write SetAddr;
|
|
property AddrPort: String read GetAddr2;
|
|
property OnDataReceived: TDataReceived read FOnDataReceived write FOnDataReceived;
|
|
property OnProxyTalk: TProxyLogData read FOnProxyTalk write FOnProxyTalk;
|
|
end;
|
|
*)
|
|
TCallbacks = class
|
|
private
|
|
FOnBeforeHeaderSend: TBeforeHeaderSendEvent;
|
|
FOnSendData: TDocDataEvent;
|
|
FOnRequestDone: THttpRequestDone;
|
|
FOnHeaderEnd: TNotifyEvent;
|
|
FOnDocData: TDocDataEvent;
|
|
public
|
|
Data: Pointer;
|
|
property OnBeforeHeaderSend: TBeforeHeaderSendEvent read FOnBeforeHeaderSend write FOnBeforeHeaderSend;
|
|
property OnSendData: TDocDataEvent read FOnSendData write FOnSendData;
|
|
property OnRequestDone: THttpRequestDone read FOnRequestDone write FOnRequestDone;
|
|
property OnHeaderEnd: TNotifyEvent read FOnHeaderEnd write FOnHeaderEnd;
|
|
end;
|
|
|
|
const
|
|
ConnectionError = 'Connection error\n%s\n[%d] %s';
|
|
SSLError = 'OpenSSL libs are not found\n%s';
|
|
FileTooBig = 'File is too big, max size %s MB';
|
|
AuthFailed = 'File hosting authentication failed';
|
|
InitFailed = 'Failed to get upload link from ICQ server';
|
|
UploadError = 'Failed to upload file! Server response';
|
|
|
|
ImageContentTypes: array [0 .. 25] of string = (
|
|
'image/bmp', 'image/x-bmp', 'image/x-bitmap', 'image/x-xbitmap', 'image/x-win-bitmap', 'image/x-windows-bmp', 'image/ms-bmp', 'image/x-ms-bmp', 'application/bmp', 'application/x-bmp', 'application/x-win-bitmap',
|
|
'image/jpeg', 'image/jpg', 'application/jpg', 'application/x-jpg',
|
|
'image/gif',
|
|
'image/png', 'application/png', 'application/x-png',
|
|
'image/ico', 'image/x-icon', 'application/ico', 'application/x-ico',
|
|
'image/tiff', 'image/x-tiff',
|
|
'image/webp'
|
|
);
|
|
ImageExtensions: array [0 .. 25] of string = (
|
|
'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp', 'bmp',
|
|
'jpg', 'jpg', 'jpg', 'jpg',
|
|
'gif',
|
|
'png', 'png', 'png',
|
|
'ico', 'ico', 'ico', 'ico',
|
|
'tiff', 'tiff',
|
|
'webp'
|
|
);
|
|
function HeaderFromURL(const URL: String): String;
|
|
function InfoFromURL(const URL: String; Callbacks: TCallbacks): TLinkInfo;
|
|
function UploadFileICQ(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
function UploadFileRGhost(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
function UploadFileMikanoshi(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
function UploadFileRnQ(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
function CreateZip(str: TStringList): TMemoryStream;
|
|
function GetICQFileLinkInfo(const lnk: String): TICQFileInfo;
|
|
function CheckType(const lnk: String): Boolean; overload;
|
|
function CheckType(const lnk: String; var sA: RawByteString; var ext: String): Boolean; overload;
|
|
function DownloadAndCache(const lnk: String): Boolean;
|
|
|
|
procedure SetupProxy(var httpCli: TSslHttpCli);
|
|
procedure HandleError(E: EHttpException; const URL: String; const ErrText: String = ''; Quiet: Boolean = True);
|
|
|
|
function DecodeURL(const url: String): String;
|
|
function LoadFromURL(const URL: String; var fn: String; var fs: TMemoryStream; Threshold: LongInt = 0;
|
|
ExtByContent: Boolean = False; const POSTData: RawByteString = ''; ShowErrors: Boolean = true;
|
|
OutputAsStr: Boolean = False): Boolean; overload;
|
|
function LoadFromURL(const URL: String; var fn: String; Threshold: LongInt = 0; ExtByContent: Boolean = False;
|
|
const POSTData: RawByteString = ''; ShowErrors: Boolean = true): Boolean; overload;
|
|
function LoadFromURL(const URL: String; var fs: TMemoryStream; Threshold: LongInt = 0; ExtByContent: Boolean = False;
|
|
const POSTData: RawByteString = ''; ShowErrors: Boolean = true): Boolean; overload;
|
|
function LoadFromURLAsString(const URL: String; var str: String; const POSTData: RawByteString = ''): Boolean;
|
|
|
|
function LoadFromURLAsync(const URL: String; Callback: THttpRequestDone = nil; Data: Pointer = nil;
|
|
const POSTData: RawByteString = ''; ShowErrors: Boolean = True): Boolean;
|
|
var
|
|
MainProxy: TProxy;
|
|
AllProxies: TProxies;
|
|
IsUploading: Boolean;
|
|
UploadSize: Int64;
|
|
UploadedSize: Int64;
|
|
SslCtx: TSslContext;
|
|
|
|
EnableVideoLinks: Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, Base64, SysUtils, StrUtils, System.Threading,
|
|
RDUtils, RnQPrefsLib, RnQZip,
|
|
{$IFDEF UNICODE}
|
|
AnsiStrings,
|
|
{$ENDIF UNICODE}
|
|
// OverbyteIcsLogger,
|
|
{$IFDEF RNQ}
|
|
RnQLangs, RnQDialogs, RQUtil, utilLib, ICQContacts, ICQSession, globalLib,
|
|
{$ENDIF RNQ}
|
|
{$IFDEF RNQ_PLUGIN}
|
|
RDPlugins,
|
|
{$ENDIF RNQ_PLUGIN}
|
|
RnQGraphics32;
|
|
|
|
Procedure CopyProxy(var pTo: Tproxy; const pFrom: Tproxy);
|
|
begin
|
|
// p1.enabled:= p2.enabled;
|
|
pTo.name := pFrom.name;
|
|
pTo.proto := pFrom.proto;
|
|
{ for pp:=low(pp) to high(pp) do
|
|
begin
|
|
proxy.addr[pp].host:=proxyes[lastProxy].addr[pp].host;
|
|
proxy.addr[pp].port:=proxyes[lastProxy].addr[pp].port;
|
|
end; }
|
|
pTo.addr.host := pFrom.addr.host;
|
|
pTo.addr.port := pFrom.addr.port;
|
|
pTo.user := pFrom.user;
|
|
pTo.pwd := pFrom.pwd;
|
|
pTo.auth := pFrom.auth;
|
|
pTo.NTLM := pFrom.NTLM;
|
|
end;
|
|
|
|
Procedure ClearProxy(var p1: Tproxy);
|
|
begin
|
|
p1.name := '';
|
|
p1.proto := PP_NONE;
|
|
{ for pp:=low(pp) to high(pp) do
|
|
begin
|
|
proxy.addr[pp].host:=proxyes[lastProxy].addr[pp].host;
|
|
proxy.addr[pp].port:=proxyes[lastProxy].addr[pp].port;
|
|
end; }
|
|
p1.addr.host := '';
|
|
p1.user := '';
|
|
p1.pwd := '';
|
|
end;
|
|
|
|
Procedure CopyProxyArr(var pATo: TProxies; const pAFrom: TProxies);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
ClearProxyArr(pATo);
|
|
SetLength(pATo, Length(pAFrom));
|
|
if Length(pAFrom) > 0 then
|
|
for I := Low(pAFrom) to High(pAFrom) do
|
|
// ClearProxy(pa[i]);
|
|
CopyProxy(pATo[I], pAFrom[I]);
|
|
// SetLength(pa, 0);
|
|
end;
|
|
|
|
procedure ClearProxyArr(var pa: TProxies);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Length(pa) > 0 then
|
|
begin
|
|
for I := Low(pa) to High(pa) do
|
|
ClearProxy(pa[I]);
|
|
SetLength(pa, 0);
|
|
end;
|
|
end;
|
|
|
|
function RemoveAnchorFromURL(URL: String): String;
|
|
begin
|
|
if URL.Contains('#') then
|
|
Result := URL.Substring(0, URL.IndexOf('#'))
|
|
else
|
|
Result := URL;
|
|
end;
|
|
|
|
function DecodeURL(const url: String): String;
|
|
begin
|
|
Result := TEncoding.UTF8.GetString(TNetEncoding.URL.DecodeStringToBytes(url));
|
|
end;
|
|
|
|
procedure HandleError(E: EHttpException; const URL: String; const ErrText: String = ''; Quiet: Boolean = True);
|
|
begin
|
|
if Assigned(E) then
|
|
TThread.Synchronize(nil, procedure begin
|
|
if E.ErrorCode = 3 then
|
|
MsgDlg(GetTranslation(SSLError, [E.Message]), False, mtError)
|
|
else if (E.ErrorCode <> 404) or not Quiet then
|
|
begin
|
|
if (E.ErrorCode = 404) and URL.Contains('store_id=') then
|
|
Exit;
|
|
if not (ErrText = '') then
|
|
MsgDlg(GetTranslation(UploadError) + ': ' + #13#10 + ErrText, False, mtError)
|
|
else
|
|
MsgDlg(GetTranslation(ConnectionError, [URL, E.ErrorCode, GetTranslation(E.Message)]), False, mtError);
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
procedure SetupProxy(var httpCli: TSslHttpCli);
|
|
begin
|
|
with httpCli do
|
|
begin
|
|
// Reset SOCKS
|
|
SocksServer := '';
|
|
SocksPort := '';
|
|
SocksAuthentication := socksNoAuthentication;
|
|
SocksUsercode := '';
|
|
SocksPassword := '';
|
|
|
|
// Reset HTTPS
|
|
Proxy := '';
|
|
ProxyPort := '';
|
|
ProxyUsername := '';
|
|
ProxyPassword := '';
|
|
ProxyAuth := OverbyteIcsHttpProt.httpAuthNone;
|
|
|
|
SslContext := SslCtx; // always define in case of a redirect to https
|
|
ProxyConnection := 'keep-alive';
|
|
|
|
if (MainProxy.proto in [PP_SOCKS4, PP_SOCKS5, PP_HTTPS]) then
|
|
case MainProxy.proto of
|
|
PP_SOCKS4, PP_SOCKS5:
|
|
begin
|
|
// sock.socksServer:=proxy.addr[proxy.proto].host;
|
|
// sock.socksPort:=proxy.addr[proxy.proto].port;
|
|
SocksServer := MainProxy.addr.host;
|
|
SocksPort := IntToStr(MainProxy.addr.port);
|
|
|
|
if MainProxy.proto = PP_SOCKS4 then
|
|
SocksLevel := '4'
|
|
else
|
|
SocksLevel := '5';
|
|
|
|
if MainProxy.auth then
|
|
SocksAuthentication := socksAuthenticateUsercode
|
|
else
|
|
SocksAuthentication := socksNoAuthentication;
|
|
|
|
SocksUsercode := MainProxy.user;
|
|
SocksPassword := MainProxy.pwd;
|
|
end;
|
|
PP_HTTPS:
|
|
begin
|
|
Proxy := MainProxy.addr.host;
|
|
ProxyPort := intToStr(MainProxy.addr.port);
|
|
// ProxyConnection - keep-alive?
|
|
if MainProxy.auth then
|
|
begin
|
|
ProxyUsername := MainProxy.user;
|
|
ProxyPassword := MainProxy.pwd;
|
|
if MainProxy.NTLM then
|
|
ProxyAuth := OverbyteIcsHttpProt.httpAuthNtlm
|
|
else
|
|
ProxyAuth := OverbyteIcsHttpProt.httpAuthBasic;
|
|
end else
|
|
ProxyAuth := OverbyteIcsHttpProt.httpAuthNone;
|
|
end
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function LoadFromURLAsString(const URL: String; var str: String; const POSTData: RawByteString = ''): Boolean;
|
|
var
|
|
fs: TMemoryStream;
|
|
begin
|
|
fs := nil;
|
|
str := '';
|
|
Result := LoadFromURL(URL, str, fs, 0, False, POSTData, True, True);
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fn: String; Threshold: LongInt = 0; ExtByContent: Boolean = False;
|
|
const POSTData: RawByteString = ''; ShowErrors: Boolean = True): Boolean;
|
|
var
|
|
fs: TMemoryStream;
|
|
begin
|
|
fs := nil;
|
|
Result := LoadFromURL(URL, fn, fs, Threshold, ExtByContent, POSTData, ShowErrors);
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fs: TMemoryStream; Threshold: LongInt = 0; ExtByContent: Boolean = False;
|
|
const POSTData: RawByteString = ''; ShowErrors: Boolean = True): Boolean;
|
|
var
|
|
fn: String;
|
|
begin
|
|
Result := LoadFromURL(URL, fn, fs, Threshold, ExtByContent, POSTData, ShowErrors);
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fn: String; var fs: TMemoryStream; Threshold: LongInt = 0;
|
|
ExtByContent: Boolean = False; const POSTData: RawByteString = ''; ShowErrors: Boolean = True; OutputAsStr: Boolean = False): Boolean;
|
|
var
|
|
AvStream: TStringStream;
|
|
httpCli: TSslHttpCli;
|
|
ft: TPAFormat;
|
|
begin
|
|
Result := False;
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
try
|
|
httpCli.MultiThreaded := not (GetCurrentThreadID = MainThreadID);
|
|
httpCli.URL := RemoveAnchorFromURL(URL);
|
|
httpCli.FollowRelocation := True;
|
|
httpCli.Connection := 'keep-alive';
|
|
// httpCli.Agent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:73.0) Gecko/20100101 Firefox/72.0';
|
|
SetupProxy(httpCli);
|
|
|
|
AvStream := TStringStream.Create('', TEncoding.UTF8);
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
try
|
|
if Threshold > 0 then
|
|
begin
|
|
httpCli.Head;
|
|
if httpCli.ContentLength > Threshold then
|
|
Exit;
|
|
end;
|
|
|
|
try
|
|
if not (POSTData = '') then
|
|
begin
|
|
httpCli.ContentTypePost := IfThen(POSTData[1] = '{', 'application/json', 'application/x-www-form-urlencoded');
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
httpCli.SendStream.Write(POSTData[1], Length(POSTData));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
httpCli.Post;
|
|
end else
|
|
httpCli.Get;
|
|
Result := True;
|
|
except
|
|
on E: EHttpException do
|
|
if ShowErrors then
|
|
HandleError(E, URL, '', False);
|
|
end;
|
|
|
|
if Result then
|
|
begin
|
|
AvStream.Seek(0, soFromBeginning);
|
|
if OutputAsStr then
|
|
fn := AvStream.DataString
|
|
else if not (fs = nil) then
|
|
begin
|
|
AvStream.SaveToStream(fs);
|
|
fs.Seek(0, soFromBeginning);
|
|
end
|
|
else if not (fn = '') then
|
|
begin
|
|
if ExtByContent then
|
|
begin
|
|
ft := DetectFileFormatStream(AvStream);
|
|
if ft <> PA_FORMAT_UNK then
|
|
fn := ChangeFileExt(fn, PAFormat[ft]);
|
|
end;
|
|
AvStream.SaveToFile(fn);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(AvStream);
|
|
end;
|
|
finally
|
|
if Assigned(httpCli.SendStream) then
|
|
httpCli.SendStream.Free;
|
|
httpCli.Free;
|
|
end;
|
|
end;
|
|
|
|
function LoadFromURLAsync(const URL: String; Callback: THttpRequestDone = nil; Data: Pointer = nil; const POSTData: RawByteString = ''; ShowErrors: Boolean = True): Boolean;
|
|
var
|
|
httpCli: THttpAsync;
|
|
begin
|
|
Result := False;
|
|
try
|
|
httpCli := THttpAsync.Create(15, Callback);
|
|
httpCli.Setup(URL, Data);
|
|
httpCli.RcvdStream := TMemoryStream.Create;
|
|
try
|
|
if not (POSTData = '') then
|
|
begin
|
|
httpCli.ContentTypePost := 'application/x-www-form-urlencoded';
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
httpCli.SendStream.Write(POSTData[1], Length(POSTData));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
httpCli.PostAsync;
|
|
end else
|
|
httpCli.GetAsync;
|
|
httpCli.StartTimeout;
|
|
Result := True;
|
|
except
|
|
on E: EHttpException do
|
|
if ShowErrors then
|
|
HandleError(E, URL);
|
|
end;
|
|
except end;
|
|
end;
|
|
|
|
function HeaderFromURL(const URL: String): String;
|
|
var
|
|
httpCli: TSslHttpCli;
|
|
begin
|
|
Result := '';
|
|
if URL = '' then
|
|
Exit;
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
try
|
|
httpCli.MultiThreaded := not (GetCurrentThreadID = MainThreadID);
|
|
httpCli.URL := RemoveAnchorFromURL(URL);
|
|
httpCli.FollowRelocation := True;
|
|
httpCli.Timeout := 2;
|
|
SetupProxy(httpCli);
|
|
try httpCli.Head; except end;
|
|
Result := httpCli.ContentType;
|
|
finally
|
|
httpCli.Free;
|
|
end;
|
|
end;
|
|
|
|
function InfoFromURL(const URL: String; Callbacks: TCallbacks): TLinkInfo;
|
|
var
|
|
httpCli: TSslHttpCli;
|
|
begin
|
|
Result := Default(TLinkInfo);
|
|
if URL = '' then
|
|
Exit;
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
try
|
|
httpCli.MultiThreaded := not (GetCurrentThreadID = MainThreadID);
|
|
httpCli.URL := RemoveAnchorFromURL(URL);
|
|
httpCli.FollowRelocation := True;
|
|
httpCli.LocationChangeMaxCount := 10;
|
|
httpCli.Timeout := 5;
|
|
httpCli.Connection := 'keep-alive';
|
|
httpCli.Agent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:79.0) Gecko/20100101 Firefox/79.0';
|
|
httpCli.Accept := '*/*';
|
|
httpCli.AcceptLanguage := 'en,en-US;q=0.7,ru;q=0.3';
|
|
httpCli.ExtraHeaders.Add('Accept-Encoding: gzip, deflate, br');
|
|
httpCli.OnHeaderEnd := Callbacks.OnHeaderEnd;
|
|
SetupProxy(httpCli);
|
|
try httpCli.Get; except end;
|
|
Result.code := IfThen(httpCli.Tag = 0, httpCli.StatusCode, httpCli.Tag);
|
|
Result.size := httpCli.ContentLength;
|
|
Result.mime := httpCli.ContentType;
|
|
Result.redirects := httpCli.LocationChangeCurCount;
|
|
finally
|
|
httpCli.Free;
|
|
end;
|
|
end;
|
|
|
|
function FileSize(const aFilename: String): Int64;
|
|
var
|
|
info: TWin32FileAttributeData;
|
|
begin
|
|
result := -1;
|
|
|
|
if not GetFileAttributesEx(PWideChar(aFileName), GetFileExInfoStandard, @info) then
|
|
Exit;
|
|
|
|
result := Int64(info.nFileSizeLow) or Int64(info.nFileSizeHigh shl 32);
|
|
end;
|
|
|
|
function InputText(const Boundry, Name, Value: RawByteString): RawByteString;
|
|
begin
|
|
Result := '--' + boundry + CRLF + 'Content-Disposition: form-data; name="' + name + '"' + CRLF + CRLF + value + CRLF;
|
|
end;
|
|
|
|
function UploadFileICQ(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
var
|
|
AvStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
Response: RawByteString;
|
|
JSON, Res: TJSONObject;
|
|
ULimit, Code: Integer;
|
|
UploadLink: String;
|
|
begin
|
|
Result := '';
|
|
|
|
ULimit := 4096;
|
|
if FileSize(FileName) > ULimit * 1024 * 1024 then
|
|
begin
|
|
MsgDlg(GetTranslation(FileTooBig, [IntToStr(ULimit)]), False, mtError);
|
|
Exit;
|
|
end;
|
|
|
|
UploadLink := Account.AccProto.FilesInit(FileName, FileStream.Size);
|
|
if UploadLink = '' then
|
|
begin
|
|
MsgDlg(AuthFailed, True, mtError);
|
|
Exit;
|
|
end;
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
try
|
|
httpCli.BandwidthLimit := 0;
|
|
httpCli.Connection := 'keep-alive';
|
|
httpCli.Agent := IfThen(Account.AccProto.ShowClientID, 'R&Q', 'Mail.ru Windows ICQ New');
|
|
httpCli.ContentTypePost := 'application/octet-stream';
|
|
httpCli.URL := UploadLink;
|
|
httpCli.ExtraHeaders.Add('Content-Disposition: attachment; filename="' + FileName + '"');
|
|
httpCli.ExtraHeaders.Add('Content-Range: bytes 0-' + IntToStr(FileStream.Size - 1) + '/' + IntToStr(FileStream.Size));
|
|
SetupProxy(httpCli);
|
|
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
httpCli.SendStream.CopyFrom(FileStream);
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
httpCli.OnBeforeHeaderSend := UploadCallbacks.OnBeforeHeaderSend;
|
|
httpCli.OnSendData := UploadCallbacks.OnSendData;
|
|
|
|
try
|
|
UploadSize := httpCli.SendStream.Size;
|
|
UploadedSize := 0;
|
|
IsUploading := True;
|
|
httpCli.FollowRelocation := True;
|
|
httpCli.Post;
|
|
IsUploading := False;
|
|
|
|
AvStream.Seek(0, soFromBeginning);
|
|
SetLength(Response, AvStream.Size);
|
|
AvStream.ReadBuffer(Response[1], AvStream.Size);
|
|
|
|
JSON := TJSONObject.ParseJSONValue(Response) as TJSONObject;
|
|
if Assigned(JSON) then
|
|
try
|
|
TJSONObject(JSON.GetValue('status')).GetValue('code').TryGetValue(Code);
|
|
if not (Code = 200) or (JSON.GetValue('result') = nil) then
|
|
begin
|
|
MsgDlg(GetTranslation(UploadError) + ': ' + IntToStr(Code), False, mtError);
|
|
Exit;
|
|
end;
|
|
Res := TJSONObject(JSON.GetValue('result'));
|
|
Result := Res.GetValue('static_url').Value;
|
|
finally
|
|
FreeAndNil(JSON);
|
|
end;
|
|
except
|
|
MsgDlg(GetTranslation(UploadError) + ': ' + httpCli.LastResponse, False, mtError);
|
|
end;
|
|
finally
|
|
IsUploading := False;
|
|
if Assigned(httpCli.SendStream) then
|
|
httpCli.SendStream.Free;
|
|
httpCli.Free;
|
|
FreeAndNil(AvStream);
|
|
end;
|
|
end;
|
|
|
|
function UploadFileRGhost(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
var
|
|
AvStream, TokenStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
Host, Token, Buf, Boundry, TokenStr, FilePage: RawByteString;
|
|
JSONObject: TJSONObject;
|
|
i, p, ULimit: Integer;
|
|
Cookie, DirectLink: String;
|
|
begin
|
|
Result := '';
|
|
Boundry := 'RghostUploadBoundaryabcdef0123456789';
|
|
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
try
|
|
TokenStream := TMemoryStream.Create;
|
|
httpCli.RcvdStream := TokenStream;
|
|
httpCli.BandwidthLimit := 0;
|
|
httpCli.Connection := 'keep-alive';
|
|
httpCli.Reference := 'http://rghost.net/';
|
|
httpCli.Agent := 'rgup 1.3';
|
|
httpCli.URL := 'http://rghost.net/multiple/upload_host';
|
|
httpCli.Cookie := '';
|
|
SetupProxy(httpCli);
|
|
httpCli.Get;
|
|
|
|
for i := 0 to httpCli.RcvdHeader.Count - 1 do
|
|
if StartsText('Set-Cookie:', httpCli.RcvdHeader[i]) then
|
|
Cookie := StrUtils.ReplaceText(Copy(httpCli.RcvdHeader[i], 1, Pos(';', httpCli.RcvdHeader[i]) - 1), 'Set-Cookie: ', '');
|
|
|
|
TokenStream.Seek(0, soFromBeginning);
|
|
SetLength(TokenStr, TokenStream.Size);
|
|
TokenStream.ReadBuffer(TokenStr[1], TokenStream.Size);
|
|
TokenStream.Clear;
|
|
FreeAndNil(TokenStream);
|
|
except end;
|
|
|
|
JSONObject := TJSONObject.ParseJSONValue(TokenStr) as TJSONObject;
|
|
if Assigned(JSONObject) then
|
|
begin
|
|
Host := JSONObject.GetValue('upload_host').Value;
|
|
Token := JSONObject.GetValue('authenticity_token').Value;
|
|
ULimit := 100;
|
|
TryStrToInt(JSONObject.GetValue('upload_limit').Value, ULimit);
|
|
|
|
if FileSize(FileName) > ULimit * 1024 * 1024 then
|
|
begin
|
|
MsgDlg(GetTranslation(FileTooBig, [IntToStr(ULimit)]), False, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
MsgDlg(AuthFailed, True, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
try
|
|
httpCli.URL := 'http://' + Host + '/files';
|
|
httpCli.ContentTypePost := 'multipart/form-data; boundary=' + Boundry;
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
|
|
Buf := InputText(Boundry, 'authenticity_token', Token) +
|
|
'--' + Boundry + CRLF + 'Content-Disposition: form-data; name="file"; filename="' + UTF(FileName) + '"' + CRLF +
|
|
'Content-Transfer-Encoding: binary' + CRLF + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
|
|
httpCli.SendStream.CopyFrom(FileStream);
|
|
|
|
Buf := CRLF + '--' + Boundry + '--' + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
|
|
httpCli.OnBeforeHeaderSend := UploadCallbacks.OnBeforeHeaderSend;
|
|
httpCli.OnSendData := UploadCallbacks.OnSendData;
|
|
|
|
httpCli.RcvdStream := AvStream;
|
|
httpCli.Cookie := Cookie;
|
|
|
|
try
|
|
UploadSize := httpCli.SendStream.Size;
|
|
UploadedSize := 0;
|
|
IsUploading := True;
|
|
httpCli.FollowRelocation := False;
|
|
httpCli.Post;
|
|
IsUploading := False;
|
|
|
|
for i := 0 to httpCli.RcvdHeader.Count - 1 do
|
|
if StartsText('Location:', httpCli.RcvdHeader[i]) then
|
|
Result := Trim(StrUtils.ReplaceText(httpCli.RcvdHeader[i], 'Location:', ''));
|
|
|
|
if not (Result = '') then
|
|
begin
|
|
AvStream.Clear;
|
|
httpCli.URL := Result;
|
|
httpCli.FollowRelocation := True;
|
|
httpCli.Get;
|
|
AvStream.Seek(0, soFromBeginning);
|
|
SetLength(FilePage, AvStream.Size);
|
|
AvStream.ReadBuffer(FilePage[1], AvStream.Size);
|
|
|
|
p := Pos('name="file[direct_link]" onclick="this.select();" size="30" title="', FilePage) + 67;
|
|
DirectLink := Copy(FilePage, p, Pos('"', FilePage, p) - p);
|
|
if StartsText('http://', DirectLink) then
|
|
Result := DirectLink;
|
|
end;
|
|
except
|
|
MsgDlg(GetTranslation(UploadError) + ': ' + httpCli.LastResponse, False, mtError);
|
|
end;
|
|
finally
|
|
IsUploading := False;
|
|
if Assigned(httpCli.SendStream) then
|
|
httpCli.SendStream.Free;
|
|
httpCli.Free;
|
|
FreeAndNil(AvStream);
|
|
end;
|
|
end;
|
|
|
|
function UploadFile2MyServer(FileStream: TStream; const fn: String; const Boundry: RawByteString; const URL: String; UploadCallbacks: TCallbacks): String;
|
|
var
|
|
AvStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
Buf, UploadedName: RawByteString;
|
|
begin
|
|
Result := '';
|
|
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
httpCli.BandwidthLimit := 0;
|
|
httpCli.Connection := 'keep-alive';
|
|
httpCli.Agent := 'R&Q';
|
|
|
|
if FileStream.Size > 100 * 1024 * 1024 then
|
|
begin
|
|
MsgDlg(GetTranslation(FileTooBig, [IntToStr(100)]), False, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
try
|
|
httpCli.URL := URL;
|
|
SetupProxy(httpCli);
|
|
httpCli.ContentTypePost := 'multipart/form-data; boundary=' + Boundry;
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
Buf := InputText(Boundry, 'fname', UTF(fn)) +
|
|
'--' + Boundry + CRLF + 'Content-Disposition: form-data; name="file"; filename="' + UTF(fn) + '"' + CRLF +
|
|
'Content-Transfer-Encoding: binary' + CRLF + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
|
|
httpCli.SendStream.CopyFrom(FileStream);
|
|
|
|
Buf := CRLF + '--' + Boundry + '--' + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
|
|
httpCli.OnBeforeHeaderSend := UploadCallbacks.OnBeforeHeaderSend;
|
|
httpCli.OnSendData := UploadCallbacks.OnSendData;
|
|
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
try
|
|
UploadSize := httpCli.SendStream.Size;
|
|
UploadedSize := 0;
|
|
IsUploading := True;
|
|
httpCli.FollowRelocation := False;
|
|
httpCli.Post;
|
|
IsUploading := False;
|
|
|
|
AvStream.Seek(0, soFromBeginning);
|
|
SetLength(UploadedName, AvStream.Size);
|
|
AvStream.ReadBuffer(UploadedName[1], AvStream.Size);
|
|
|
|
Result := LowerCase(UploadedName);
|
|
except
|
|
on E: EHttpException do
|
|
HandleError(E, URL, httpCli.RcvdHeader.Text, False);
|
|
end;
|
|
finally
|
|
IsUploading := False;
|
|
if Assigned(httpCli.SendStream) then
|
|
httpCli.SendStream.Free;
|
|
httpCli.Free;
|
|
FreeAndNil(AvStream);
|
|
end;
|
|
end;
|
|
|
|
function UploadFileRnQ(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
begin
|
|
Result := UploadFile2MyServer(FileStream, FileName, '---------------RnQPortalServerUpload', 'https://rnq.ru/file_upload.php', UploadCallbacks);
|
|
end;
|
|
|
|
function UploadFileMikanoshi(FileStream: TStream; const FileName: String; UploadCallbacks: TCallbacks): String;
|
|
begin
|
|
Result := UploadFile2MyServer(FileStream, FileName, '---------------MikanoshiServerUpload', 'https://code.highspec.ru/upload.php', UploadCallbacks);
|
|
end;
|
|
|
|
function GetICQFileLinkInfo(const lnk: String): TICQFileInfo;
|
|
var
|
|
JSONObject, JSONObject2: TJSONObject;
|
|
fileIdStr, imgStr: RawByteString;
|
|
buf: TMemoryStream;
|
|
fn: String;
|
|
begin
|
|
Result := Default(TICQFileInfo);
|
|
|
|
fileIdStr := ReplaceText(Trim(lnk), 'files.icq.net/get/', 'files.icq.com/getinfo?file_id=');
|
|
fileIdStr := ReplaceText(fileIdStr, 'files.icq.net/files/get?fileId=', 'files.icq.com/getinfo?file_id=');
|
|
Result.jsonlink := fileIdStr;
|
|
|
|
buf := TMemoryStream.Create;
|
|
LoadFromURL(fileIdStr, fn, buf, 0, False, '', False);
|
|
SetLength(imgStr, buf.Size);
|
|
buf.ReadBuffer(imgStr[1], buf.Size);
|
|
buf.Free;
|
|
|
|
JSONObject := TJSONObject.ParseJSONValue(imgStr) as TJSONObject;
|
|
if Assigned(JSONObject) then
|
|
try
|
|
JSONObject2 := TJSONObject.ParseJSONValue(TJSONArray(JSONObject.GetValue('file_list')).Items[0].ToJSON) as TJSONObject;
|
|
try
|
|
Result.dlink := JSONObject2.GetValue('dlink').Value;
|
|
Result.mime := JSONObject2.GetValue('mime').Value;
|
|
Result.filename := JSONObject2.GetValue('filename').Value;
|
|
Result.filesize := StrToInt64(JSONObject2.GetValue('filesize').Value);
|
|
Result.avstatus := IfThen(JSONObject2.GetValue('avstatus') = nil, 'unknown', JSONObject2.GetValue('avstatus').Value);
|
|
Result.is_previewable := StrToInt(JSONObject2.GetValue('is_previewable').Value) = 1;
|
|
if Result.is_previewable then
|
|
if Result.filename.StartsWith('dnld') then // sticker?
|
|
Result.preview := JSONObject2.GetValue('static').Value
|
|
else
|
|
Result.preview := JSONObject2.GetValue('xlarge').Value;
|
|
finally
|
|
FreeAndNil(JSONObject2);
|
|
FreeAndNil(JSONObject);
|
|
end;
|
|
except
|
|
FreeAndNil(JSONObject);
|
|
end;
|
|
end;
|
|
|
|
function CheckType(const lnk: String): Boolean;
|
|
var
|
|
ext: String;
|
|
sA: RawByteString;
|
|
begin
|
|
Result := CheckType(lnk, sA, ext);
|
|
end;
|
|
|
|
function CheckType(const lnk: String; var sA: RawByteString; var ext: String): Boolean;
|
|
var
|
|
Task: ITask;
|
|
Res, HasMime: Boolean;
|
|
sALocal: RawByteString;
|
|
extLocal, anchor: String;
|
|
info: TICQFileInfo;
|
|
begin
|
|
Res := False;
|
|
HasMime := False;
|
|
|
|
Task := TTask.Run(procedure()
|
|
var
|
|
buf: TMemoryStream;
|
|
idx: Integer;
|
|
ctype, fn: String;
|
|
imgStr: RawByteString;
|
|
begin
|
|
|
|
if EnableVideoLinks and (ContainsText(lnk, 'youtube.com/') or ContainsText(lnk, 'youtu.be/') or ContainsText(lnk, 'vimeo.com/')) then
|
|
begin
|
|
buf := TMemoryStream.Create;
|
|
LoadFromURL(lnk, fn, buf, 0, False, '', False);
|
|
SetLength(imgStr, buf.Size);
|
|
buf.ReadBuffer(imgStr[1], buf.Size);
|
|
buf.Free;
|
|
|
|
anchor := 'property="og:image" content="';
|
|
sALocal := copy(imgStr, pos(anchor, imgStr) + length(anchor));
|
|
sALocal := copy(sALocal, 1, pos('"', sALocal) - 1);
|
|
sALocal := DecodeURL(UnUTF(sALocal));
|
|
end else if ContainsText(lnk, 'files.icq.net/') then
|
|
begin
|
|
info := GetICQFileLinkInfo(lnk);
|
|
if info.mime.StartsWith('image/') then
|
|
begin
|
|
if info.preview = '' then
|
|
sALocal := info.dlink
|
|
else if info.is_previewable then
|
|
sALocal := info.preview;
|
|
ctype := info.mime;
|
|
HasMime := True;
|
|
end else if info.is_previewable then
|
|
begin
|
|
sALocal := info.preview;
|
|
ctype := info.mime;
|
|
HasMime := True;
|
|
end else
|
|
sALocal := '';
|
|
end else
|
|
sALocal := Trim(lnk);
|
|
|
|
if not HasMime then
|
|
ctype := HeaderFromURL(sALocal);
|
|
|
|
if not (ctype = '') and (pos(';', ctype) > 0) then
|
|
ctype := copy(ctype, 1, pos(';', ctype) - 1);
|
|
|
|
CacheType(lnk, ctype);
|
|
if MatchText(ctype, ImageContentTypes) then
|
|
begin
|
|
Res := True;
|
|
idx := IndexText(ctype, ImageContentTypes);
|
|
if idx >= 0 then
|
|
extLocal := ImageExtensions[idx]
|
|
else
|
|
extLocal := 'jpg';
|
|
end;
|
|
end);
|
|
|
|
task.Wait(10000);
|
|
|
|
sA := sALocal;
|
|
ext := extLocal;
|
|
Result := Res;
|
|
end;
|
|
|
|
function DownloadAndCache(const lnk: String): Boolean;
|
|
var
|
|
ext: String;
|
|
sA: RawByteString;
|
|
res: Boolean;
|
|
buf: TMemoryStream;
|
|
begin
|
|
Result := False;
|
|
if not CheckType(lnk, sA, ext) then
|
|
Exit;
|
|
|
|
buf := TMemoryStream.Create;
|
|
LoadFromURL(sA, buf, 0, False, '', False);
|
|
|
|
TThread.Synchronize(nil, procedure begin
|
|
if buf.Size = 0 then
|
|
CacheType(lnk, 'text/html')
|
|
else
|
|
res := CacheImage(buf, lnk, ext);
|
|
end);
|
|
|
|
if Assigned(buf) then
|
|
buf.Free;
|
|
Result := res;
|
|
end;
|
|
|
|
function CreateZip(str: TStringList): TMemoryStream;
|
|
var
|
|
Zip: TZipFile;
|
|
i: Integer;
|
|
fs: TFileStream;
|
|
pData: RawByteString;
|
|
begin
|
|
Result := TMemoryStream.Create;
|
|
Zip := TZipFile.Create;
|
|
try
|
|
for i := 0 to str.Count - 1 do
|
|
if FileExists(str.Strings[i]) then
|
|
begin
|
|
fs := TFileStream.Create(str.Strings[i], fmOpenRead);
|
|
SetLength(pData, fs.Size);
|
|
fs.ReadBuffer(pData[1], fs.Size);
|
|
FreeAndNil(fs);
|
|
Zip.AddFile(ExtractFileName(str.Strings[i]), 0, '', pData);
|
|
end;
|
|
Zip.SaveToStream(Result);
|
|
except end;
|
|
FreeAndNil(Zip);
|
|
end;
|
|
|
|
initialization
|
|
SslCtx := TSslContext.Create(nil);
|
|
|
|
finalization
|
|
FreeAndNil(SslCtx);
|
|
// ClearProxyArr(AllProxies);
|
|
end.
|