david
f2dddaa81b
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.FastReport@13 475b051d-3a53-6940-addd-820bf0cfe0d7
672 lines
19 KiB
ObjectPascal
672 lines
19 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ CGI wrapper client unit }
|
|
{ }
|
|
{ Copyright (c) 1998-2007 }
|
|
{ by Alexander Fediachov, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxCGIClient;
|
|
|
|
{$I frx.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Classes, ScktComp, frxServerUtils, frxNetUtils
|
|
{$IFDEF Delphi6}
|
|
, Variants
|
|
{$ENDIF};
|
|
|
|
type
|
|
TfrxCGIServerFields = class;
|
|
TfrxCGIClientFields = class;
|
|
TfrxClientThread = class;
|
|
|
|
TfrxCGIClient = class(TObject)
|
|
private
|
|
FActive: Boolean;
|
|
FAnswer: TStrings;
|
|
FBreaked: Boolean;
|
|
FClientFields: TfrxCGIClientFields;
|
|
FErrors: TStrings;
|
|
FHeader: TStrings;
|
|
FHost: String;
|
|
FPort: Integer;
|
|
FProxyHost: String;
|
|
FProxyPort: Integer;
|
|
FRetryCount: Integer;
|
|
FRetryTimeOut: Integer;
|
|
FServerFields: TfrxCGIServerFields;
|
|
FStream: TMemoryStream;
|
|
FTempStream: TMemoryStream;
|
|
FThread: TfrxClientThread;
|
|
FTimeOut: Integer;
|
|
F_QUERY_STRING: String;
|
|
F_REMOTE_HOST: String;
|
|
F_SERVER_NAME: String;
|
|
F_SERVER_PORT: String;
|
|
F_HTTP_REFERER: String;
|
|
F_HTTP_USER_AGENT: String;
|
|
F_CGI_FILENAME: String;
|
|
OutStream: THandleStream;
|
|
IsHTML: Boolean;
|
|
procedure DoConnect(Sender: TObject; Socket: TCustomWinSocket);
|
|
procedure DoDisconnect(Sender: TObject; Socket: TCustomWinSocket);
|
|
procedure DoError(Sender: TObject; Socket: TCustomWinSocket;
|
|
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
|
|
procedure DoRead(Sender: TObject; Socket: TCustomWinSocket);
|
|
procedure SetActive(const Value: Boolean);
|
|
procedure SetClientFields(const Value: TfrxCGIClientFields);
|
|
procedure SetServerFields(const Value: TfrxCGIServerFields);
|
|
procedure PrepareCGIStream(IStream: TStream; OStream: TStream);
|
|
procedure ReplaceCGIReps(Sign1: String; Sign2: String; IStream: TStream; OStream: TStream);
|
|
procedure DeleteCGIReps(Sign: String; IStream: TStream; OStream: TStream);
|
|
procedure InsertCGIHref(Sign: String; IStream: TStream; OStream: TStream);
|
|
public
|
|
ParentThread: TThread;
|
|
StreamSize: Cardinal;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Connect;
|
|
procedure Disconnect;
|
|
procedure Open;
|
|
procedure Close;
|
|
property Answer: TStrings read FAnswer write FAnswer;
|
|
property Breaked: Boolean read FBreaked;
|
|
property Errors: TStrings read FErrors write Ferrors;
|
|
property Header: TStrings read FHeader write FHeader;
|
|
property Stream: TMemoryStream read FStream write FStream;
|
|
property ClientFields: TfrxCGIClientFields read FClientFields write SetClientFields;
|
|
property ServerFields: TfrxCGIServerFields read FServerFields write SetServerFields;
|
|
|
|
property Active: Boolean read FActive write SetActive;
|
|
property Host: String read FHost write FHost;
|
|
property Port: Integer read FPort write FPort;
|
|
property ProxyHost: String read FProxyHost write FProxyHost;
|
|
property ProxyPort: Integer read FProxyPort write FProxyPort;
|
|
property RetryCount: Integer read FRetryCount write FRetryCount;
|
|
property RetryTimeOut: Integer read FRetryTimeOut write FRetryTimeOut;
|
|
property TimeOut: Integer read FTimeOut write FTimeOut;
|
|
end;
|
|
|
|
TfrxCGIServerFields = class (TPersistent)
|
|
private
|
|
FAnswerCode: Integer;
|
|
FContentEncoding: String;
|
|
FContentLength: Integer;
|
|
FLocation: String;
|
|
FSessionId: String;
|
|
public
|
|
constructor Create;
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
property AnswerCode: Integer read FAnswerCode write FAnswerCode;
|
|
property ContentEncoding: String read FContentEncoding write FContentEncoding;
|
|
property ContentLength: Integer read FContentLength write FContentLength;
|
|
property Location: String read FLocation write FLocation;
|
|
property SessionId: String read FSessionId write FSessionId;
|
|
end;
|
|
|
|
TfrxCGIClientFields = class (TPersistent)
|
|
private
|
|
FAcceptEncoding: String;
|
|
FHost: String;
|
|
FHTTPVer: String;
|
|
FLogin: String;
|
|
FName: String;
|
|
FPassword: String;
|
|
FQueryType: TfrxHTTPQueryType;
|
|
FReferer: String;
|
|
FUserAgent: String;
|
|
public
|
|
constructor Create;
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
property AcceptEncoding: String read FAcceptEncoding write FAcceptEncoding;
|
|
property FileName: String read FName write FName;
|
|
property Host: String read FHost write FHost;
|
|
property HTTPVer: String read FHTTPVer write FHTTPVer;
|
|
property Login: String read FLogin write FLogin;
|
|
property Password: String read FPassword write FPassword;
|
|
property QueryType: TfrxHTTPQueryType read FQueryType write FQueryType;
|
|
property Referer: String read FReferer write FReferer;
|
|
property UserAgent: String read FUserAgent write FUserAgent;
|
|
end;
|
|
|
|
TfrxClientThread = class (TThread)
|
|
protected
|
|
FClient: TfrxCGIClient;
|
|
procedure DoOpen;
|
|
procedure Execute; override;
|
|
public
|
|
FSocket: TClientSocket;
|
|
constructor Create(Client: TfrxCGIClient);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses frxFileUtils;
|
|
|
|
type
|
|
THackThread = class(TThread);
|
|
|
|
{ TfrxCGIServerFields }
|
|
|
|
constructor TfrxCGIServerFields.Create;
|
|
begin
|
|
FAnswerCode := 0;
|
|
FLocation := '';
|
|
FContentEncoding := '';
|
|
FContentLength := 0;
|
|
end;
|
|
|
|
procedure TfrxCGIServerFields.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TfrxCGIServerFields then
|
|
begin
|
|
FAnswerCode := TfrxCGIServerFields(Source).AnswerCode;
|
|
FLocation := TfrxCGIServerFields(Source).Location;
|
|
FContentEncoding := TfrxCGIServerFields(Source).ContentEncoding;
|
|
FContentLength := TfrxCGIServerFields(Source).ContentLength;
|
|
end;
|
|
end;
|
|
|
|
{ TfrxCGIClientFields }
|
|
|
|
constructor TfrxCGIClientFields.Create;
|
|
begin
|
|
FQueryType := qtGet;
|
|
FHTTPVer := 'HTTP/1.1';
|
|
FName := '';
|
|
FUserAgent := 'FastReportCGI/3.0';
|
|
FHost := '';
|
|
FAcceptEncoding := '';
|
|
FLogin := '';
|
|
FPassword := '';
|
|
FReferer := '';
|
|
end;
|
|
|
|
procedure TfrxCGIClientFields.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TfrxCGIClientFields then
|
|
begin
|
|
FQueryType := TfrxCGIClientFields(Source).QueryType;
|
|
FName := TfrxCGIClientFields(Source).FileName;
|
|
FHTTPVer := TfrxCGIClientFields(Source).HTTPVer;
|
|
FUserAgent := TfrxCGIClientFields(Source).UserAgent;
|
|
FHost := TfrxCGIClientFields(Source).Host;
|
|
FAcceptEncoding := TfrxCGIClientFields(Source).AcceptEncoding;
|
|
FLogin := TfrxCGIClientFields(Source).Login;
|
|
FPassword := TfrxCGIClientFields(Source).Password;
|
|
FReferer := TfrxCGIClientFields(Source).Referer;
|
|
end;
|
|
end;
|
|
|
|
{ TfrxCGIClient }
|
|
|
|
constructor TfrxCGIClient.Create;
|
|
begin
|
|
FHeader := TStringList.Create;
|
|
FAnswer := TStringList.Create;
|
|
FStream := TMemoryStream.Create;
|
|
FTempStream := TMemoryStream.Create;
|
|
FErrors := TStringList.Create;
|
|
FHost := '127.0.0.1';
|
|
FPort := 8097;
|
|
FProxyHost := '';
|
|
FProxyPort := 8080;
|
|
FActive := False;
|
|
FServerFields := TfrxCGIServerFields.Create;
|
|
FClientFields := TfrxCGIClientFields.Create;
|
|
FRetryTimeOut := 5;
|
|
FRetryCount := 3;
|
|
FTimeOut := 30;
|
|
FBreaked := False;
|
|
ParentThread := nil;
|
|
FThread := TfrxClientThread.Create(Self);
|
|
FThread.FSocket.OnConnect := DoConnect;
|
|
FThread.FSocket.OnRead := DoRead;
|
|
FThread.FSocket.OnDisconnect := DoDisconnect;
|
|
FThread.FSocket.OnError := DoError;
|
|
end;
|
|
|
|
destructor TfrxCGIClient.Destroy;
|
|
begin
|
|
Close;
|
|
while FActive do
|
|
PMessages;
|
|
FThread.Free;
|
|
FClientFields.Free;
|
|
FServerFields.Free;
|
|
FHeader.Free;
|
|
FAnswer.Free;
|
|
FStream.Free;
|
|
FTempStream.Free;
|
|
FErrors.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.Connect;
|
|
var
|
|
ticks: Cardinal;
|
|
i: Integer;
|
|
s: String;
|
|
begin
|
|
IsHTML := False;
|
|
F_QUERY_STRING := GetEnvVar('QUERY_STRING');
|
|
F_REMOTE_HOST := GetEnvVar('REMOTE_HOST');
|
|
F_SERVER_NAME := GetEnvVar('SERVER_NAME');
|
|
F_SERVER_PORT := GetEnvVar('SERVER_PORT');
|
|
F_HTTP_REFERER := GetEnvVar('HTTP_REFERER');
|
|
F_HTTP_USER_AGENT := GetEnvVar('HTTP_USER_AGENT');
|
|
F_CGI_FILENAME := ExtractFileName(ParamStr(0));
|
|
ClientFields.AcceptEncoding := '';
|
|
if Pos('report', ClientFields.FileName) > 0 then
|
|
ClientFields.FileName := 'result?' + ClientFields.FileName;
|
|
ClientFields.FileName := F_QUERY_STRING;
|
|
ClientFields.Host := F_REMOTE_HOST;
|
|
ClientFields.UserAgent := F_HTTP_USER_AGENT;
|
|
ClientFields.Referer := F_HTTP_REFERER;
|
|
|
|
OutStream := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE));
|
|
try
|
|
i := FRetryCount;
|
|
FBreaked := False;
|
|
repeat
|
|
FErrors.Clear;
|
|
FTempStream.Clear;
|
|
FActive := True;
|
|
if Length(FProxyHost) > 0 then
|
|
begin
|
|
FThread.FSocket.Host := FProxyHost;
|
|
FThread.FSocket.Address := FProxyHost;
|
|
FThread.FSocket.Port := FProxyPort;
|
|
end else
|
|
begin
|
|
FThread.FSocket.Host := FHost;
|
|
FThread.FSocket.Address := FHost;
|
|
FThread.FSocket.Port := FPort;
|
|
end;
|
|
FThread.FSocket.ClientType := ctNonBlocking;
|
|
FThread.Execute;
|
|
try
|
|
ticks := GetTickCount;
|
|
while FActive and (not FBreaked) do
|
|
begin
|
|
PMessages;
|
|
if (GetTickCount - ticks) > Cardinal(FTimeOut * 1000) then
|
|
begin
|
|
Errors.Add('Timeout expired (' + IntToStr(FTimeOut) + ')');
|
|
break;
|
|
end;
|
|
end;
|
|
finally
|
|
Disconnect;
|
|
end;
|
|
if not FBreaked then
|
|
begin
|
|
if (Errors.Count = 0) and ((FServerFields.AnswerCode = 301) or
|
|
(FServerFields.AnswerCode = 302) or (FServerFields.AnswerCode = 303)) then
|
|
begin
|
|
i := FRetryCount;
|
|
FClientFields.FileName := FServerFields.Location;
|
|
end
|
|
else if (Errors.Count > 0)
|
|
and (FServerFields.AnswerCode <> 401)
|
|
and (FServerFields.AnswerCode <> 403)
|
|
and (FServerFields.AnswerCode <> 404) then
|
|
begin
|
|
Dec(i);
|
|
if i > 0 then
|
|
Sleep(FRetryTimeOut * 1000)
|
|
else
|
|
if FRetryCount > 1 then
|
|
Errors.Add('Retry count (' + IntToStr(FRetryCount) + ') exceed')
|
|
end else
|
|
i := 0;
|
|
end;
|
|
until (i = 0) or FBreaked;
|
|
for i := 0 to Answer.Count - 1 do
|
|
if Pos('Content-type', Answer[i]) > 0 then
|
|
begin
|
|
s := Answer[i] + #13#10;
|
|
OutStream.Write(s[1], Length(s));
|
|
IsHTML := Pos('text/html', s) > 0;
|
|
break;
|
|
end;
|
|
s := 'Status: ' + IntToStr(ServerFields.AnswerCode) + #13#10;
|
|
OutStream.Write(s[1], Length(s));
|
|
s := 'Script-Control: no-abort'#13#10;
|
|
OutStream.Write(s[1], Length(s));
|
|
OutStream.Write(#13#10, 2);
|
|
if IsHTML then
|
|
PrepareCGIStream(FStream, OutStream)
|
|
else
|
|
OutStream.CopyFrom(FStream, 0);
|
|
finally
|
|
OutStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.Disconnect;
|
|
begin
|
|
FThread.FSocket.Close;
|
|
FThread.Terminate;
|
|
FActive := False;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.DoConnect(Sender: TObject;
|
|
Socket: TCustomWinSocket);
|
|
var
|
|
s, s1: String;
|
|
m: TMemoryStream;
|
|
begin
|
|
FHeader.Clear;
|
|
if FClientFields.QueryType = qtGet then
|
|
s := 'GET'
|
|
else if FClientFields.QueryType = qtPost then
|
|
s := 'POST'
|
|
else
|
|
s := '';
|
|
if Length(FProxyHost) > 0 then
|
|
s1 := 'http://' + Host + ':' + IntToStr(FPort) + '/' + FClientFields.FileName
|
|
else
|
|
s1 := '/' + FClientFields.FileName;
|
|
FHeader.Add(s + ' ' + s1 + ' ' + FClientFields.HTTPVer);
|
|
if Length(FClientFields.Host) = 0 then
|
|
s := Socket.LocalAddress
|
|
else
|
|
s := FClientFields.Host;
|
|
FHeader.Add('Host: ' + s);
|
|
if Length(FClientFields.UserAgent) > 0 then
|
|
FHeader.Add('User-Agent: ' + FClientFields.UserAgent);
|
|
if Length(FClientFields.AcceptEncoding) > 0 then
|
|
FHeader.Add('Accept-Encoding: ' + FClientFields.AcceptEncoding);
|
|
if Length(FClientFields.Login) > 0 then
|
|
FHeader.Add('Authorization: Basic ' + Base64Encode(FClientFields.Login + ':' +
|
|
FClientFields.Password));
|
|
FHeader.Add('Connection: close');
|
|
FHeader.Add('');
|
|
try
|
|
m := TMemoryStream.Create;
|
|
try
|
|
m.Write(FHeader.Text[1], Length(FHeader.Text));
|
|
if FStream.Size > 1 then
|
|
m.Write(FStream.Memory^, FStream.Size);
|
|
Socket.SendBuf(m.Memory^, m.Size);
|
|
finally
|
|
m.Free;
|
|
end
|
|
except
|
|
Errors.Add('Data send error');
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.DoDisconnect(Sender: TObject;
|
|
Socket: TCustomWinSocket);
|
|
var
|
|
i, j, Len: Integer;
|
|
s, s1: String;
|
|
begin
|
|
FAnswer.Clear;
|
|
FStream.Clear;
|
|
if FTempStream.Size > 0 then
|
|
begin
|
|
FTempStream.Position := 0;
|
|
i := StreamSearch(FTempStream, 0, #13#10#13#10);
|
|
if i <> 0 then
|
|
begin
|
|
Len := i + 4;
|
|
StreamSize := FTempStream.Size - Len;
|
|
SetLength(s, Len);
|
|
FTempStream.Position := 0;
|
|
FTempStream.ReadBuffer(s[1], Len);
|
|
FAnswer.Text := s;
|
|
i := Pos(' ', s) + 1;
|
|
j := i;
|
|
while (i < Length(s)) and (s[i] <> ' ') and (s[i] <> #13) do
|
|
Inc(i);
|
|
s1 := Copy(s, j, i - j);
|
|
if Length(s1) > 0 then
|
|
FServerFields.FAnswerCode := StrToInt(s1);
|
|
s1 := ParseHeaderField('Location: ', s);
|
|
if (Length(s1) > 0) and (s1[1] = '/') then
|
|
Delete(s1, 1, 1);
|
|
FServerFields.Location := s1;
|
|
FServerFields.ContentEncoding := LowerCase(ParseHeaderField('Content-Encoding: ', s));
|
|
s1 := ParseHeaderField('SessionId: ', s);
|
|
if Length(s1) > 0 then
|
|
FServerFields.SessionId := s1;
|
|
s1 := ParseHeaderField('Content-length: ', s);
|
|
if Length(s1) > 0 then
|
|
FServerFields.ContentLength := StrToInt(s1);
|
|
s1 := GetHTTPErrorText(FServerFields.AnswerCode);
|
|
if Length(s1) > 0 then
|
|
Errors.Add(s1);
|
|
if Errors.Count = 0 then
|
|
begin
|
|
if FServerFields.ContentLength > 0 then
|
|
if (FTempStream.Size - Len) <> FServerFields.ContentLength then
|
|
Errors.Add('Received data size mismatch');
|
|
if Errors.Count = 0 then
|
|
FStream.CopyFrom(FTempStream, FTempStream.Size - Len);
|
|
end;
|
|
end else
|
|
Errors.Add('Bad header');
|
|
FTempStream.Clear;
|
|
end
|
|
else if Errors.Count = 0 then
|
|
Errors.Add('Zero bytes received');
|
|
if FStream.Size > 0 then
|
|
FStream.Position := 0;
|
|
FActive := False;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.DoError(Sender: TObject; Socket: TCustomWinSocket;
|
|
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
|
|
begin
|
|
Errors.Add(GetSocketErrorText(ErrorCode));
|
|
FActive := False;
|
|
ErrorCode := 0;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.DoRead(Sender: TObject; Socket: TCustomWinSocket);
|
|
var
|
|
buf: PChar;
|
|
i, j: Integer;
|
|
begin
|
|
i := Socket.ReceiveLength;
|
|
GetMem(buf, i);
|
|
j := i;
|
|
try
|
|
try
|
|
while j > 0 do
|
|
begin
|
|
j := Socket.ReceiveBuf(buf^, i);
|
|
FTempStream.Write(buf^, j);
|
|
end;
|
|
except
|
|
Errors.Add('Data receive error.')
|
|
end;
|
|
finally
|
|
FreeMem(buf);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.SetActive(const Value: Boolean);
|
|
begin
|
|
if Value then Connect
|
|
else Disconnect;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.Close;
|
|
begin
|
|
FBreaked := True;
|
|
Active := False;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.Open;
|
|
begin
|
|
Active := True;
|
|
end;
|
|
|
|
procedure TfrxCGIClient.SetServerFields(const Value: TfrxCGIServerFields);
|
|
begin
|
|
FServerFields.Assign(Value);
|
|
end;
|
|
|
|
procedure TfrxCGIClient.SetClientFields(const Value: TfrxCGIClientFields);
|
|
begin
|
|
FClientFields.Assign(Value);
|
|
end;
|
|
|
|
procedure TfrxCGIClient.InsertCGIHref(Sign: String; IStream: TStream; OStream: TStream);
|
|
var
|
|
i, j: Integer;
|
|
p, p1: Longint;
|
|
s, s1, buf: String;
|
|
begin
|
|
p := 0;
|
|
p1 := 0;
|
|
s := StringReplace(ExtractFileDir(StringReplace(ClientFields.FileName, '/', '\', [rfReplaceAll ])), '\', '/', [rfReplaceAll ]);
|
|
if s <> '' then
|
|
s := s + '/';
|
|
s1 := F_CGI_FILENAME + '?' + s;
|
|
s := Sign;
|
|
SetLength(buf, 1);
|
|
while p <> -1 do
|
|
begin
|
|
p := StreamSearch(IStream, p, s);
|
|
if p <> -1 then
|
|
begin
|
|
i := StreamSearch(IStream, p, 'http:');
|
|
j := StreamSearch(IStream, p, 'mailto:');
|
|
if (i <> (p + Length(s))) and (j <> (p + Length(s))) then
|
|
begin
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, p - p1 + Length(s));
|
|
IStream.Read(buf[1], 1);
|
|
if buf[1] in ['"', ''''] then
|
|
begin
|
|
OStream.Write(buf[1], 1);
|
|
p := p + 1;
|
|
end;
|
|
OStream.Write(s1[1], Length(s1));
|
|
p1 := p + Length(s);
|
|
p := p + Length(s1);
|
|
end;
|
|
p := p + Length(s);
|
|
end;
|
|
end;
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, IStream.Size - p1);
|
|
end;
|
|
|
|
procedure TfrxCGIClient.DeleteCGIReps(Sign: String; IStream: TStream; OStream: TStream);
|
|
var
|
|
p, p1: Longint;
|
|
s: String;
|
|
begin
|
|
p := 0;
|
|
p1 := 0;
|
|
s := Sign;
|
|
while p <> -1 do
|
|
begin
|
|
p := StreamSearch(IStream, p, s);
|
|
if p <> -1 then
|
|
begin
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, p - p1);
|
|
p := p + Length(s);
|
|
p1 := p;
|
|
end;
|
|
end;
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, IStream.Size - p1);
|
|
end;
|
|
|
|
procedure TfrxCGIClient.ReplaceCGIReps(Sign1: String; Sign2: String; IStream: TStream; OStream: TStream);
|
|
var
|
|
p, p1: Longint;
|
|
s: String;
|
|
begin
|
|
p := 0;
|
|
p1 := 0;
|
|
s := Sign1;
|
|
while p <> -1 do
|
|
begin
|
|
p := StreamSearch(IStream, p, s);
|
|
if p <> -1 then
|
|
begin
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, p - p1);
|
|
OStream.Write(Sign2[1], Length(Sign2));
|
|
p := p + Length(s);
|
|
p1 := p;
|
|
end;
|
|
end;
|
|
IStream.Position := p1;
|
|
OStream.CopyFrom(IStream, IStream.Size - p1);
|
|
end;
|
|
|
|
procedure TfrxCGIClient.PrepareCGIStream(IStream: TStream; OStream: TStream);
|
|
var
|
|
TempStream: TMemoryStream;
|
|
TempStream1: TMemoryStream;
|
|
begin
|
|
TempStream := TMemoryStream.Create;
|
|
TempStream1 := TMemoryStream.Create;
|
|
try
|
|
TempStream.Clear;
|
|
InsertCGIHref(' href=', IStream, TempStream);
|
|
TempStream1.Clear;
|
|
InsertCGIHref(' src=', TempStream, TempStream1);
|
|
TempStream.Clear;
|
|
InsertCGIHref('frPrefix="', TempStream1, TempStream);
|
|
TempStream1.Clear;
|
|
InsertCGIHref('parent.location = "', TempStream, TempStream1);
|
|
TempStream.Clear;
|
|
DeleteCGIReps('result?', TempStream1, TempStream);
|
|
TempStream1.Clear;
|
|
ReplaceCGIReps('action="result"', 'action="' + F_CGI_FILENAME + '"', TempStream, TempStream1);
|
|
OStream.CopyFrom(TempStream1, 0);
|
|
finally
|
|
TempStream.Free;
|
|
TempStream1.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TfrxClientThread }
|
|
|
|
constructor TfrxClientThread.Create(Client: TfrxCGIClient);
|
|
begin
|
|
inherited Create(True);
|
|
FClient := Client;
|
|
FreeOnTerminate := False;
|
|
FSocket := TClientSocket.Create(nil);
|
|
end;
|
|
|
|
destructor TfrxClientThread.Destroy;
|
|
begin
|
|
FSocket.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxClientThread.DoOpen;
|
|
begin
|
|
FSocket.Open;
|
|
end;
|
|
|
|
procedure TfrxClientThread.Execute;
|
|
begin
|
|
Synchronize(DoOpen);
|
|
end;
|
|
|
|
end.
|