dnhttpparser.pas

一个国外比较早的IOCP控件

// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1.1.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
unit DnHttpParser;
interface
uses  SysUtils, Windows, Classes, contnrs,
      DnRtl, DnConst;

type

  TDnHttpParser = class(TObject)
  protected
    FHttpData: String;
    FHttpVersion: String;
    FMethodName: String;
    FMethodURL: String;
    FHttpResponseCode: Integer;
    FHttpResponseReason: String;
    FNames: TStringList;
    FValues: TStringList;
    
    class function  ExtractLine(var Data: String): String;
    class procedure ExtractPair(var Data: String; var LeftPart, RightPart: String);
    class procedure StripSpaces(var Data: String);
    class function  Skip1Space(const S: String; StartWith: Integer): Integer;
    class function  Skip1Colon(const S: String; StartWith: Integer): Integer;
    class function  GetWord(const S: String; StartWith: Integer; var Lexem: String): Integer;
    class function  GetIntLexem(const S: String; StartWith: Integer; var Lexem: String): Integer;
    procedure ParseHttpHeaders(S: String);
    function  AssembleHttpHeaders: String;

    function  GetHttpHeader(const Name: String): String;
    procedure SetHttpHeader(const Name, Value: String);

  public
    constructor Create;
    destructor  Destroy; override;
    procedure   Clear;
    procedure   ParseResponse(const HttpData: String);
    procedure   ParseRequest(const HttpData: String);
    function    AssembleResponse: String;
    function    AssembleRequest: String;

    class function  IsAbsoluteUrl(const Url: String): Boolean;

    class procedure ParseAbsoluteUrl(const Url: String;
        var Protocol, User, Password, Host, Port, Path,
        Query: String; var UserExists, PasswordExists: Boolean); overload;

    class procedure ParseRelativeUrl(const Url: String; var Path, Query: String);
    class procedure ParseHttpTime(const S: String; StartWith: Integer;
        var FinishWith: Integer;
        var Year, Month, Day, DayOfWeek, Hour, Minute, Second: Integer;
        var TimeZone: String);
    class function  FormatHttpTime(Year, Month, Day, DayOfWeek, Hour,
        Minute, Second: Integer;
        TimeZone: String): String;
    class procedure ParseResponseContentType(const S: String; var ContentType: String;
        var CharSet: String);
    class function  ParseAcceptList(const S: String): TStringList;
    class function  AdjustSlash(const S: String): String;
    property  HttpMethodName: String read FMethodName write FMethodName;
    property  HttpMethodURL: String read FMethodURL write FMethodURL;
    property  HttpVersion: String read FHttpVersion write FHttpVersion;
    property  HttpHeader[const Name: String]: String read GetHttpHeader write SetHttpHeader;
    property  HttpCode: Integer read FHttpResponseCode write FHttpResponseCode;
    property  HttpReason: String read FHttpResponseReason write FHttpResponseReason;
  end;

  
implementation
const
  CRLF: String = #13#10;
  ShortWeekDays: array[0..6] of String =
    ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  LongWeekDays: array[0..6] of String =
    ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday' );
    
  MonthNames: array[1..12] of String = ('Jan', 'Feb', 'Mar', 'Apr',
                                        'May', 'Jun', 'Jul', 'Aug',
                                        'Sep', 'Oct', 'Nov', 'Dec');


//---------------------------------------------------------------------------
//---------------------------------------------------------------------------

class function  TDnHttpParser.Skip1Space(const S: String; StartWith: Integer): Integer;
var i: Integer;
begin
  i := StartWith;
  if (i < Length(S)) and (S[i] = ' ') then
    Result := i + 1
  else
    raise EDnException.Create(ErrCannotParseHttpHeader, 0, S);
end;

class function  TDnHttpParser.Skip1Colon(const S: String; StartWith: Integer): Integer;
var i: Integer;
begin
  i := StartWith;
  if (i < Length(S)) and (S[i] = ':') then
    Result := i + 1
  else
    raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
end;

class function  TDnHttpParser.GetWord(const S: String; StartWith: Integer; var Lexem: String): Integer;
var i, len: Integer;
begin
  i := StartWith; len := Length(S);
  while (i<=len) and (S[i] in ['A'..'Z','a'..'z']) do
    Inc(i);
  Lexem := Copy(S, StartWith, i-StartWith);
  Result := i;
end;

class function  TDnHttpParser.GetIntLexem(const S: String; StartWith: Integer; var Lexem: String): Integer;
var i, len: Integer;
begin
  i := StartWith; len := Length(S);
  while (i<=len) and ((S[i] in ['0'..'9']) or ((S[i] in ['-', '+']) and (i = StartWith))) do
    Inc(i);
  Lexem := Copy(S, StartWith, i-StartWith);
  Result := i;
end;

class procedure TDnHttpParser.ParseResponseContentType(const S: String; var ContentType: String;
                                                      var CharSet: String);
var semicolon: Integer;
begin
  semicolon := Pos(';', S);
  if semicolon <> 0 then
  begin
    ContentType := Copy(S, 1, semicolon-1);
    CharSet := Copy(S, semicolon+1, Length(S) - semicolon);
  end else
  begin
    ContentType := Copy(S, 1, Length(S));
    CharSet := 'us-ascii';
  end;
  ContentType := Trim(ContentType); CharSet := Trim(CharSet);
end;

class function  TDnHttpParser.ParseAcceptList(const S: String): TStringList;
begin
  Result := TStringList.Create;
end;

class function  TDnHttpParser.AdjustSlash(const S: String): String;
var i: Integer;
begin
  Result := S;
  for i:=1 to Length(S) do
    if Result[i] = '/' then
      Result[i] := '\'; 
end;

class procedure TDnHttpParser.ParseHttpTime(const S: String; StartWith: Integer;
                                            var FinishWith: Integer;
                                            var Year, Month, Day, DayOfWeek, Hour,
                                            Minute, Second: Integer;
                                            var TimeZone: String);
var i, len, j, lexemLen, TimeKind: Integer;
    Lexem: String;
begin
  i := StartWith; len := Length(S);
  i := GetWord(S, i, Lexem); lexemLen := i - StartWith;

  if lexemLen > 3 then
    TimeKind := 2 //RFC 850
  else if (i <= len) and (S[i] = ',') and (lexemLen = 3) then
    TimeKind := 1 //RFC 822
  else if (i <= len) and (S[i] = ' ') and (lexemLen = 3) then
    TimeKind := 3 //asctime
  else if lexemLen = 0 then
    TimeKind := 4 //number of seconds
  else
    raise EDnException.Create(ErrCannotParseHttpTime, 0, S);

  case TimeKind of
    1:  begin //RFC 822
          //find a number of week day
          j := 0;
          while (j < 7) and (ShortWeekDays[j] <> Lexem) do
            Inc(j);
          if j = 7 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          DayOfWeek := j;

          Inc(i); //skip a comma
          //find a number of day (in month)
          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Day := StrToInt(Lexem);
          if Day > 31 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);

          i := Skip1Space(S, i);
          i := GetWord(S, i, Lexem);
          j := 1;
          while (j<13) and (MonthNames[j] <> Lexem) do
            Inc(j);
          if j = 13 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          Month := j;

          //find a year
          i := Skip1Space(S, i);
          i := GetIntLexem(S, i, Lexem);
          Year := StrToInt(Lexem);

          //find a hour
          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Hour := StrToInt(Lexem);

          //find a minute
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Minute := StrToInt(Lexem);

          //find a second
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Second := StrToInt(Lexem);

          i := Skip1Space(S, i); i := GetWord(S, i, Lexem);
          TimeZone := Lexem;
          FinishWith := i-1;
        end;
    2:  begin //RFC 850
          //find a number of week day
          j := 0;
          while (j < 7) and (LongWeekDays[j] <> Lexem) do
            Inc(j);
          if j = 7 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          DayOfWeek := j;

          Inc(i); //skip a comma
          //find a number of day (in month)
          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Day := StrToInt(Lexem);
          if Day > 31 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);

          Inc(i);//skip a '-'
          i := GetWord(S, i, Lexem);
          j := 1;
          while (j<13) and (MonthNames[j] <> Lexem) do
            Inc(j);
          if j = 13 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          Month := j;
          Inc(i);//skip a '-'
          i := GetIntLexem(S, i, Lexem);
          Year := StrToInt(Lexem);
          //Y2K problem
          if Year > 35 then
            Year := Year + 1900
          else
            Year := Year + 2000;

          //find a hour
          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Hour := StrToInt(Lexem);

          //find a minute
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Minute := StrToInt(Lexem);

          //find a second
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Second := StrToInt(Lexem);

          i := Skip1Space(S, i); i := GetWord(S, i, Lexem);
          TimeZone := Lexem;
          FinishWith := i-1;
        end;
    3:  begin
          //find a number of week day
          j := 0;
          while (j < 7) and (ShortWeekDays[j] <> Lexem) do
            Inc(j);
          if j = 7 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          DayOfWeek := j;
          i := Skip1Space(S, i); i := GetWord(S, i, Lexem);
          j := 1;
          while (j<13) and (MonthNames[j] <> Lexem) do
            Inc(j);
          if j = 13 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          Month := j;
          i := Skip1Space(S, i);
          if i>Length(S) then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);
          if S[i] = ' ' then
            i := Skip1Space(S, i);

          i := GetIntLexem(S, i, Lexem);
          day := StrToInt(Lexem);
          if Day > 31 then
            raise EDnException.Create(ErrCannotParseHttpTime, 0, S);

          //find a hour
          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Hour := StrToInt(Lexem);

          //find a minute
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Minute := StrToInt(Lexem);

          //find a second
          i := Skip1Colon(S, i); i := GetIntLexem(S, i, Lexem);
          Second := StrToInt(Lexem);

          i := Skip1Space(S, i); i := GetIntLexem(S, i, Lexem);
          Year := StrToInt(Lexem);
          TimeZone := 'GMT';
          FinishWith := i-1;
        end;
    4:  begin
          i := GetIntLexem(S, i, Lexem);
          Second := StrToInt(Lexem);
          FinishWith := i-1;
        end;
  end;

end;

class function  TDnHttpParser.FormatHttpTime( Year, Month, Day, DayOfWeek, Hour, Minute, Second: Integer;
                                              TimeZone: String): String;
var HttpTime: String;
begin
  if  (DayOfWeek > 6) or (DayOfWeek < 0) or (Month > 12) or (Month < 1) or
      (Day < 1) or (Day > 31) or (Hour > 24) or (Hour < 0) or
      (Minute < 0) or (Minute > 59) or (Second < 0) or (Second > 59) then
    raise EDnException.Create(ErrInvalidParameter, -1);
    
  HttpTime := '%s, %.2d %s %.4d %.2d:%.2:%.2 %s';
  Result := Format (HttpTime, [ShortWeekDays[DayOfWeek], Day,
                    MonthNames[Month], Year, Hour,
                    Minute, Second, TimeZone]);
end;


constructor TDnHttpParser.Create;
begin
  inherited Create;