|
@@ -0,0 +1,637 @@
|
|
|
|
+{
|
|
|
|
+ $Id$
|
|
|
|
+
|
|
|
|
+ HTTP: Classes for dealing with HTTP requests
|
|
|
|
+ Copyright (C) 2000 by Sebastian Guenther ([email protected])
|
|
|
|
+
|
|
|
|
+ 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.3 2002-09-07 15:15:24 peter
|
|
|
|
+ * old logs removed and tabs fixed
|
|
|
|
+
|
|
|
|
+}
|