mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 09:02:22 +01:00
* Replaced by fpAsync and net/http.pp
This commit is contained in:
sg
parent
4c05df2a6a
commit
6fbae3273f
@ -1,523 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
Async_IO: Mananging class for asynchronous input/output
|
||||
Copyright (C) 2000 by Sebastian Guenther (sg@freepascal.org)
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
|
||||
{$MODE objfpc}
|
||||
{$H+}
|
||||
|
||||
unit AsyncIO;
|
||||
|
||||
interface
|
||||
|
||||
{$i asyncioh.inc}
|
||||
|
||||
type
|
||||
TAsyncIOManager = class;
|
||||
|
||||
TAsyncIONotify = procedure(UserData: TObject) of object;
|
||||
|
||||
TAsyncIONotifyInfo = record
|
||||
Method: TAsyncIONotify;
|
||||
UserData: TObject;
|
||||
end;
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TAsyncIOManager
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
|
||||
TAsyncIOManager = class
|
||||
protected
|
||||
DoBreak: Boolean;
|
||||
IOdata : TIOdata;
|
||||
ReadNotifies, WriteNotifies: array[0..MaxHandle] of TAsyncIONotifyInfo;
|
||||
HighestHandle: Integer;
|
||||
FTimeout: Integer;
|
||||
TimeoutNotify: TAsyncIONotifyInfo;
|
||||
procedure CalcHighestHandle(max: Integer);
|
||||
procedure ExecuteNotify(const Notify: TAsyncIONotifyInfo);
|
||||
function GetHandleAsync(AHandle: Integer): Boolean;
|
||||
procedure SetHandleAsync(AHandle: Integer; AValue: Boolean);
|
||||
public
|
||||
constructor Create;
|
||||
procedure Run;
|
||||
procedure BreakRun;
|
||||
procedure SetReadHandler(AHandle: Integer; AMethod: TAsyncIONotify; AUserData: TObject);
|
||||
procedure ClearReadHandler(AHandle: Integer);
|
||||
function GetReadHandler(AHandle: Integer): TAsyncIONotify;
|
||||
procedure SetWriteHandler(AHandle: Integer; AMethod: TAsyncIONotify; AUserData: TObject);
|
||||
procedure ClearWriteHandler(AHandle: Integer);
|
||||
function GetWriteHandler(AHandle: Integer): TAsyncIONotify;
|
||||
procedure SetTimeoutHandler(AMethod: TAsyncIONotify; AUserData: TObject);
|
||||
procedure ClearTimeoutHandler;
|
||||
function GetTimeoutHandler: TAsyncIONotify;
|
||||
property Timeout: Integer read FTimeout write FTimeout;
|
||||
property HandleAsync[AHandle: Integer]: Boolean read GetHandleAsync write SetHandleAsync;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// Line reader classes
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
TLineNotify = procedure(const line: String) of object;
|
||||
|
||||
PBoolean = ^Boolean;
|
||||
|
||||
TGenericLineReader = class
|
||||
protected
|
||||
FDestroyedFlag: PBoolean;
|
||||
RealBuffer, FBuffer: PChar;
|
||||
FBytesInBuffer: Integer;
|
||||
FOnLine: TLineNotify;
|
||||
|
||||
function Read(var ABuffer; count: Integer): Integer; virtual; abstract;
|
||||
procedure NoData; virtual; abstract;
|
||||
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure Run; // Process as many lines as possible
|
||||
|
||||
property Buffer: PChar read FBuffer;
|
||||
property BytesInBuffer: Integer read FBytesInBuffer;
|
||||
property OnLine: TLineNotify read FOnLine write FOnLine;
|
||||
end;
|
||||
|
||||
|
||||
TAsyncStreamLineReader = class(TGenericLineReader)
|
||||
protected
|
||||
FManager: TAsyncIOManager;
|
||||
FDataStream: TStream;
|
||||
FBlockingStream: THandleStream;
|
||||
FOnEOF: TNotifyEvent;
|
||||
|
||||
function Read(var ABuffer; count: Integer): Integer; override;
|
||||
procedure NoData; override;
|
||||
procedure StreamDataAvailable(UserData: TObject);
|
||||
public
|
||||
constructor Create(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
constructor Create(AManager: TAsyncIOManager;
|
||||
ADataStream: TStream; ABlockingStream: THandleStream);
|
||||
destructor Destroy; override;
|
||||
|
||||
property DataStream: TStream read FDataStream;
|
||||
property BlockingStream: THandleStream read FBlockingStream;
|
||||
property OnEOF: TNotifyEvent read FOnEOF write FOnEOF;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TWriteBuffer
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
TWriteBuffer = class(TStream)
|
||||
protected
|
||||
FBuffer: PChar;
|
||||
FBytesInBuffer: Integer;
|
||||
FOnBufferEmpty: TNotifyEvent;
|
||||
|
||||
function Seek(Offset: LongInt; Origin: Word): LongInt; override;
|
||||
function Write(const ABuffer; Count: LongInt): LongInt; override;
|
||||
function DoRealWrite(const ABuffer; Count: Integer): Integer; virtual; abstract;
|
||||
procedure WritingFailed; virtual; abstract;
|
||||
procedure WantWrite; virtual; abstract;
|
||||
procedure BufferEmpty; virtual;
|
||||
|
||||
constructor Create;
|
||||
|
||||
public
|
||||
EndOfLineMarker: String;
|
||||
|
||||
destructor Destroy; override;
|
||||
procedure WriteLine(const line: String);
|
||||
procedure Run; // Write as many data as possible
|
||||
|
||||
property BytesInBuffer: Integer read FBytesInBuffer;
|
||||
property OnBufferEmpty: TNotifyEvent read FOnBufferEmpty write FOnBufferEmpty;
|
||||
end;
|
||||
|
||||
|
||||
TAsyncWriteStream = class(TWriteBuffer)
|
||||
protected
|
||||
FManager: TAsyncIOManager;
|
||||
FDataStream: TStream;
|
||||
FBlockingStream: THandleStream;
|
||||
|
||||
function DoRealWrite(const ABuffer; Count: Integer): Integer; override;
|
||||
procedure WritingFailed; override;
|
||||
procedure WantWrite; override;
|
||||
procedure BufferEmpty; override;
|
||||
procedure CanWrite(UserData: TObject);
|
||||
public
|
||||
constructor Create(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
constructor Create(AManager: TAsyncIOManager;
|
||||
ADataStream: TStream; ABlockingStream: THandleStream);
|
||||
destructor Destroy; override;
|
||||
|
||||
property DataStream: TStream read FDataStream;
|
||||
property BlockingStream: THandleStream read FBlockingStream;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// ===================================================================
|
||||
// ===================================================================
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
{$i asyncio.inc}
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TAsyncIOManager
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure TAsyncIOManager.ExecuteNotify(const Notify: TAsyncIONotifyInfo);
|
||||
begin
|
||||
if Assigned(Notify.Method) then
|
||||
Notify.Method(Notify.UserData);
|
||||
end;
|
||||
|
||||
procedure TAsyncIOManager.SetTimeoutHandler(AMethod: TAsyncIONotify; AUserData: TObject);
|
||||
begin
|
||||
TimeoutNotify.Method := AMethod;
|
||||
TimeoutNotify.UserData := AUserData;
|
||||
end;
|
||||
|
||||
procedure TAsyncIOManager.ClearTimeoutHandler;
|
||||
begin
|
||||
TimeoutNotify.Method := nil;
|
||||
end;
|
||||
|
||||
function TAsyncIOManager.GetTimeoutHandler: TAsyncIONotify;
|
||||
begin
|
||||
Result := TimeoutNotify.Method;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TGenericLineReader
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
destructor TGenericLineReader.Destroy;
|
||||
begin
|
||||
if Assigned(FDestroyedFlag) then
|
||||
FDestroyedFlag^ := True;
|
||||
if Assigned(RealBuffer) then
|
||||
begin
|
||||
FreeMem(RealBuffer);
|
||||
RealBuffer := nil;
|
||||
end;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGenericLineReader.Run;
|
||||
var
|
||||
NewData: array[0..1023] of Byte;
|
||||
p: PChar;
|
||||
BytesRead, OldBufSize, CurBytesInBuffer, LastEndOfLine, i, LineLength: Integer;
|
||||
line: String;
|
||||
FirstRun, DestroyedFlag: Boolean;
|
||||
begin
|
||||
FirstRun := True;
|
||||
DestroyedFlag := False;
|
||||
while True do
|
||||
begin
|
||||
BytesRead := Read(NewData, SizeOf(NewData));
|
||||
//WriteLn('Linereader: ', BytesRead, ' bytes read');
|
||||
if BytesRead <= 0 then begin
|
||||
if FirstRun then
|
||||
NoData;
|
||||
break;
|
||||
end;
|
||||
FirstRun := False;
|
||||
OldBufSize := FBytesInBuffer;
|
||||
|
||||
// Append the new received data to the read buffer
|
||||
Inc(FBytesInBuffer, BytesRead);
|
||||
ReallocMem(RealBuffer, FBytesInBuffer);
|
||||
Move(NewData, RealBuffer[OldBufSize], BytesRead);
|
||||
|
||||
{Process all potential lines in the current buffer. Attention: FBuffer and
|
||||
FBytesInBuffer MUST be updated for each line, as they can be accessed from
|
||||
within the FOnLine handler!}
|
||||
LastEndOfLine := 0;
|
||||
if OldBufSize > 0 then
|
||||
i := OldBufSize - 1
|
||||
else
|
||||
i := 0;
|
||||
|
||||
CurBytesInBuffer := FBytesInBuffer;
|
||||
|
||||
while i <= CurBytesInBuffer - 1 do
|
||||
begin
|
||||
if (RealBuffer[i] = #13) or (RealBuffer[i] = #10) then
|
||||
begin
|
||||
LineLength := i - LastEndOfLine;
|
||||
SetLength(line, LineLength);
|
||||
if LineLength > 0 then
|
||||
Move(RealBuffer[LastEndOfLine], line[1], LineLength);
|
||||
|
||||
if (i < CurBytesInBuffer - 1) and (RealBuffer[i] = #13) and
|
||||
(RealBuffer[i + 1] = #10) then
|
||||
Inc(i);
|
||||
LastEndOfLine := i + 1;
|
||||
|
||||
if Assigned(FOnLine) then
|
||||
begin
|
||||
FBuffer := RealBuffer + LastEndOfLine;
|
||||
FBytesInBuffer := CurBytesInBuffer - LastEndOfLine;
|
||||
FDestroyedFlag := @DestroyedFlag;
|
||||
FOnLine(line);
|
||||
FDestroyedFlag := nil;
|
||||
if DestroyedFlag then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
FBytesInBuffer := CurBytesInBuffer;
|
||||
|
||||
if LastEndOfLine > 0 then
|
||||
begin
|
||||
// Remove all processed lines from the buffer
|
||||
Dec(FBytesInBuffer, LastEndOfLine);
|
||||
GetMem(p, FBytesInBuffer);
|
||||
Move(RealBuffer[LastEndOfLine], p^, FBytesInBuffer);
|
||||
FreeMem(RealBuffer);
|
||||
RealBuffer := p;
|
||||
end;
|
||||
FBuffer := RealBuffer;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TAsyncStreamLineReader
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
function TAsyncStreamLineReader.Read(var ABuffer; count: Integer): Integer;
|
||||
begin
|
||||
Result := FDataStream.Read(ABuffer, count);
|
||||
end;
|
||||
|
||||
procedure TAsyncStreamLineReader.NoData;
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
if (FDataStream = FBlockingStream) or (FDataStream.Position = FDataStream.Size) then
|
||||
begin
|
||||
|
||||
if (FBytesInBuffer > 0) and Assigned(FOnLine) then
|
||||
begin
|
||||
if FBuffer[FBytesInBuffer - 1] in [#13, #10] then
|
||||
Dec(FBytesInBuffer);
|
||||
SetLength(s, FBytesInBuffer);
|
||||
Move(FBuffer^, s[1], FBytesInBuffer);
|
||||
FOnLine(s);
|
||||
end;
|
||||
|
||||
FManager.ClearReadHandler(FBlockingStream.Handle);
|
||||
if Assigned(FOnEOF) then
|
||||
FOnEOF(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAsyncStreamLineReader.StreamDataAvailable(UserData: TObject);
|
||||
begin
|
||||
Run;
|
||||
end;
|
||||
|
||||
constructor TAsyncStreamLineReader.Create(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
begin
|
||||
Self.Create(AManager, AStream, AStream);
|
||||
end;
|
||||
|
||||
constructor TAsyncStreamLineReader.Create(AManager: TAsyncIOManager;
|
||||
ADataStream: TStream; ABlockingStream: THandleStream);
|
||||
begin
|
||||
ASSERT(Assigned(ADataStream) and Assigned(ABlockingStream));
|
||||
|
||||
inherited Create;
|
||||
FManager := AManager;
|
||||
FDataStream := ADataStream;
|
||||
FBlockingStream := ABlockingStream;
|
||||
AManager.SetReadHandler(FBlockingStream.Handle, @StreamDataAvailable, nil);
|
||||
AManager.HandleAsync[FBlockingStream.Handle] := True;
|
||||
end;
|
||||
|
||||
destructor TAsyncStreamLineReader.Destroy;
|
||||
var
|
||||
Handler: TMethod;
|
||||
begin
|
||||
Handler := TMethod(FManager.GetReadHandler(FBlockingStream.Handle));
|
||||
if (Handler.Code = Pointer(@StreamDataAvailable)) and
|
||||
(Handler.Data = Pointer(Self)) then
|
||||
FManager.ClearReadHandler(FBlockingStream.Handle);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TWriteBuffer
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure TWriteBuffer.BufferEmpty;
|
||||
begin
|
||||
if Assigned(FOnBufferEmpty) then
|
||||
FOnBufferEmpty(Self);
|
||||
end;
|
||||
|
||||
constructor TWriteBuffer.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
FBuffer := nil;
|
||||
FBytesInBuffer := 0;
|
||||
EndOfLineMarker := #10;
|
||||
end;
|
||||
|
||||
destructor TWriteBuffer.Destroy;
|
||||
begin
|
||||
if Assigned(FBuffer) then
|
||||
FreeMem(FBuffer);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TWriteBuffer.Seek(Offset: LongInt; Origin: Word): LongInt;
|
||||
begin
|
||||
if ((Offset = 0) and ((Origin = soFromCurrent) or (Origin = soFromEnd))) or
|
||||
((Offset = FBytesInBuffer) and (Origin = soFromBeginning)) then
|
||||
Result := FBytesInBuffer
|
||||
else
|
||||
raise EStreamError.Create('Invalid stream operation');
|
||||
end;
|
||||
|
||||
function TWriteBuffer.Write(const ABuffer; Count: LongInt): LongInt;
|
||||
begin
|
||||
ReallocMem(FBuffer, FBytesInBuffer + Count);
|
||||
Move(ABuffer, FBuffer[FBytesInBuffer], Count);
|
||||
Inc(FBytesInBuffer, Count);
|
||||
WantWrite;
|
||||
Result := Count;
|
||||
end;
|
||||
|
||||
procedure TWriteBuffer.WriteLine(const line: String);
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
s := line + EndOfLineMarker;
|
||||
WriteBuffer(s[1], Length(s));
|
||||
end;
|
||||
|
||||
procedure TWriteBuffer.Run;
|
||||
var
|
||||
CurStart, written: Integer;
|
||||
NewBuf: PChar;
|
||||
failed: Boolean;
|
||||
begin
|
||||
CurStart := 0;
|
||||
failed := True;
|
||||
repeat
|
||||
if FBytesInBuffer = 0 then begin
|
||||
BufferEmpty;
|
||||
exit;
|
||||
end;
|
||||
|
||||
written := DoRealWrite(FBuffer[CurStart], FBytesInBuffer - CurStart);
|
||||
if written > 0 then begin
|
||||
Inc(CurStart, written);
|
||||
failed := False;
|
||||
GetMem(NewBuf, FBytesInBuffer - CurStart);
|
||||
Move(FBuffer[CurStart], NewBuf[0], FBytesInBuffer - CurStart);
|
||||
FreeMem(FBuffer);
|
||||
FBuffer := NewBuf;
|
||||
Dec(FBytesInBuffer, CurStart);
|
||||
end;
|
||||
until written <= 0;
|
||||
|
||||
if failed then
|
||||
WritingFailed;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TAsyncWriteStream
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
function TAsyncWriteStream.DoRealWrite(const ABuffer; Count: Integer): Integer;
|
||||
begin
|
||||
Result := FDataStream.Write(ABuffer, count);
|
||||
end;
|
||||
|
||||
procedure TAsyncWriteStream.WritingFailed;
|
||||
begin
|
||||
if FDataStream <> FBlockingStream then
|
||||
FManager.ClearWriteHandler(FBlockingStream.Handle);
|
||||
end;
|
||||
|
||||
procedure TAsyncWriteStream.WantWrite;
|
||||
begin
|
||||
FManager.SetWriteHandler(FBlockingStream.Handle, @CanWrite, nil);
|
||||
end;
|
||||
|
||||
procedure TAsyncWriteStream.BufferEmpty;
|
||||
begin
|
||||
FManager.ClearWriteHandler(FBlockingStream.Handle);
|
||||
inherited BufferEmpty;
|
||||
end;
|
||||
|
||||
procedure TAsyncWriteStream.CanWrite(UserData: TObject);
|
||||
begin
|
||||
Run;
|
||||
end;
|
||||
|
||||
constructor TAsyncWriteStream.Create(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
begin
|
||||
Self.Create(AManager, AStream, AStream);
|
||||
end;
|
||||
|
||||
constructor TAsyncWriteStream.Create(AManager: TAsyncIOManager;
|
||||
ADataStream: TStream; ABlockingStream: THandleStream);
|
||||
begin
|
||||
ASSERT(Assigned(ADataStream) and Assigned(ABlockingStream));
|
||||
|
||||
inherited Create;
|
||||
FManager := AManager;
|
||||
FDataStream := ADataStream;
|
||||
FBlockingStream := ABlockingStream;
|
||||
AManager.HandleAsync[FBlockingStream.Handle] := True;
|
||||
end;
|
||||
|
||||
destructor TAsyncWriteStream.Destroy;
|
||||
begin
|
||||
FManager.ClearWriteHandler(FBlockingStream.Handle);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-24 22:29:37 sg
|
||||
* Line reader now reports a read line after a single #10 at the end of the
|
||||
current input buffer
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:58 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
637
fcl/inc/http.pp
637
fcl/inc/http.pp
@ -1,637 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
|
||||
HTTP: Classes for dealing with HTTP requests
|
||||
Copyright (C) 2000 by Sebastian Guenther (sg@freepascal.org)
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
}
|
||||
|
||||
|
||||
{$MODE objfpc}
|
||||
{$H+}
|
||||
|
||||
unit HTTP;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes, AsyncIO, SSockets;
|
||||
|
||||
const
|
||||
|
||||
fieldAccept = 'Accept';
|
||||
fieldAcceptCharset = 'Accept-Charset';
|
||||
fieldAcceptEncoding = 'Accept-Encoding';
|
||||
fieldAcceptLanguage = 'Accept-Language';
|
||||
fieldAuthorization = 'Authorization';
|
||||
fieldContentEncoding = 'Content-Encoding';
|
||||
fieldContentLanguage = 'Content-Language';
|
||||
fieldContentLength = 'Content-Length';
|
||||
fieldContentType = 'Content-Type';
|
||||
fieldCookie = 'Cookie';
|
||||
fieldDate = 'Date';
|
||||
fieldExpires = 'Expires';
|
||||
fieldFrom = 'From';
|
||||
fieldIfModifiedSince = 'If-Modified-Since';
|
||||
fieldLastModified = 'Last-Modified';
|
||||
fieldLocation = 'Location';
|
||||
fieldPragma = 'Pragma';
|
||||
fieldReferer = 'Referer';
|
||||
fieldRetryAfter = 'Retry-After';
|
||||
fieldServer = 'Server';
|
||||
fieldSetCookie = 'Set-Cookie';
|
||||
fieldUserAgent = 'User-Agent';
|
||||
fieldWWWAuthenticate = 'WWW-Authenticate';
|
||||
|
||||
type
|
||||
|
||||
PHttpField = ^THttpField;
|
||||
THttpField = record
|
||||
Name, Value: String;
|
||||
end;
|
||||
|
||||
|
||||
THttpHeader = class
|
||||
protected
|
||||
FReader: TAsyncStreamLineReader;
|
||||
FWriter: TAsyncWriteStream;
|
||||
FOnCompleted: TNotifyEvent;
|
||||
FFields: TList;
|
||||
CmdReceived: Boolean;
|
||||
|
||||
procedure ParseFirstHeaderLine(const line: String); virtual; abstract;
|
||||
procedure LineReceived(const line: String);
|
||||
function GetFirstHeaderLine: String; virtual; abstract;
|
||||
procedure WriterCompleted(ASender: TObject);
|
||||
|
||||
function GetFieldCount: Integer;
|
||||
function GetFields(AIndex: Integer): String;
|
||||
function GetFieldNames(AIndex: Integer): String;
|
||||
procedure SetFieldNames(AIndex: Integer; const AName: String);
|
||||
function GetFieldValues(AIndex: Integer): String;
|
||||
procedure SetFieldValues(AIndex: Integer; const AValue: String);
|
||||
|
||||
|
||||
function GetAccept: String;
|
||||
procedure SetAccept(const AValue: String);
|
||||
function GetAcceptCharset: String;
|
||||
procedure SetAcceptCharset(const AValue: String);
|
||||
function GetAcceptEncoding: String;
|
||||
procedure SetAcceptEncoding(const AValue: String);
|
||||
function GetAcceptLanguage: String;
|
||||
procedure SetAcceptLanguage(const AValue: String);
|
||||
function GetAuthorization: String;
|
||||
procedure SetAuthorization(const AValue: String);
|
||||
function GetContentEncoding: String;
|
||||
procedure SetContentEncoding(const AValue: String);
|
||||
function GetContentLanguage: String;
|
||||
procedure SetContentLanguage(const AValue: String);
|
||||
function GetContentLength: Integer;
|
||||
procedure SetContentLength(AValue: Integer);
|
||||
function GetContentType: String;
|
||||
procedure SetContentType(const AValue: String);
|
||||
function Get_Cookie: String;
|
||||
procedure Set_Cookie(const AValue: String);
|
||||
function GetDate: String;
|
||||
procedure SetDate(const AValue: String);
|
||||
function GetExpires: String;
|
||||
procedure SetExpires(const AValue: String);
|
||||
function GetFrom: String;
|
||||
procedure SetFrom(const AValue: String);
|
||||
function GetIfModifiedSince: String;
|
||||
procedure SetIfModifiedSince(const AValue: String);
|
||||
function GetLastModified: String;
|
||||
procedure SetLastModified(const AValue: String);
|
||||
function GetLocation: String;
|
||||
procedure SetLocation(const AValue: String);
|
||||
function GetPragma: String;
|
||||
procedure SetPragma(const AValue: String);
|
||||
function GetReferer: String;
|
||||
procedure SetReferer(const AValue: String);
|
||||
function GetRetryAfter: String;
|
||||
procedure SetRetryAfter(const AValue: String);
|
||||
function GetServer: String;
|
||||
procedure SetServer(const AValue: String);
|
||||
function Get_SetCookie: String;
|
||||
procedure Set_SetCookie(const AValue: String);
|
||||
function GetUserAgent: String;
|
||||
procedure SetUserAgent(const AValue: String);
|
||||
function GetWWWAuthenticate: String;
|
||||
procedure SetWWWAuthenticate(const AValue: String);
|
||||
|
||||
public
|
||||
HttpVersion: String;
|
||||
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure SetFieldByName(const AName, AValue: String);
|
||||
function GetFieldByName(const AName: String): String;
|
||||
|
||||
procedure AsyncSend(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
procedure AsyncReceive(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
|
||||
property Reader: TAsyncStreamLineReader read FReader;
|
||||
property Writer: TAsyncWriteStream read FWriter;
|
||||
property FieldCount: Integer read GetFieldCount;
|
||||
property Fields[AIndex: Integer]: String read GetFields;
|
||||
property FieldNames[AIndex: Integer]: String read GetFieldNames write SetFieldNames;
|
||||
property FieldValues[AIndex: Integer]: String read GetFieldValues write SetFieldValues;
|
||||
|
||||
property OnCompleted: TNotifyEvent read FOnCompleted write FOnCompleted;
|
||||
|
||||
property Accept: String read GetAccept write SetAccept;
|
||||
property AcceptCharset: String read GetAcceptCharset write SetAcceptCharset;
|
||||
property AcceptEncoding: String read GetAcceptEncoding write SetAcceptEncoding;
|
||||
property AcceptLanguage: String read GetAcceptLanguage write SetAcceptLanguage;
|
||||
property Authorization: String read GetAuthorization write SetAuthorization;
|
||||
property ContentEncoding: String read GetContentEncoding write SetContentEncoding;
|
||||
property ContentLanguage: String read GetContentLanguage write SetContentLanguage;
|
||||
property ContentLength: Integer read GetContentLength write SetContentLength;
|
||||
property ContentType: String read GetContentType write SetContentType;
|
||||
property Cookie: String read Get_Cookie write Set_Cookie;
|
||||
property Date: String read GetDate write SetDate;
|
||||
property Expires: String read GetExpires write SetExpires;
|
||||
property From: String read GetFrom write SetFrom;
|
||||
property IfModifiedSince: String read GetIfModifiedSince write SetIfModifiedSince;
|
||||
property LastModified: String read GetLastModified write SetLastModified;
|
||||
property Location: String read GetLocation write SetLocation;
|
||||
property Pragma: String read GetPragma write SetPragma;
|
||||
property Referer: String read GetReferer write SetReferer;
|
||||
property RetryAfter: String read GetRetryAfter write SetRetryAfter;
|
||||
property Server: String read GetServer write SetServer;
|
||||
property SetCookie: String read Get_SetCookie write Set_SetCookie;
|
||||
property UserAgent: String read GetUserAgent write SetUserAgent;
|
||||
property WWWAuthenticate: String read GetWWWAuthenticate write SetWWWAuthenticate;
|
||||
end;
|
||||
|
||||
|
||||
THttpRequestHeader = class(THttpHeader)
|
||||
protected
|
||||
procedure ParseFirstHeaderLine(const line: String); override;
|
||||
function GetFirstHeaderLine: String; override;
|
||||
public
|
||||
CommandLine: String;
|
||||
Command: String;
|
||||
URI: String; // Uniform Resource Identifier
|
||||
end;
|
||||
|
||||
|
||||
THttpAnswerHeader = class(THttpHeader)
|
||||
protected
|
||||
procedure ParseFirstHeaderLine(const line: String); override;
|
||||
function GetFirstHeaderLine: String; override;
|
||||
public
|
||||
Code: Integer;
|
||||
CodeText: String;
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
|
||||
TCustomHttpConnection = class
|
||||
protected
|
||||
FManager: TAsyncIOManager;
|
||||
FSocket: TInetSocket;
|
||||
SendBuffer: TAsyncWriteStream;
|
||||
FOnHeaderSent, FOnStreamSent, FOnHeaderReceived, FOnStreamReceived: TNotifyEvent;
|
||||
RecvSize: Integer; // How many bytes are still to be read. -1 if unknown.
|
||||
|
||||
procedure HeaderToSendCompleted(Sender: TObject);
|
||||
procedure StreamToSendCompleted(Sender: TObject);
|
||||
procedure ReceivedHeaderCompleted(Sender: TObject);
|
||||
procedure DataAvailable(Sender: TObject);
|
||||
procedure ReceivedStreamCompleted(Sender: TObject);
|
||||
|
||||
property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
|
||||
property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
|
||||
property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
|
||||
property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
|
||||
|
||||
public
|
||||
HeaderToSend: THttpHeader;
|
||||
StreamToSend: TStream;
|
||||
ReceivedHeader: THttpHeader;
|
||||
ReceivedStream: TStream;
|
||||
|
||||
constructor Create(AManager: TAsyncIOManager; ASocket: TInetSocket);
|
||||
destructor Destroy; override;
|
||||
procedure Start;
|
||||
end;
|
||||
|
||||
THttpConnection = class(TCustomHttpConnection)
|
||||
public
|
||||
property OnHeaderSent;
|
||||
property OnStreamSent;
|
||||
property OnHeaderReceived;
|
||||
property OnStreamReceived;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// ===================================================================
|
||||
// ===================================================================
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// THttpHeader
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure THttpHeader.LineReceived(const line: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if Length(line) = 0 then
|
||||
begin
|
||||
FReader.OnLine := nil; // Stop receiving
|
||||
if Assigned(FOnCompleted) then
|
||||
FOnCompleted(Self);
|
||||
FReader.Free;
|
||||
FReader := nil;
|
||||
end else
|
||||
if not CmdReceived then
|
||||
begin
|
||||
CmdReceived := True;
|
||||
ParseFirstHeaderLine(line);
|
||||
end else
|
||||
begin
|
||||
i := Pos(':', line);
|
||||
SetFieldByName(Trim(Copy(line, 1, i - 1)), Trim(Copy(line, i + 1, Length(line))));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THttpHeader.WriterCompleted(ASender: TObject);
|
||||
begin
|
||||
if Assigned(FOnCompleted) then
|
||||
FOnCompleted(Self);
|
||||
end;
|
||||
|
||||
function THttpHeader.GetFieldCount: Integer;
|
||||
begin
|
||||
Result := FFields.Count;
|
||||
end;
|
||||
|
||||
function THttpHeader.GetFields(AIndex: Integer): String;
|
||||
begin
|
||||
Result := FieldNames[AIndex] + ': ' + FieldValues[AIndex];
|
||||
end;
|
||||
|
||||
function THttpHeader.GetFieldNames(AIndex: Integer): String;
|
||||
begin
|
||||
Result := PHttpField(FFields.Items[AIndex])^.Name;
|
||||
end;
|
||||
|
||||
procedure THttpHeader.SetFieldNames(AIndex: Integer; const AName: String);
|
||||
begin
|
||||
PHttpField(FFields.Items[AIndex])^.Name := AName;
|
||||
end;
|
||||
|
||||
function THttpHeader.GetFieldValues(AIndex: Integer): String;
|
||||
begin
|
||||
Result := PHttpField(FFields.Items[AIndex])^.Value;
|
||||
end;
|
||||
|
||||
procedure THttpHeader.SetFieldValues(AIndex: Integer; const AValue: String);
|
||||
begin
|
||||
PHttpField(FFields.Items[AIndex])^.Name := AValue;
|
||||
end;
|
||||
|
||||
function THttpHeader.GetAccept: String; begin Result := GetFieldByName(fieldAccept) end;
|
||||
procedure THttpHeader.SetAccept(const AValue: String); begin SetFieldByName(fieldAccept, AValue) end;
|
||||
function THttpHeader.GetAcceptCharset: String; begin Result := GetFieldByName(fieldAcceptCharset) end;
|
||||
procedure THttpHeader.SetAcceptCharset(const AValue: String); begin SetFieldByName(fieldAcceptCharset, AValue) end;
|
||||
function THttpHeader.GetAcceptEncoding: String; begin Result := GetFieldByName(fieldAcceptEncoding) end;
|
||||
procedure THttpHeader.SetAcceptEncoding(const AValue: String); begin SetFieldByName(fieldAcceptEncoding, AValue) end;
|
||||
function THttpHeader.GetAcceptLanguage: String; begin Result := GetFieldByName(fieldAcceptLanguage) end;
|
||||
procedure THttpHeader.SetAcceptLanguage(const AValue: String); begin SetFieldByName(fieldAcceptLanguage, AValue) end;
|
||||
function THttpHeader.GetAuthorization: String; begin Result := GetFieldByName(fieldAuthorization) end;
|
||||
procedure THttpHeader.SetAuthorization(const AValue: String); begin SetFieldByName(fieldAuthorization, AValue) end;
|
||||
function THttpHeader.GetContentEncoding: String; begin Result := GetFieldByName(fieldContentEncoding) end;
|
||||
procedure THttpHeader.SetContentEncoding(const AValue: String); begin SetFieldByName(fieldContentEncoding, AValue) end;
|
||||
function THttpHeader.GetContentLanguage: String; begin Result := GetFieldByName(fieldContentLanguage) end;
|
||||
procedure THttpHeader.SetContentLanguage(const AValue: String); begin SetFieldByName(fieldContentLanguage, AValue) end;
|
||||
function THttpHeader.GetContentLength: Integer; var s: String; begin s := GetFieldByName(fieldContentLength); if Length(s) = 0 then Result := -1 else Result := StrToInt(s) end;
|
||||
procedure THttpHeader.SetContentLength(AValue: Integer); begin SetFieldByName(fieldContentLength, IntToStr(AValue)) end;
|
||||
function THttpHeader.GetContentType: String; begin Result := GetFieldByName(fieldContentType) end;
|
||||
procedure THttpHeader.SetContentType(const AValue: String); begin SetFieldByName(fieldContentType, AValue) end;
|
||||
function THttpHeader.Get_Cookie: String; begin Result := GetFieldByName(fieldCookie) end;
|
||||
procedure THttpHeader.Set_Cookie(const AValue: String); begin SetFieldByName(fieldCookie, AValue) end;
|
||||
function THttpHeader.GetDate: String; begin Result := GetFieldByName(fieldDate) end;
|
||||
procedure THttpHeader.SetDate(const AValue: String); begin SetFieldByName(fieldDate, AValue) end;
|
||||
function THttpHeader.GetExpires: String; begin Result := GetFieldByName(fieldExpires) end;
|
||||
procedure THttpHeader.SetExpires(const AValue: String); begin SetFieldByName(fieldExpires, AValue) end;
|
||||
function THttpHeader.GetFrom: String; begin Result := GetFieldByName(fieldFrom) end;
|
||||
procedure THttpHeader.SetFrom(const AValue: String); begin SetFieldByName(fieldFrom, AValue) end;
|
||||
function THttpHeader.GetIfModifiedSince: String; begin Result := GetFieldByName(fieldIfModifiedSince) end;
|
||||
procedure THttpHeader.SetIfModifiedSince(const AValue: String); begin SetFieldByName(fieldIfModifiedSince, AValue) end;
|
||||
function THttpHeader.GetLastModified: String; begin Result := GetFieldByName(fieldLastModified) end;
|
||||
procedure THttpHeader.SetLastModified(const AValue: String); begin SetFieldByName(fieldLastModified, AValue) end;
|
||||
function THttpHeader.GetLocation: String; begin Result := GetFieldByName(fieldLocation) end;
|
||||
procedure THttpHeader.SetLocation(const AValue: String); begin SetFieldByName(fieldLocation, AValue) end;
|
||||
function THttpHeader.GetPragma: String; begin Result := GetFieldByName(fieldPragma) end;
|
||||
procedure THttpHeader.SetPragma(const AValue: String); begin SetFieldByName(fieldPragma, AValue) end;
|
||||
function THttpHeader.GetReferer: String; begin Result := GetFieldByName(fieldReferer) end;
|
||||
procedure THttpHeader.SetReferer(const AValue: String); begin SetFieldByName(fieldReferer, AValue) end;
|
||||
function THttpHeader.GetRetryAfter: String; begin Result := GetFieldByName(fieldRetryAfter) end;
|
||||
procedure THttpHeader.SetRetryAfter(const AValue: String); begin SetFieldByName(fieldRetryAfter, AValue) end;
|
||||
function THttpHeader.GetServer: String; begin Result := GetFieldByName(fieldServer) end;
|
||||
procedure THttpHeader.SetServer(const AValue: String); begin SetFieldByName(fieldServer, AValue) end;
|
||||
function THttpHeader.Get_SetCookie: String; begin Result := GetFieldByName(fieldSetCookie) end;
|
||||
procedure THttpHeader.Set_SetCookie(const AValue: String); begin SetFieldByName(fieldSetCookie, AValue) end;
|
||||
function THttpHeader.GetUserAgent: String; begin Result := GetFieldByName(fieldUserAgent) end;
|
||||
procedure THttpHeader.SetUserAgent(const AValue: String); begin SetFieldByName(fieldUserAgent, AValue) end;
|
||||
function THttpHeader.GetWWWAuthenticate: String; begin Result := GetFieldByName(fieldWWWAuthenticate) end;
|
||||
procedure THttpHeader.SetWWWAuthenticate(const AValue: String); begin SetFieldByName(fieldWWWAuthenticate, AValue) end;
|
||||
|
||||
constructor THttpHeader.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FFields := TList.Create;
|
||||
HttpVersion := '1.0';
|
||||
end;
|
||||
|
||||
destructor THttpHeader.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
field: PHttpField;
|
||||
begin
|
||||
FReader.Free;
|
||||
FWriter.Free;
|
||||
for i := 0 to FFields.Count - 1 do begin
|
||||
field := PHttpField(FFields.Items[i]);
|
||||
SetLength(field^.Name, 0);
|
||||
SetLength(field^.Value, 0);
|
||||
Dispose(field);
|
||||
end;
|
||||
FFields.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function THttpHeader.GetFieldByName(const AName: String): String;
|
||||
var
|
||||
i: Integer;
|
||||
name: String;
|
||||
begin
|
||||
name := UpperCase(AName);
|
||||
for i := 0 to FFields.Count - 1 do
|
||||
if UpperCase(FieldNames[i]) = name then begin
|
||||
Result := FieldValues[i];
|
||||
exit;
|
||||
end;
|
||||
SetLength(Result, 0);
|
||||
end;
|
||||
|
||||
procedure THttpHeader.SetFieldByName(const AName, AValue: String);
|
||||
var
|
||||
i: Integer;
|
||||
name: String;
|
||||
field: PHttpField;
|
||||
begin
|
||||
name := UpperCase(AName);
|
||||
for i := 0 to FFields.Count - 1 do
|
||||
if UpperCase(FieldNames[i]) = name then begin
|
||||
FieldNames[i] := AName; // preserve case
|
||||
FieldValues[i] := AValue;
|
||||
exit;
|
||||
end;
|
||||
New(field);
|
||||
FillChar(field^, SizeOf(field^), 0);
|
||||
field^.Name := AName;
|
||||
field^.Value := AValue;
|
||||
FFields.Add(field);
|
||||
end;
|
||||
|
||||
procedure THttpHeader.AsyncSend(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
FWriter.Free;
|
||||
FWriter := TAsyncWriteStream.Create(AManager, AStream);
|
||||
FWriter.OnBufferEmpty := @WriterCompleted;
|
||||
FWriter.EndOfLineMarker := #13#10;
|
||||
FWriter.WriteLine(GetFirstHeaderLine);
|
||||
for i := 0 to FFields.Count - 1 do
|
||||
FWriter.WriteLine(Fields[i]);
|
||||
FWriter.WriteLine('');
|
||||
end;
|
||||
|
||||
procedure THttpHeader.AsyncReceive(AManager: TAsyncIOManager; AStream: THandleStream);
|
||||
begin
|
||||
CmdReceived := False;
|
||||
FReader.Free;
|
||||
FReader := TAsyncStreamLineReader.Create(AManager, AStream);
|
||||
FReader.OnLine := @LineReceived;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// THttpRequestHeader
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure THttpRequestHeader.ParseFirstHeaderLine(const line: String);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
CommandLine := line;
|
||||
i := Pos(' ', line);
|
||||
Command := Copy(line, 1, i - 1);
|
||||
URI := Copy(line, i + 1, Length(line));
|
||||
i := Pos(' ', URI);
|
||||
if i > 0 then begin
|
||||
HttpVersion := Copy(URI, i + 1, Length(URI));
|
||||
URI := Copy(URI, 1, i - 1);
|
||||
HttpVersion := Copy(HttpVersion, Pos('/', HttpVersion) + 1, Length(HttpVersion));
|
||||
end;
|
||||
end;
|
||||
|
||||
function THttpRequestHeader.GetFirstHeaderLine: String;
|
||||
begin
|
||||
Result := Command + ' ' + URI;
|
||||
if Length(HttpVersion) > 0 then
|
||||
Result := Result + ' HTTP/' + HttpVersion;
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// THttpAnswerHeader
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure THttpAnswerHeader.ParseFirstHeaderLine(const line: String);
|
||||
var
|
||||
i: Integer;
|
||||
s: String;
|
||||
begin
|
||||
i := Pos('/', line);
|
||||
s := Copy(line, i + 1, Length(line));
|
||||
i := Pos(' ', s);
|
||||
HttpVersion := Copy(s, 1, i - 1);
|
||||
s := Copy(s, i + 1, Length(s));
|
||||
i := Pos(' ', s);
|
||||
if i > 0 then begin
|
||||
CodeText := Copy(s, i + 1, Length(s));
|
||||
s := Copy(s, 1, i - 1);
|
||||
end;
|
||||
Code := StrToInt(s);
|
||||
end;
|
||||
|
||||
function THttpAnswerHeader.GetFirstHeaderLine: String;
|
||||
begin
|
||||
Result := Format('HTTP/%s %d %s', [HttpVersion, Code, CodeText]);
|
||||
end;
|
||||
|
||||
constructor THttpAnswerHeader.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Code := 200;
|
||||
CodeText := 'OK';
|
||||
end;
|
||||
|
||||
|
||||
// -------------------------------------------------------------------
|
||||
// TCustomHttpConnection
|
||||
// -------------------------------------------------------------------
|
||||
|
||||
procedure TCustomHttpConnection.HeaderToSendCompleted(Sender: TObject);
|
||||
begin
|
||||
//WriteLn('TCustomHttpConnection.HeaderToSendCompleted');
|
||||
if Assigned(FOnHeaderSent) then
|
||||
FOnHeaderSent(Self);
|
||||
if Assigned(StreamToSend) then begin
|
||||
SendBuffer := TAsyncWriteStream.Create(FManager, FSocket);
|
||||
SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
|
||||
SendBuffer.OnBufferEmpty := @StreamToSendCompleted;
|
||||
SendBuffer.Run;
|
||||
end else
|
||||
StreamToSendCompleted(nil);
|
||||
end;
|
||||
|
||||
procedure TCustomHttpConnection.StreamToSendCompleted(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnStreamSent) then
|
||||
FOnStreamSent(Self);
|
||||
//WriteLn('TCustomHttpConnection.StreamToSendCompleted');
|
||||
SendBuffer.Free;
|
||||
SendBuffer := nil;
|
||||
end;
|
||||
|
||||
procedure TCustomHttpConnection.ReceivedHeaderCompleted(Sender: TObject);
|
||||
var
|
||||
BytesInBuffer: Integer;
|
||||
begin
|
||||
//WriteLn('TCustomHttpConnection.ReceivedHeaderCompleted');
|
||||
BytesInBuffer := ReceivedHeader.Reader.BytesInBuffer;
|
||||
//WriteLn('BytesInBuffer: ', BytesInBuffer, ', Content length: ', ReceivedHeader.ContentLength);
|
||||
if Assigned(FOnHeaderReceived) then
|
||||
FOnHeaderReceived(Self);
|
||||
RecvSize := ReceivedHeader.ContentLength;
|
||||
if Assigned(ReceivedStream) then
|
||||
begin
|
||||
if BytesInBuffer > 0 then
|
||||
begin
|
||||
ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
|
||||
if RecvSize > 0 then
|
||||
Dec(RecvSize, BytesInBuffer);
|
||||
if BytesInBuffer = ReceivedHeader.ContentLength then
|
||||
begin
|
||||
ReceivedStreamCompleted(nil);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
FManager.SetReadHandler(FSocket.Handle, @DataAvailable, nil);
|
||||
end else
|
||||
ReceivedStreamCompleted(nil);
|
||||
end;
|
||||
|
||||
procedure TCustomHttpConnection.DataAvailable(Sender: TObject);
|
||||
var
|
||||
FirstRun: Boolean;
|
||||
ReadNow, BytesRead: Integer;
|
||||
buf: array[0..1023] of Byte;
|
||||
begin
|
||||
FirstRun := True;
|
||||
while True do
|
||||
begin
|
||||
if RecvSize >= 0 then
|
||||
begin
|
||||
ReadNow := RecvSize;
|
||||
if ReadNow > 1024 then
|
||||
ReadNow := 1024;
|
||||
end else
|
||||
ReadNow := 1024;
|
||||
BytesRead := FSocket.Read(buf, ReadNow);
|
||||
//WriteLn('TCustomHttpConnection.DataAvailable: Read ', BytesRead, ' bytes; RecvSize=', RecvSize);
|
||||
if BytesRead <= 0 then
|
||||
begin
|
||||
if FirstRun then
|
||||
ReceivedStreamCompleted(nil);
|
||||
break;
|
||||
end;
|
||||
FirstRun := False;
|
||||
ReceivedStream.Write(buf, BytesRead);
|
||||
if RecvSize > 0 then
|
||||
Dec(RecvSize, BytesRead);
|
||||
if RecvSize = 0 then
|
||||
begin
|
||||
ReceivedStreamCompleted(nil);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomHttpConnection.ReceivedStreamCompleted(Sender: TObject);
|
||||
begin
|
||||
//WriteLn('TCustomHttpConnection.ReceivedStreamCompleted');
|
||||
if Assigned(FOnStreamReceived) then
|
||||
FOnStreamReceived(Self);
|
||||
FManager.ClearReadHandler(FSocket.Handle);
|
||||
end;
|
||||
|
||||
constructor TCustomHttpConnection.Create(AManager: TAsyncIOManager; ASocket: TInetSocket);
|
||||
begin
|
||||
inherited Create;
|
||||
FManager := AManager;
|
||||
FSocket := ASocket;
|
||||
end;
|
||||
|
||||
destructor TCustomHttpConnection.Destroy;
|
||||
begin
|
||||
FManager.ClearReadHandler(FSocket.Handle);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomHttpConnection.Start;
|
||||
begin
|
||||
// Start receiver
|
||||
if Assigned(ReceivedHeader) then begin
|
||||
ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
|
||||
ReceivedHeader.AsyncReceive(FManager, FSocket);
|
||||
end;
|
||||
|
||||
// Start sender
|
||||
if Assigned(HeaderToSend) then begin
|
||||
// Set the 'Content-Length' field automatically, if possible
|
||||
if (HeaderToSend.ContentLength = -1) and Assigned(StreamToSend) then
|
||||
HeaderToSend.ContentLength := StreamToSend.Size;
|
||||
|
||||
HeaderToSend.OnCompleted := @HeaderToSendCompleted;
|
||||
HeaderToSend.AsyncSend(FManager, FSocket)
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:59 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user