90 lines
2.3 KiB
ObjectPascal
90 lines
2.3 KiB
ObjectPascal
|
|
||
|
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastReport VCL }
|
||
|
|
{ }
|
||
|
|
{ Copyright (c) 1998-2021 }
|
||
|
|
{ by Fast Reports Inc. }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
unit frxHTTPProtocol;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$I frx.inc}
|
||
|
|
|
||
|
|
uses
|
||
|
|
SysUtils, Classes, SyncObjs, frxProtocolFactory, frxBaseSocketIOHandler;
|
||
|
|
|
||
|
|
type
|
||
|
|
TfrxHTTPDatalinkProtocol = class(TfrxCustomDatalinkProtocol)
|
||
|
|
protected
|
||
|
|
class function GetIOHandlerClass: TfrxCustomIOHandlerClass; virtual;
|
||
|
|
public
|
||
|
|
class function LoadBy(var Link: String; Stream: TStream; BoundData: TObject = nil): Boolean; override;
|
||
|
|
end;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
uses frxBaseTransportConnection, frxTransportHTTP;
|
||
|
|
|
||
|
|
{ TfrxHTTPDatalinkProtocol }
|
||
|
|
|
||
|
|
class function TfrxHTTPDatalinkProtocol.GetIOHandlerClass: TfrxCustomIOHandlerClass;
|
||
|
|
begin
|
||
|
|
Result := frxHTTPSocketIOHandlerClass;
|
||
|
|
end;
|
||
|
|
|
||
|
|
const
|
||
|
|
REDIR_TRIES = 10;
|
||
|
|
|
||
|
|
class function TfrxHTTPDatalinkProtocol.LoadBy(var Link: String;
|
||
|
|
Stream: TStream; BoundData: TObject): Boolean;
|
||
|
|
var
|
||
|
|
tHttp: TfrxTransportHTTP;
|
||
|
|
Res: AnsiString;
|
||
|
|
MemTmp: TMemoryStream;
|
||
|
|
iPos, rTry: Integer;
|
||
|
|
sLink: AnsiString;
|
||
|
|
begin
|
||
|
|
tHttp := TfrxTransportHTTP.Create(nil);
|
||
|
|
tHttp.HandleOnlySocketMessages := True;
|
||
|
|
tHttp.SocketType := fstBlocking;
|
||
|
|
MemTmp := TMemoryStream.Create;
|
||
|
|
iPos := Stream.Position;
|
||
|
|
rTry := 0;
|
||
|
|
try
|
||
|
|
tHttp.HTTPRequest.DefAcceptTypes := htcDefaultApp;
|
||
|
|
tHttp.IOHandler := GetIOHandlerClass.Create;
|
||
|
|
tHttp.TimeOut := 20;
|
||
|
|
tHttp.RetryCount := 3;
|
||
|
|
sLink := AnsiString(Link);
|
||
|
|
Res := tHttp.Get(sLink, Stream);
|
||
|
|
while (tHttp.ServerFields.AnswerCode = 301) and (rTry < REDIR_TRIES) do
|
||
|
|
begin
|
||
|
|
Stream.Size := 0;
|
||
|
|
if Pos('//', tHttp.ServerFields.Location) > 0 then
|
||
|
|
sLink := AnsiString(tHttp.ServerFields.Location)
|
||
|
|
else
|
||
|
|
sLink := sLink + AnsiString(tHttp.ServerFields.Location);
|
||
|
|
Res := tHttp.Get(sLink, Stream);
|
||
|
|
//frxDataProtocols.LoadByLink(sLink, Stream);
|
||
|
|
Inc(rTry);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
Result := (Stream.Size - iPos > 0) and (tHttp.Errors.Count = 0);
|
||
|
|
Link := String(sLink);
|
||
|
|
tHttp.Free;
|
||
|
|
MemTmp.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
frxDataProtocols.Register(TfrxHTTPDatalinkProtocol, 'http');
|
||
|
|
|
||
|
|
finalization
|
||
|
|
frxDataProtocols.Unregister('http');
|
||
|
|
|
||
|
|
end.
|
||
|
|
|