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.
1426 lines
42 KiB
Plaintext
1426 lines
42 KiB
Plaintext
unit RnQNet;
|
|
{$I forRnQConfig.inc}
|
|
{ $I RnQConfig.inc }
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, JSON, OverbyteIcsWSocket, OverbyteIcsHttpProt, OverbyteIcsNtlmMsgs, OverbyteIcsWSockBuf,
|
|
{$IFDEF UseNTLMAuthentication}
|
|
RnQHttpAuth,
|
|
{$ENDIF}
|
|
RDGlobal, RnQGlobal;
|
|
// wsocket, HttpProt;
|
|
// , OverbyteIcsMD5,
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
type
|
|
{$IFDEF UseNTLMAuthentication}
|
|
TRnQHttpNTLMState = (ntlmNone, ntlmMsg1, ntlmMsg2, ntlmMsg3, ntlmDone);
|
|
{$ENDIF}
|
|
TRnQHttpBasicState = (basicNone, basicMsg1, basicDone);
|
|
TRnQHttpAuthType = (httpAuthNone, httpAuthBasic, httpAuthNtlm);
|
|
|
|
type
|
|
TproxyProto = (PP_NONE = 0, PP_SOCKS4 = 1, PP_SOCKS5 = 2, PP_HTTPS = 3);
|
|
|
|
Thostport = record
|
|
host: String;
|
|
port: Integer;
|
|
end;
|
|
|
|
Tproxy = record
|
|
name: string;
|
|
user: String;
|
|
pwd: String; // Support Unicode!
|
|
// enabled : boolean;
|
|
auth: boolean;
|
|
NTLM: boolean;
|
|
proto: TproxyProto;
|
|
addr: Thostport;
|
|
rslvIP: boolean;
|
|
{$IFNDEF PREF_IN_DB}
|
|
serv: Thostport;
|
|
ssl: boolean;
|
|
{$ENDIF ~PREF_IN_DB}
|
|
// addr : array [Tproxyproto] of Thostport;
|
|
// host,port : string;
|
|
end;
|
|
|
|
TarrProxy = array of Tproxy;
|
|
|
|
const
|
|
proxyProto2Str: array [TproxyProto] of AnsiString = ('NONE', 'SOCKS4', 'SOCKS5', 'HTTP/S');
|
|
|
|
// var
|
|
{ :record
|
|
enabled :boolean;
|
|
auth :boolean;
|
|
proto :TproxyProto;
|
|
// addr :array [Tproxyproto] of Thostport;
|
|
NTLM :boolean;
|
|
user, pwd :string;
|
|
end; }
|
|
Procedure CopyProxy(var pTo: Tproxy; const pFrom: Tproxy);
|
|
Procedure ClearProxy(var p1: Tproxy);
|
|
Procedure CopyProxyArr(var pATo: TarrProxy; const pAFrom: TarrProxy);
|
|
Procedure ClearProxyArr(var pa: TarrProxy);
|
|
// procedure proxy_http_Enable(v_icq : TicqSession);
|
|
// procedure proxy_http_Enable(sock : TRnQSocket);
|
|
|
|
type
|
|
ThttpProxyInfo = record
|
|
user: String;
|
|
addr, port: String;
|
|
pwd: AnsiString;
|
|
authType: TRnQHttpAuthType;
|
|
{$IFDEF UseNTLMAuthentication}
|
|
FNTLMMsg2Info: TNTLM_Msg2_Info;
|
|
FProxyNTLMMsg2Info: TNTLM_Msg2_Info;
|
|
FAuthNTLMState: TRnQHttpNTLMState;
|
|
FProxyAuthNTLMState: TRnQHttpNTLMState;
|
|
{$ENDIF}
|
|
enabled: boolean;
|
|
end;
|
|
|
|
TDataReceived = procedure(Sender: TObject; ErrCode: Word; pkt: RawByteString) of object;
|
|
TProxyLogData = procedure(Sender: TObject; isReceive: boolean; Data: RawByteString) of object;
|
|
|
|
{$IFDEF USE_SSL}
|
|
|
|
TRnQSocket = class(TSslWSocket)
|
|
{$ELSE}
|
|
TRnQSocket = class(TWSocket)
|
|
{$ENDIF USE_SSL}
|
|
private
|
|
FSocksConnected: boolean;
|
|
FOldOnSessionConnected: TSessionConnected;
|
|
FOldOnDataAvailable: TDataAvailable;
|
|
FServerAddr: String;
|
|
FServerPort: AnsiString;
|
|
FMyBeautifulSocketBuffer: RawByteString;
|
|
FOnDataReceived: TDataReceived;
|
|
FOnProxyTalk: TProxyLogData;
|
|
|
|
// server authentication
|
|
// oSeq: AUTH_SEQ;
|
|
// proxy authentication
|
|
pSeq: AUTH_SEQ;
|
|
|
|
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;
|
|
http: ThttpProxyInfo;
|
|
{$IFDEF USE_SSL}
|
|
isSSL: boolean;
|
|
procedure StartTLS;
|
|
{$ENDIF USE_SSL}
|
|
protected
|
|
{$IFDEF USE_SSL}
|
|
SslCtxt: TSslContext;
|
|
procedure SockSslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: boolean);
|
|
{$ENDIF USE_SSL}
|
|
procedure TriggerSessionClosed(Error: Word); override;
|
|
function GetAddr1: String;
|
|
function GetAddr2: String;
|
|
{$IFDEF UseNTLMAuthentication}
|
|
// procedure StartAuthNTLM; virtual;
|
|
// procedure StartProxyAuthNTLM; virtual; {BLD proxy NTLM support }
|
|
function GetNTLMMessage1: AnsiString;
|
|
function GetNTLMMessage3(const ForProxy: boolean): AnsiString;
|
|
function GetNTLMMessage3_RD(const ForProxy: boolean; Domain: String = ''): AnsiString;
|
|
// procedure ElaborateNTLMAuth;
|
|
// function PrepareNTLMAuth(var FlgClean : Boolean) : Boolean;
|
|
{$ENDIF}
|
|
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 proxySettings(proxy: Tproxy);
|
|
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;
|
|
public
|
|
property OnBeforeHeaderSend: TBeforeHeaderSendEvent read FOnBeforeHeaderSend write FOnBeforeHeaderSend;
|
|
property OnSendData: TDocDataEvent read FOnSendData write FOnSendData;
|
|
end;
|
|
|
|
const
|
|
ProxyUnkError = 'PROXY: Unknown reply\n[%d]\n%s';
|
|
SSLError = 'SSL: libeay32.dll or ssleay32.dll not found\n%s';
|
|
FileTooBig = 'File is too big, max size %s MB';
|
|
AuthFailed = 'File hosting authentication failed';
|
|
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'
|
|
);
|
|
function HeaderFromURL(const URL: String): String;
|
|
function UploadFileRGhost(FileStream: TStream; FileName: String; uploadCallbacks: TCallbacks): String;
|
|
function UploadFileMikanoshi(FileStream: TStream; FileName: String; uploadCallbacks: TCallbacks): String;
|
|
function UploadFileRnQ(FileStream: TStream; FileName: String; uploadCallbacks: TCallbacks): String;
|
|
function CreateZip(str: TStringList): TMemoryStream;
|
|
|
|
function LoadFromURL(const URL: String; var fn: String; var fs: TMemoryStream; Threshold: LongInt = 0;
|
|
ExtByContent: boolean = false; DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean; overload;
|
|
function LoadFromURL(const URL: String; var fn: String; Threshold: LongInt = 0; ExtByContent: boolean = false;
|
|
DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean; overload;
|
|
function LoadFromURL(const URL: String; var fs: TMemoryStream; Threshold: LongInt = 0; ExtByContent: boolean = false;
|
|
DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean; overload;
|
|
|
|
var
|
|
MainProxy: Tproxy;
|
|
AllProxies: TarrProxy;
|
|
isUploading: Boolean;
|
|
uploadSize: Int64;
|
|
uploadedSize: Int64;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, Base64, SysUtils, StrUtils,
|
|
RDUtils,
|
|
RnQPrefsLib, RnQZip,
|
|
{$IFDEF UNICODE}
|
|
AnsiStrings,
|
|
{$ENDIF UNICODE}
|
|
// OverbyteIcsLogger,
|
|
{$IFDEF RNQ}
|
|
RnQLangs, RnQDialogs, RQUtil,
|
|
{$ENDIF RNQ}
|
|
{$IFDEF RNQ_PLUGIN}
|
|
RDPlugins,
|
|
{$ENDIF RNQ_PLUGIN}
|
|
RnQGraphics32;
|
|
|
|
(*
|
|
procedure proxy_http_Enable(v_icq : TicqSession);
|
|
begin
|
|
v_icq.sock.http.enabled:=proxy.enabled and (proxy.proto=PP_HTTPS);
|
|
if (proxy.proto=PP_HTTPS) then
|
|
begin
|
|
v_icq.sock.http.addr:=proxy.addr.host;
|
|
v_icq.sock.http.port:=IntToStr(proxy.addr.port);
|
|
end
|
|
else
|
|
begin
|
|
v_icq.sock.http.addr:='';
|
|
v_icq.sock.http.port:='';
|
|
end;
|
|
if proxy.auth then
|
|
begin
|
|
// if not proxy.NTLM then
|
|
begin
|
|
// sock.SocksAuthentication :=
|
|
v_icq.sock.http.user:=proxy.user;
|
|
v_icq.sock.http.pwd:=proxy.pwd;
|
|
if proxy.NTLM then
|
|
v_icq.sock.http.authType := RnQNet.httpAuthNtlm
|
|
else
|
|
v_icq.sock.http.authType := RnQNet.httpAuthBasic;
|
|
end
|
|
{ else
|
|
begin
|
|
v_icq.http.user:='';
|
|
v_icq.http.pwd:='';
|
|
v_icq.http.authType := httpAuthNtlm;
|
|
end;}
|
|
end
|
|
else
|
|
begin
|
|
v_icq.sock.http.authType := RnQNet.httpAuthNone;
|
|
v_icq.sock.http.user:='';
|
|
v_icq.sock.http.pwd:='';
|
|
end;
|
|
end;
|
|
*)
|
|
(* procedure proxy_http_Enable(proxy : TProxy; sock : TRnQSocket);
|
|
begin
|
|
sock.http.enabled := proxy.enabled and (proxy.proto=PP_HTTPS);
|
|
if (proxy.proto=PP_HTTPS) then
|
|
begin
|
|
sock.http.addr:=proxy.addr.host;
|
|
sock.http.port:=IntToStr(proxy.addr.port);
|
|
end
|
|
else
|
|
begin
|
|
sock.http.addr:='';
|
|
sock.http.port:='';
|
|
end;
|
|
if proxy.auth then
|
|
begin
|
|
// if not proxy.NTLM then
|
|
begin
|
|
// sock.SocksAuthentication :=
|
|
sock.http.user:=proxy.user;
|
|
sock.http.pwd:=proxy.pwd;
|
|
if proxy.NTLM then
|
|
sock.http.authType := RnQNet.httpAuthNtlm
|
|
else
|
|
sock.http.authType := RnQNet.httpAuthBasic;
|
|
end
|
|
{ else
|
|
begin
|
|
v_icq.http.user:='';
|
|
v_icq.http.pwd:='';
|
|
v_icq.http.authType := httpAuthNtlm;
|
|
end;}
|
|
end
|
|
else
|
|
begin
|
|
sock.http.authType := RnQNet.httpAuthNone;
|
|
sock.http.user:='';
|
|
sock.http.pwd:='';
|
|
end;
|
|
end;
|
|
*)
|
|
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;
|
|
{$IFDEF PREF_IN_DB}
|
|
{$ELSE ~PREF_IN_DB}
|
|
pTo.serv.host := pFrom.serv.host;
|
|
pTo.serv.port := pFrom.serv.port;
|
|
pTo.ssl := pFrom.ssl;
|
|
{$ENDIF PREF_IN_DB}
|
|
pTo.user := pFrom.user;
|
|
pTo.pwd := pFrom.pwd;
|
|
pTo.auth := pFrom.auth;
|
|
pTo.NTLM := pFrom.NTLM;
|
|
pTo.rslvIP := pFrom.rslvIP;
|
|
// if pTo.serv.host = '' then
|
|
// pTo.serv.host := DefLoginServer;
|
|
// if pTo.serv.port <= 0 then
|
|
// pTo.serv.port := DefLoginPort;
|
|
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.rslvIP := true;
|
|
p1.user := '';
|
|
p1.pwd := '';
|
|
{$IFDEF PREF_IN_DB}
|
|
{$ELSE ~PREF_IN_DB}
|
|
p1.serv.host := '';
|
|
{$ENDIF PREF_IN_DB}
|
|
end;
|
|
|
|
Procedure CopyProxyArr(var pATo: TarrProxy; const pAFrom: TarrProxy);
|
|
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: TarrProxy);
|
|
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;
|
|
|
|
{ TRnQSocket }
|
|
|
|
constructor TRnQSocket.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
http.enabled := false;
|
|
fAccIDX := -1;
|
|
{$IFDEF USE_SSL}
|
|
SslCtxt := NIL;
|
|
{$ENDIF USE_SSL}
|
|
{ IcsLogger := TIcsLogger.Create(AOwner);
|
|
IcsLogger.LogFileName := 'sckt.log';
|
|
IcsLogger.LogOptions := [loDestFile, loWsockErr, loWsockInfo, loWsockDump,
|
|
// loSslErr, loSslInfo, loSslDump,
|
|
loProtSpecErr, loProtSpecInfo, loProtSpecDump];
|
|
}
|
|
end;
|
|
|
|
procedure TRnQSocket.Connect;
|
|
var
|
|
Mtd: Pointer;
|
|
begin
|
|
FSocksConnected := false;
|
|
http.FProxyAuthNTLMState := ntlmNone;
|
|
FServerAddr := FAddrStr;
|
|
FServerPort := port;
|
|
|
|
AuthTerm(@pSeq);
|
|
fillchar(pSeq, sizeof(pSeq), 0);
|
|
AuthInit(@pSeq);
|
|
|
|
{$IFDEF USE_SSL}
|
|
if isSSL then
|
|
begin
|
|
OnSslHandshakeDone := SockSslHandshakeDone;
|
|
if not Assigned(SslCtxt) then
|
|
SslCtxt := TSslContext.Create(self);
|
|
// else
|
|
// SslCtxt.InitContext
|
|
|
|
// SslCtxt.IcsLogger := Self.IcsLogger;
|
|
// SslCtxt.SslVersionMethod := sslTLS_V1_CLIENT;
|
|
// SslCtxt.SslCipherList := 'ALL:eNULL:aNULL:@STRENGTH';
|
|
SslCtxt.SslCipherList := 'DEFAULT:@STRENGTH';
|
|
|
|
// SslCtxt.SslSessionCacheModes := [];
|
|
SslCtxt.SslVersionMethod := sslV23;
|
|
SslCtxt.SslVerifyPeer := false;
|
|
// SslCtxt.SslVerifyDepth := 1;
|
|
SslCtxt.SslVerifyPeerModes := [SslVerifyMode_NONE];
|
|
SslCtxt.SslVerifyDepth := 9;
|
|
SslContext := SslCtxt;
|
|
SslEnable := false;
|
|
SslMode := sslModeClient;
|
|
end;
|
|
{$ENDIF USE_SSL}
|
|
if http.enabled then // and (http.authType <> httpAuthNone) then
|
|
begin
|
|
addr := http.addr;
|
|
port := http.port;
|
|
Mtd := @TRnQSocket.myOnConnected;
|
|
if Mtd <> TMethod(FOnSessionConnected).Code then
|
|
begin
|
|
FOldOnSessionConnected := OnSessionConnected;
|
|
FOnSessionConnected := myOnConnected;
|
|
end;
|
|
Mtd := @TRnQSocket.myOnReceived;
|
|
if Mtd <> TMethod(FOnDataAvailable).Code then
|
|
begin
|
|
FOldOnDataAvailable := OnDataAvailable;
|
|
FOnDataAvailable := myOnReceived;
|
|
end;
|
|
end
|
|
{$IFDEF USE_SSL}
|
|
else if isSSL then
|
|
begin
|
|
Mtd := @TRnQSocket.myOnConnected;
|
|
if Mtd <> TMethod(FOnSessionConnected).Code then
|
|
begin
|
|
FOldOnSessionConnected := OnSessionConnected;
|
|
FOnSessionConnected := myOnConnected;
|
|
FOldOnDataAvailable := OnDataAvailable;
|
|
end;
|
|
end
|
|
{$ENDIF USE_SSL}
|
|
;
|
|
inherited;
|
|
end;
|
|
|
|
destructor TRnQSocket.Destroy;
|
|
begin
|
|
SetLength(http.addr, 0);
|
|
SetLength(http.port, 0);
|
|
SetLength(http.user, 0);
|
|
SetLength(http.pwd, 0);
|
|
{$IFDEF USE_SSL}
|
|
SslContext := NIL;
|
|
if Assigned(SslCtxt) then
|
|
SslCtxt.Free;
|
|
SslCtxt := NIL;
|
|
{$ENDIF USE_SSL}
|
|
AuthTerm(@pSeq);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRnQSocket.TriggerProxyData(isReceive: boolean; Data: RawByteString);
|
|
begin
|
|
if Assigned(FOnProxyTalk) then
|
|
FOnProxyTalk(self, isReceive, Data);
|
|
end;
|
|
|
|
procedure TRnQSocket.myOnConnected(Sender: TObject; Error: Word);
|
|
var
|
|
// eventData, s : AnsiString;
|
|
vData, vRaw: RawByteString;
|
|
begin
|
|
if Error <> 0 then
|
|
begin
|
|
// if Assigned(FOldOnSessionConnected) then
|
|
// FOldOnSessionConnected(Sender, Error);
|
|
ClientConnected(Sender, Error);
|
|
Exit;
|
|
end;
|
|
if http.enabled and not FSocksConnected then
|
|
begin
|
|
{ if phase = CONNECTING_ then
|
|
eventData:=loginServerAddr+':'+loginServerPort
|
|
else
|
|
eventData:=serviceServerAddr+':'+serviceServerPort;
|
|
}
|
|
vData := AnsiString(FServerAddr) + ':' + FServerPort;
|
|
|
|
if (http.user > '') or (http.authType = httpAuthNtlm) then
|
|
begin
|
|
{$IFDEF UseNTLMAuthentication}
|
|
if (http.authType = httpAuthNtlm) and (http.FProxyAuthNTLMState = ntlmNone) then
|
|
http.FProxyAuthNTLMState := ntlmMsg1;
|
|
|
|
if (http.authType = httpAuthNtlm) then
|
|
begin
|
|
if (http.FProxyAuthNTLMState <> ntlmMsg1) then
|
|
begin
|
|
if (http.FAuthNTLMState = ntlmMsg1) then
|
|
vRaw := AnsiString('Authorization: NTLM ') + GetNTLMMessage1 + AnsiString(CRLF)
|
|
else if (http.FAuthNTLMState = ntlmMsg3) then
|
|
vRaw := AnsiString('Authorization: NTLM ') + GetNTLMMessage3(false) + AnsiString(CRLF)
|
|
end
|
|
end
|
|
else // if (http.FAuthBasicState = basicMsg1) then
|
|
vRaw := AnsiString('Authorization: Basic ') + Base64EncodeString(AnsiString(http.user) + ':' + http.pwd)
|
|
// EncodeStr(encBase64, http.user + ':' + http.pwd)
|
|
+ CRLF;
|
|
{$ELSE}
|
|
// if (FAuthBasicState = basicMsg1) then
|
|
vRaw := AnsiString('Authorization: Basic ') + Base64EncodeString(http.user + ':' + http.pwd)
|
|
// EncodeStr(encBase64, http.user + ':' + http.pwd)
|
|
+ CRLF;
|
|
{$ENDIF}
|
|
{$IFDEF UseNTLMAuthentication}
|
|
if (http.FProxyAuthNTLMState = ntlmMsg1) then
|
|
vRaw := vRaw + 'Proxy-Authorization: NTLM ' + GetNTLMMessage1 + CRLF
|
|
else if (http.FProxyAuthNTLMState = ntlmMsg3) then
|
|
// s := s+ 'Proxy-Authorization: NTLM ' + GetNTLMMessage3(True) + CRLF
|
|
vRaw := vRaw + 'Proxy-Authorization: NTLM ' + GetNTLMMessage3_RD(true) + CRLF
|
|
else
|
|
{$ENDIF}
|
|
// if (FProxyAuthBasicState = basicMsg1) then
|
|
vRaw := vRaw + AnsiString('Proxy-Authorization: Basic ') +
|
|
Base64EncodeString(AnsiString(http.user) + AnsiString(':') + http.pwd)
|
|
// EncodeStr(encBase64, http.user + ':' + http.pwd)
|
|
+ AnsiString(CRLF);
|
|
|
|
// s:=base64encode(http.user+':'+http.pwd);
|
|
// s:=
|
|
// 'Authorization: Basic '+s+CRLF+
|
|
// 'Proxy-authorization: Basic '+s+CRLF;
|
|
end;
|
|
vData := 'CONNECT ' + vData + ' HTTP/1.0' + CRLF +
|
|
// 'User-agent: ICQ/2000b (Mozilla 1.24b; Windows; I; 32-bit)'+CRLF+
|
|
// SetRequestHeader('Connection', 'keep-alive');
|
|
'Connection' + ': ' + 'keep-alive' + CRLF + vRaw + // eventually empty
|
|
CRLF;
|
|
sendStr(vData);
|
|
TriggerProxyData(false, vData);
|
|
end
|
|
else
|
|
ClientConnected(Sender, Error);
|
|
end;
|
|
|
|
procedure TRnQSocket.myOnReceived(Sender: TObject; Error: Word);
|
|
const
|
|
socksAuthenticationFailed = 20015;
|
|
var
|
|
pkt, s: RawByteString;
|
|
I, j: Integer;
|
|
eventError: Word;
|
|
begin
|
|
eventError := 0;
|
|
if http.enabled and not FSocksConnected then
|
|
begin
|
|
{$IFDEF UNICODE}
|
|
pkt := ReceiveStrA;
|
|
{$ELSE nonUNICODE}
|
|
pkt := ReceiveStrA;
|
|
{$ENDIF UNICODE}
|
|
// if ((phase in [CONNECTING_,RECONNECTING_]) or
|
|
// ((phase = relogin_) and isAvatarSession)) and sock.http.enabled then
|
|
begin
|
|
FMyBeautifulSocketBuffer := FMyBeautifulSocketBuffer + pkt;
|
|
if pos(AnsiString(CRLFCRLF), FMyBeautifulSocketBuffer) = 0 then
|
|
Exit;
|
|
pkt := chop(AnsiString(CRLFCRLF), RawByteString(FMyBeautifulSocketBuffer));
|
|
// eventData:=pkt+CRLFCRLF;
|
|
// notifyListeners(IE_serverSent);
|
|
TriggerProxyData(true, pkt);
|
|
|
|
// eventError:=EC_other;
|
|
if (SameText(Copy(pkt, 1, 6), AnsiString('')) or SameText(Copy(pkt, 1, 9), AnsiString(' |
|
begin
|
|
j := pos(AnsiString(''), pkt);
|
|
if j <= 0 then
|
|
j := 1;
|
|
I := PosEx(AnsiString('HTTP/1'), pkt, j);
|
|
if I < 0 then
|
|
I := PosEx(AnsiString('HTTPS/1'), pkt, j);;
|
|
if I >= 0 then
|
|
pkt := Copy(pkt, I, 10000)
|
|
end;
|
|
if AnsiStartsText(AnsiString('HTTPS/1.0 200'), pkt) or AnsiStartsText(AnsiString('HTTPS/1.1 200'), pkt) or
|
|
AnsiStartsText(AnsiString('HTTP/1.1 200'), pkt) or AnsiStartsText(AnsiString('HTTP/1.0 200'), pkt) or
|
|
AnsiStartsText(AnsiString('HTTP/1.0 200'), pkt) or AnsiStartsText(AnsiString('HTTP/1.1 200'), pkt) then
|
|
ClientConnected(Sender, 0)
|
|
else if AnsiStartsStr(AnsiString('HTTP/1.0 407'), pkt) or AnsiStartsStr(AnsiString('HTTP/1.1 407'), pkt)
|
|
// or PosEx('HTTP/1.1 407')
|
|
then
|
|
if (http.authType = httpAuthNtlm) and (http.FProxyAuthNTLMState = ntlmMsg1) then
|
|
begin
|
|
I := pos(AnsiString(' NTLM '), pkt);
|
|
if I > 0 then
|
|
begin
|
|
inc(I, 6);
|
|
j := PosEx(AnsiString(CRLF), pkt, I);
|
|
s := Copy(pkt, I, j - I);
|
|
http.FProxyNTLMMsg2Info := NtlmGetMessage2(s);
|
|
http.FProxyAuthNTLMState := ntlmMsg3;
|
|
myOnConnected(Sender, 0);
|
|
// connected(NIL, 0);
|
|
Exit;
|
|
end
|
|
else
|
|
begin
|
|
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// TriggerSessionClosed();
|
|
DataAvailableError(socksAuthenticationFailed, 'PROXY: Invalid user/password');
|
|
// eventError:=EC_proxy_badPwd
|
|
eventError := 1;
|
|
end
|
|
else
|
|
begin
|
|
// eventError:=EC_proxy_unk;
|
|
eventError := 1;
|
|
DataAvailableError(socksAuthenticationFailed, pkt);
|
|
// eventMsg:=pkt;
|
|
end;
|
|
|
|
// pass what follows to the snac cruncher
|
|
pkt := FMyBeautifulSocketBuffer;
|
|
FMyBeautifulSocketBuffer := '';
|
|
|
|
if eventError <> 0 then
|
|
begin
|
|
// eventMsg := WSocketErrorDesc(eventInt);
|
|
// eventMsg := '';
|
|
// notifyListeners(IE_error);
|
|
// disconnect;
|
|
Close;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if pkt > '' then
|
|
if Assigned(OnDataReceived) then
|
|
OnDataReceived(Sender, Error, pkt);
|
|
end;
|
|
// ClientConnected
|
|
end;
|
|
|
|
{$IFDEF USE_SSL}
|
|
|
|
procedure TRnQSocket.SockSslHandshakeDone(Sender: TObject; ErrCode: Word; PeerCert: TX509Base; var Disconnect: boolean);
|
|
begin
|
|
ClientConnected2(Sender, ErrCode);
|
|
end;
|
|
|
|
procedure TRnQSocket.StartTLS;
|
|
begin
|
|
isSSL := true;
|
|
begin
|
|
OnSslHandshakeDone := SockSslHandshakeDone;
|
|
if not Assigned(SslCtxt) then
|
|
SslCtxt := TSslContext.Create(self);
|
|
SslCtxt.SslCipherList := 'DEFAULT:@STRENGTH';
|
|
|
|
// SslCtxt.SslVersionMethod := sslV23;
|
|
SslCtxt.SslVersionMethod := sslTLS_V1;
|
|
SslCtxt.SslVerifyPeer := false;
|
|
// SslCtxt.SslVerifyDepth := 1;
|
|
SslCtxt.SslVerifyPeerModes := [SslVerifyMode_NONE];
|
|
SslCtxt.SslVerifyDepth := 9;
|
|
SslContext := SslCtxt;
|
|
SslMode := sslModeClient;
|
|
SslEnable := true;
|
|
StartSslHandshake;
|
|
end;
|
|
end;
|
|
{$ENDIF USE_SSL}
|
|
|
|
procedure TRnQSocket.Close;
|
|
begin
|
|
if Assigned(FOldOnSessionConnected) then
|
|
FOnSessionConnected := FOldOnSessionConnected;
|
|
FOldOnSessionConnected := nil;
|
|
if Assigned(FOldOnDataAvailable) then
|
|
FOnDataAvailable := FOldOnDataAvailable;
|
|
FOldOnDataAvailable := nil;
|
|
// if not FSecureClient.Active then
|
|
// FErrorOccured := true;
|
|
inherited;
|
|
|
|
end;
|
|
|
|
procedure TRnQSocket.ClientConnected(Sender: TObject; Error: Word);
|
|
begin
|
|
{$IFDEF USE_SSL}
|
|
if isSSL and (Error = 0) then
|
|
begin
|
|
try
|
|
self.SslEnable := true;
|
|
self.StartSslHandshake;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
if Assigned(FOnSocksError) then
|
|
FOnSocksError(self, 1001, E.Classname + ' ' + E.Message);
|
|
Close;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
{$ENDIF USE_SSL}
|
|
ClientConnected2(Sender, Error);
|
|
end;
|
|
|
|
procedure TRnQSocket.ClientConnected2(Sender: TObject; Error: Word);
|
|
var
|
|
FOldOnData: TDataAvailable;
|
|
begin
|
|
FSocksConnected := true;
|
|
if Assigned(FOldOnSessionConnected) then
|
|
begin
|
|
FOldOnData := FOnDataAvailable;
|
|
FOldOnSessionConnected(Sender, Error);
|
|
// if TMethod(FOnDataAvailable).Code <> TMethod(FOldOnData).Code then
|
|
// begin
|
|
// FOldOnDataAvailable := FOnDataAvailable;
|
|
// FOnDataAvailable := FOldOnData;
|
|
// end;
|
|
if Assigned(FOldOnDataAvailable) then
|
|
FOnDataAvailable := FOldOnDataAvailable;
|
|
FOldOnDataAvailable := nil;
|
|
end
|
|
else if Assigned(FOnSessionConnected) then
|
|
FOnSessionConnected(Sender, Error);
|
|
|
|
// if FSecureClient.Enabled and FSecureClient.Active then
|
|
// DoSSLEstablished();
|
|
end;
|
|
|
|
procedure TRnQSocket.DisableProxy();
|
|
begin
|
|
self.http.authType := RnQNet.httpAuthNone;
|
|
self.http.user := '';
|
|
self.http.pwd := '';
|
|
self.http.addr := '';
|
|
self.http.port := '';
|
|
self.http.enabled := false;
|
|
self.socksServer := '';
|
|
self.socksPort := '';
|
|
self.SocksAuthentication := socksNoAuthentication;
|
|
end;
|
|
|
|
procedure TRnQSocket.proxySettings(proxy: Tproxy);
|
|
procedure disblHTTP;
|
|
begin
|
|
http.authType := RnQNet.httpAuthNone;
|
|
http.user := '';
|
|
http.pwd := '';
|
|
http.addr := '';
|
|
http.port := '';
|
|
http.enabled := false;
|
|
end;
|
|
procedure disblSOCKS;
|
|
begin
|
|
socksServer := '';
|
|
socksPort := '';
|
|
SocksAuthentication := socksNoAuthentication;
|
|
end;
|
|
|
|
begin
|
|
if self.State <> wsClosed then
|
|
Exit;
|
|
// proxy_http_Enable(sock);
|
|
case proxy.proto of
|
|
PP_NONE:
|
|
begin
|
|
disblHTTP;
|
|
disblSOCKS;
|
|
end;
|
|
PP_SOCKS4, PP_SOCKS5:
|
|
begin
|
|
disblHTTP;
|
|
socksServer := proxy.addr.host;
|
|
socksPort := intToStr(proxy.addr.port);
|
|
if proxy.proto = PP_SOCKS4 then
|
|
socksLevel := '4'
|
|
else
|
|
socksLevel := '5';
|
|
if proxy.auth then
|
|
SocksAuthentication := socksAuthenticateUsercode
|
|
else
|
|
SocksAuthentication := socksNoAuthentication;
|
|
// if proxy.NTLM then sock.SocksAuthentication := s
|
|
// if not proxy.NTLM then
|
|
begin
|
|
// sock.SocksAuthentication :=
|
|
SocksUsercode := proxy.user;
|
|
SocksPassword := proxy.pwd;
|
|
end
|
|
end;
|
|
PP_HTTPS:
|
|
begin
|
|
disblSOCKS;
|
|
http.enabled := true;
|
|
http.addr := proxy.addr.host;
|
|
http.port := intToStr(proxy.addr.port);
|
|
if proxy.auth then
|
|
begin
|
|
http.user := proxy.user;
|
|
http.pwd := proxy.pwd;
|
|
if proxy.NTLM then
|
|
http.authType := RnQNet.httpAuthNtlm
|
|
else
|
|
http.authType := RnQNet.httpAuthBasic;
|
|
end
|
|
else
|
|
http.authType := RnQNet.httpAuthNone;
|
|
end;
|
|
end;
|
|
end; // proxySettings
|
|
|
|
procedure TRnQSocket.getFreePort;
|
|
begin
|
|
port := '0';
|
|
end;
|
|
|
|
{
|
|
procedure TRnQSocket.CloseDelayed;
|
|
begin
|
|
inherited;
|
|
|
|
end;
|
|
|
|
function TRnQSocket.RealSend(Data: Pointer; Len: Integer): Integer;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TRnQSocket.Receive(Buffer: Pointer; BufferSize: Integer): Integer;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TRnQSocket.ReceiveStr: string;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TRnQSocket.Send(Data: Pointer; Len: Integer): Integer;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TRnQSocket.SendStr(const Str: String): Integer;
|
|
begin
|
|
|
|
end;
|
|
}
|
|
|
|
procedure TRnQSocket.TriggerSessionClosed(Error: Word);
|
|
begin
|
|
// if FState <> wsClosed then begin
|
|
if FState = wsClosed then
|
|
begin
|
|
addr := FServerAddr;
|
|
port := FServerPort;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TRnQSocket.GetAddr1: String;
|
|
begin
|
|
// if FSocksConnected then
|
|
if FState = wsClosed then
|
|
Result := FAddrStr
|
|
else
|
|
Result := FServerAddr;
|
|
// else
|
|
// Addr;
|
|
end;
|
|
|
|
function TRnQSocket.GetAddr2: String;
|
|
begin
|
|
Result := GetAddr1 + ':' + port;
|
|
end;
|
|
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
|
|
{$IFDEF UseNTLMAuthentication}
|
|
|
|
function TRnQSocket.GetNTLMMessage1: AnsiString;
|
|
begin
|
|
{ Result := FNTLM.GetMessage1(FNTLMHost, FNTLMDomain); }
|
|
{ it is very common not to send domain and workstation strings on }
|
|
{ the first message }
|
|
Result := NtlmGetMessage1('', '');
|
|
end;
|
|
|
|
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
|
|
function TRnQSocket.GetNTLMMessage3(const ForProxy: boolean): AnsiString;
|
|
var
|
|
Hostname: String;
|
|
begin
|
|
{ get local hostname }
|
|
try
|
|
Hostname := LocalHostName;
|
|
except
|
|
Hostname := '';
|
|
end;
|
|
|
|
{ domain is not used }
|
|
{ hostname is the local hostname }
|
|
if ForProxy then
|
|
begin
|
|
Result := NtlmGetMessage3('', Hostname, http.user, // FProxyUsername,
|
|
http.pwd, // FProxyPassword,
|
|
http.FProxyNTLMMsg2Info.Challenge)
|
|
end
|
|
else
|
|
begin
|
|
Result := NtlmGetMessage3('', Hostname,
|
|
{ FNTLMUsercode, FNTLMPassword, }
|
|
// FCurrUsername, FCurrPassword,
|
|
http.user, http.pwd, http.FNTLMMsg2Info.Challenge);
|
|
end;
|
|
end;
|
|
|
|
function TRnQSocket.GetNTLMMessage3_RD(const ForProxy: boolean; Domain: String = ''): AnsiString;
|
|
var
|
|
Hostname, usr: String;
|
|
// res : AnsiString;
|
|
nmd: boolean;
|
|
AuthDt: RawByteString;
|
|
I: Integer;
|
|
begin
|
|
if secInit and (http.user = '') and (http.pwd = '') then
|
|
begin
|
|
SetLength(AuthDt, sizeof(http.FProxyNTLMMsg2Info.Challenge));
|
|
CopyMemory(@AuthDt[1], @http.FProxyNTLMMsg2Info.Challenge[0], Length(AuthDt));
|
|
AddAuthorizationHeader(Result, 'NTLM', AuthDt, http.user, http.pwd, nmd, ForProxy, @pSeq);
|
|
end
|
|
else
|
|
begin
|
|
usr := http.user;
|
|
if Domain > '' then
|
|
begin
|
|
if AnsiStartsText(Domain, http.user) then
|
|
usr := Copy(http.user, Length(Domain) + 2, Length(http.user))
|
|
end
|
|
else if pos('\', http.user) > 0 then
|
|
begin
|
|
I := pos('\', http.user);
|
|
Domain := Copy(http.user, 1, I - 1);
|
|
usr := Copy(http.user, I + 1, Length(http.user))
|
|
end;
|
|
|
|
{ get local hostname }
|
|
try
|
|
Hostname := LocalHostName;
|
|
except
|
|
Hostname := '';
|
|
end;
|
|
|
|
{ domain is not used }
|
|
{ hostname is the local hostname }
|
|
if ForProxy then
|
|
begin
|
|
Result := NtlmGetMessage3(Domain, Hostname, usr, // FProxyUsername,
|
|
http.pwd, // FProxyPassword,
|
|
http.FProxyNTLMMsg2Info.Challenge)
|
|
end
|
|
else
|
|
begin
|
|
Result := NtlmGetMessage3('', Hostname,
|
|
{ FNTLMUsercode, FNTLMPassword, }
|
|
// FCurrUsername, FCurrPassword,
|
|
usr, http.pwd, http.FNTLMMsg2Info.Challenge);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF RNQ_FULL}
|
|
|
|
procedure SetupProxy(var httpCli: TSslHttpCli);
|
|
begin
|
|
httpCli.SocksServer := '';
|
|
httpCli.SocksPort := '';
|
|
httpCli.SocksAuthentication := socksNoAuthentication;
|
|
httpCli.Proxy := '';
|
|
httpCli.ProxyPort := '';
|
|
if (StrUtils.StartsText('https://', httpCli.URL)) then
|
|
httpCli.SslContext := TSslContext.Create(nil);
|
|
|
|
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;
|
|
httpCli.SocksServer := MainProxy.addr.host;
|
|
httpCli.SocksPort := intToStr(MainProxy.addr.port);
|
|
|
|
if MainProxy.proto = PP_SOCKS4 then
|
|
httpCli.SocksLevel := '4'
|
|
else
|
|
httpCli.SocksLevel := '5';
|
|
httpCli.SocksAuthentication := socksNoAuthentication;
|
|
if MainProxy.auth then
|
|
httpCli.SocksAuthentication := socksAuthenticateUsercode;
|
|
// if proxy.NTLM then sock.SocksAuthentication := s
|
|
// if not proxy.NTLM then
|
|
begin
|
|
// sock.SocksAuthentication :=
|
|
httpCli.SocksUsercode := MainProxy.user;
|
|
httpCli.SocksPassword := MainProxy.pwd;
|
|
end
|
|
end;
|
|
PP_HTTPS:
|
|
begin
|
|
httpCli.Proxy := MainProxy.addr.host;
|
|
httpCli.ProxyPort := intToStr(MainProxy.addr.port);
|
|
// mainfrm.httpClient.ProxyConnection
|
|
if MainProxy.auth then
|
|
begin
|
|
httpCli.ProxyUsername := MainProxy.user;
|
|
httpCli.ProxyPassword := MainProxy.pwd;
|
|
if MainProxy.NTLM then
|
|
httpCli.ProxyAuth := OverbyteIcsHttpProt.httpAuthNtlm
|
|
else
|
|
httpCli.ProxyAuth := OverbyteIcsHttpProt.httpAuthBasic;
|
|
end
|
|
end
|
|
end;
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fn: String; Threshold: LongInt = 0; ExtByContent: boolean = false;
|
|
DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean;
|
|
var
|
|
fs: TMemoryStream;
|
|
begin
|
|
fs := nil;
|
|
Result := LoadFromURL(URL, fn, fs, Threshold, ExtByContent, DoPOST, POSTData, showErrors);
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fs: TMemoryStream; Threshold: LongInt = 0; ExtByContent: boolean = false;
|
|
DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean;
|
|
var
|
|
fn: String;
|
|
begin
|
|
Result := LoadFromURL(URL, fn, fs, Threshold, ExtByContent, DoPOST, POSTData, showErrors);
|
|
end;
|
|
|
|
function LoadFromURL(const URL: String; var fn: String; var fs: TMemoryStream; Threshold: LongInt = 0;
|
|
ExtByContent: boolean = false; DoPOST: boolean = false; POSTData: RawByteString = ''; showErrors: boolean = true): boolean;
|
|
var
|
|
// idx: Integer;
|
|
AvStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
ft: TPAFormat;
|
|
begin
|
|
Result := false;
|
|
// idx:= HasAvatar(UIN);
|
|
try
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
httpCli.URL := URL;
|
|
httpCli.FollowRelocation := True;
|
|
SetupProxy(httpCli);
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
Result := false;
|
|
try
|
|
if Threshold > 0 then
|
|
begin
|
|
httpCli.Head;
|
|
if httpCli.ContentLength > Threshold then
|
|
Exit;
|
|
end;
|
|
// httpCli.Options
|
|
try
|
|
// httpCli.MultiThreaded := True;
|
|
// httpCli.ThreadDetach;
|
|
if DoPOST then
|
|
begin
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
httpCli.SendStream.Write(POSTData[1], Length(POSTData));
|
|
httpCli.SendStream.Seek(0, 0);
|
|
httpCli.Post;
|
|
end
|
|
else
|
|
httpCli.Get;
|
|
// httpCli.ThreadAttach;
|
|
Result := true;
|
|
except
|
|
on E: EHttpException do
|
|
if showErrors then
|
|
if E.ErrorCode = 3 then
|
|
msgDlg(getTranslation(SSLError, [E.Message]), false, mtError)
|
|
else if E.ErrorCode <> 404 then
|
|
msgDlg(getTranslation(ProxyUnkError, [E.ErrorCode, E.Message]), false, mtError)
|
|
end;
|
|
|
|
if Result then
|
|
begin
|
|
AvStream.Seek(0, 0);
|
|
if not (fs = nil) then
|
|
begin
|
|
AvStream.SaveToStream(fs);
|
|
fs.Seek(0, 0);
|
|
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
|
|
httpCli.Free;
|
|
FreeAndNil(AvStream);
|
|
end;
|
|
except
|
|
|
|
end;
|
|
end;
|
|
|
|
function HeaderFromURL(const URL: String): String;
|
|
var
|
|
AvStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
begin
|
|
Result := '';
|
|
try
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
httpCli.URL := URL;
|
|
SetupProxy(httpCli);
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
try
|
|
httpCli.Head;
|
|
Result := httpCli.ContentType;
|
|
except end;
|
|
finally
|
|
httpCli.Free;
|
|
FreeAndNil(AvStream);
|
|
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(Boundry, Name, Value: RawByteString): RawByteString;
|
|
begin
|
|
result := format('%s' + CRLF + 'Content-Disposition: form-data; name="%s"' + CRLF + CRLF + '%s' + CRLF,
|
|
['--' + boundry, name, value]);
|
|
end;
|
|
|
|
function UploadFileRGhost(FileStream: TStream; 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, DownloadLink: String;
|
|
begin
|
|
Result := '';
|
|
Boundry := 'RghostUploadBoundaryabcdef0123456789';
|
|
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
SetupProxy(httpCli);
|
|
|
|
try
|
|
TokenStream := TMemoryStream.Create;
|
|
httpCli.RcvdStream := TokenStream;
|
|
httpCli.BandwidthLimit := 0;
|
|
httpCli.RequestVer := '1.1';
|
|
httpCli.Connection := 'Keep-Alive';
|
|
httpCli.Reference := 'http://rghost.net/';
|
|
httpCli.Agent := 'rgup 1.3';
|
|
httpCli.URL := 'http://rghost.net/multiple/upload_host';
|
|
httpCli.Cookie := '';
|
|
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, 0);
|
|
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)]), true, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
msgDlg(getTranslation(AuthFailed), true, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
|
|
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="' + StrToUTF8(FileName) + '"' + CRLF +
|
|
'Content-Transfer-Encoding: binary' + CRLF + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
|
|
httpCli.SendStream.CopyFrom(FileStream, 0);
|
|
|
|
Buf := CRLF + '--' + Boundry + '--' + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
|
|
httpCli.OnBeforeHeaderSend := uploadCallbacks.OnBeforeHeaderSend;
|
|
httpCli.OnSendData := uploadCallbacks.OnSendData;
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
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, 0);
|
|
SetLength(FilePage, AvStream.Size);
|
|
AvStream.ReadBuffer(FilePage[1], AvStream.Size);
|
|
|
|
p := Pos('window.rgh.fileurl = ''', FilePage) + 22;
|
|
DownloadLink := Copy(FilePage, p, Pos('''', FilePage, p) - p);
|
|
|
|
p := Pos('name="direct_link"', FilePage) + 83;
|
|
Result := Copy(FilePage, p, Pos('"', FilePage, p) - p);
|
|
|
|
if not StartsText('http://', Result) then
|
|
Result := httpCli.Location;
|
|
end;
|
|
except
|
|
msgDlg(getTranslation(UploadError) + ': ' + httpCli.LastResponse, true, mtError);
|
|
end;
|
|
finally
|
|
isUploading := False;
|
|
httpCli.Free;
|
|
if Assigned(AvStream) then FreeAndNil(AvStream);
|
|
end;
|
|
end;
|
|
|
|
function UploadFile2MyServer(FileStream: TStream; fn: String; Boundry: RawByteString; URL: String; uploadCallbacks: TCallbacks): String;
|
|
var
|
|
AvStream: TMemoryStream;
|
|
httpCli: TSslHttpCli;
|
|
Buf, UploadedName: RawByteString;
|
|
begin
|
|
Result := '';
|
|
|
|
httpCli := TSslHttpCli.Create(nil);
|
|
SetupProxy(httpCli);
|
|
httpCli.BandwidthLimit := 0;
|
|
httpCli.RequestVer := '1.1';
|
|
httpCli.Connection := 'Keep-Alive';
|
|
httpCli.Agent := 'R&Q';
|
|
|
|
if FileStream.Size > 100 * 1024 * 1024 then
|
|
begin
|
|
msgDlg(getTranslation(FileTooBig, [IntToStr(100)]), true, mtError);
|
|
httpCli.Free;
|
|
Exit;
|
|
end;
|
|
|
|
try
|
|
httpCli.URL := URL;
|
|
httpCli.ContentTypePost := 'multipart/form-data; boundary=' + Boundry;
|
|
httpCli.SendStream := TMemoryStream.Create;
|
|
|
|
Buf := InputText(Boundry, 'fname', StrToUTF8(fn)) +
|
|
'--' + Boundry + CRLF + 'Content-Disposition: form-data; name="file"; filename="' + StrToUTF8(fn) + '"' + CRLF +
|
|
'Content-Transfer-Encoding: binary' + CRLF + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
|
|
httpCli.SendStream.CopyFrom(FileStream, 0);
|
|
|
|
Buf := CRLF + '--' + Boundry + '--' + CRLF;
|
|
httpCli.SendStream.Write(Buf[1], Length(Buf));
|
|
httpCli.SendStream.Seek(0, soFromBeginning);
|
|
|
|
httpCli.OnBeforeHeaderSend := uploadCallbacks.OnBeforeHeaderSend;
|
|
httpCli.OnSendData := uploadCallbacks.OnSendData;
|
|
|
|
AvStream := TMemoryStream.Create;
|
|
httpCli.RcvdStream := AvStream;
|
|
|
|
try
|
|
uploadSize := httpCli.SendStream.Size;
|
|
uploadedSize := 0;
|
|
isUploading := True;
|
|
httpCli.FollowRelocation := False;
|
|
httpCli.Post;
|
|
isUploading := False;
|
|
|
|
AvStream.Seek(0, 0);
|
|
SetLength(UploadedName, AvStream.Size);
|
|
AvStream.ReadBuffer(UploadedName[1], AvStream.Size);
|
|
|
|
Result := LowerCase(UploadedName);
|
|
except
|
|
msgDlg(getTranslation(UploadError) + ': ' + #13#10 + httpCli.RcvdHeader.Text, true, mtError);
|
|
end;
|
|
finally
|
|
isUploading := False;
|
|
httpCli.Free;
|
|
if Assigned(AvStream) then FreeAndNil(AvStream);
|
|
end;
|
|
end;
|
|
|
|
function UploadFileRnQ(FileStream: TStream; FileName: String; uploadCallbacks: TCallbacks): String;
|
|
begin
|
|
Result := UploadFile2MyServer(FileStream, FileName, '---------------RnQPortalServerUpload', 'http://rnq.ru/file_upload.php', uploadCallbacks);
|
|
end;
|
|
|
|
function UploadFileMikanoshi(FileStream: TStream; FileName: String; uploadCallbacks: TCallbacks): String;
|
|
begin
|
|
Result := UploadFile2MyServer(FileStream, FileName, '---------------MikanoshiServerUpload', 'http://code.highspec.ru/upload.php', uploadCallbacks);
|
|
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;
|
|
{$ENDIF RNQ_FULL}
|
|
|
|
// FINALIZATION
|
|
// ClearProxyArr(AllProxies);
|
|
end.
|