dnhttpparser.pas

一个国外比较早的IOCP控件

  FHttpData := '';
  FNames := TStringList.Create;
  FValues := TStringList.Create;
end;

procedure TDnHttpParser.Clear;
begin
  FNames.Clear;
  FValues.Clear;
  FHttpVersion := '';
  FMethodName := '';
  FMethodURL := '';
  FHttpResponseCode := 0;
  FHttpResponseReason := '';
end;


destructor TDnHttpParser.Destroy;
begin
  FreeAndNil(FNames);
  FreeAndNil(FValues);
  inherited Destroy;
end;

function  TDnHttpParser.GetHttpHeader(const Name: String): String;
var i: Integer;
begin
  i := FNames.IndexOf(Name);
  if i = -1 then
    Result := ''
  else
    Result := FValues[i];
end;

procedure TDnHttpParser.SetHttpHeader(const Name, Value: String);
var i: Integer;
begin
  i := FNames.IndexOf(Name);
  if i <> -1 then
    FValues[i] := Value
  else
  begin
    FNames.Add(Name);
    FValues.Add(Value);
  end;
end;

procedure TDnHttpParser.ParseHttpHeaders(S: String);
var EOL, AssignPos: Integer;
    Line: String;
begin
  EOL := Pos(CRLF, S);
  while EOL<>0 do
  begin
    Line := Copy(S, 1, EOL-1); Delete(S, 1, EOL+1);
    AssignPos := Pos('=', S);
    if AssignPos <> 0 then
    begin
      FNames.Add(Trim(Copy(Line, 1, AssignPos-1)));
      FValues.Add(Trim(Copy(Line, AssignPos+1, Length(Line) - AssignPos)));
    end;
    EOL := Pos(CRLF, S);
  end;
end;

procedure TDnHttpParser.ParseRequest(const HttpData: String);
var S: String;
    Line, Lexem: String;
    EOL, i, j: Integer;
begin
  FNames.Clear; FValues.Clear;
  //Normalize CRLF pairs
  S := AdjustLineBreaks(HttpData);
  EOL := Pos(CRLF, S);
  Line := Copy(S, 1, EOL-1);
  Delete(S, 1, EOL+1);

  //parse method name, URL, HTTP version
  i := GetWord(Line, 1, Lexem);
  FMethodName := UpperCase(Lexem);
  i := Skip1Space(Line, i);
  j := i;
  while (Line[j] <> ' ') and (j < Length(Line)) do
    Inc(j);
  FMethodURL := Copy(Line, i, j-i);
  i := j;
  FHttpVersion := UpperCase(Copy(Line, i, Length(Line) - i + 1));
  ParseHttpHeaders(S);
end;

procedure TDnHttpParser.ParseResponse(const HttpData: String);
var S, Line: String;
    SpacePos, EOL: Integer;
begin
  FNames.Clear; FValues.Clear;
  S := AdjustLineBreaks(HttpData);
  EOL := Pos (CRLF, S);
  if EOL = 0 then
    raise EDnException.Create(ErrCannotParseHttp, 0, S);
  Line := Copy(S, 1, EOL-1); Delete(S, 1, EOL+1);
  SpacePos := Pos(' ', S);
  if SpacePos = 0 then
    raise EDnException.Create(ErrCannotParseHttp, 0, Line);
  FHttpVersion := Copy(Line, 1, SpacePos-1); Delete(Line, 1, SpacePos);
  SpacePos := Pos(' ', Line);
  if SpacePos = 0 then
    raise EDnException.Create(ErrCannotParseHttp, 0, Line);
  FHttpResponseCode := StrToInt(Copy(Line, 1, SpacePos-1));
  Delete(Line, 1, SpacePos+1);
  FHttpResponseReason := Copy(Line, 1, Length(Line));
  ParseHttpHeaders(S);
end;

function TDnHttpParser.AssembleHttpHeaders: String;
var i: Integer;
begin
  Result := '';
  for i:=0 to FNames.Count-1 do
    Result:= Result + FNames[i] + ': ' + FValues[i] + CRLF; 
end;

function TDnHttpParser.AssembleResponse: String;
begin
  Result := FHttpVersion + ' ' + IntToStr(FHttpResponseCode) + ' ' + FHttpResponseReason + CRLF;
  Result := Result + AssembleHttpHeaders();
  Result := Result + CRLF;
end;

function TDnHttpParser.AssembleRequest: String;
begin
  Result := FMethodName + ' ' + FMethodURL + ' ' + FHttpVersion + CRLF;
  Result := Result + AssembleHttpHeaders();
  Result := Result + CRLF;
end;

class function TDnHttpParser.ExtractLine(var Data: String): String;
var CrLfPos: Integer;
begin
  CrLfPos := Pos(CRLF, Data);
  if CrLfPos > 0 then
  begin
    Result := Copy(Data, 1, CrLfPos-1);
    Delete(Data, 1, CrLfPos+1);
  end else
  begin
    Result := Data;
    Data := '';
  end;
end;


class procedure TDnHttpParser.ExtractPair(var Data: String; var LeftPart, RightPart: String);
var ScPos: Integer;
begin
  ScPos := Pos(':', Data);
  if ScPos > 0 then
  begin
    LeftPart := Copy(Data, 1, ScPos-1);
    RightPart := Copy(Data, ScPos+1, Length(Data) - ScPos);
  end else
    LeftPart := Data;
end;

class procedure TDnHttpParser.StripSpaces(var Data: String);
var I: Integer;
begin
//Detect first spaces
  for i := 1 to Length(Data) do
    if Data[i] <> '' then
      break;

  if I <= Length(Data) then
  begin
    if I <> 1 then
      Delete(Data, 1, I-1);
  end else
    Data := '';

//Detect last spaces
  for  I:= Length(Data) downto 1 do
    if Data[i] <> '' then
     break;

  if I > 0 then
  begin
    if I <> Length(Data) then
      Delete(Data, I, Length(Data) - I);
  end else
    Data := '';
end;

procedure GetLexem( Data: String; StartWith: Integer; var Lexem: String;
                    var FinishWith: Integer);
var i, len: Integer;
begin
  len := Length(Data);
  i := StartWith;
  while not (Data[i] in ['/', '\', ':', '?', '@']) and (i <= len) do
  begin
    Inc(i);
  end;
  Lexem := Copy(Data, StartWith, i-StartWith);
  FinishWith := i;
end;

procedure GetDelimiter( Data: String; StartWith: Integer; var Delimiter: String;
                        var FinishWith: Integer);
var i, len: Integer;
begin
  len := Length(Data);
  i := StartWith;
  while (Data[i] in ['/', '\', ':', '?', '@']) and (i <= len) do
  begin
    if (Data[i] = '@') and (i = StartWith) then
    begin
      FinishWith := i + 1;
      Delimiter := '@';
      Exit;
    end else
    if (Data[i] = '@') and (i <> StartWith) then
      break;
    Inc(i);
  end;
  Delimiter := Copy(Data, StartWith, i-StartWith);
  FinishWith := i;
end;

class function TDnHttpParser.IsAbsoluteUrl(const Url: String): Boolean;
begin
  Result := Pos('://', Url) <> 0;
end;

class procedure TDnHttpParser.ParseRelativeUrl(const Url: String; var Path, Query: String);
var QueryPos : Integer;
begin
  if Url = '*' then
  begin
    Path := '*';
    Query := '';
    Exit;
  end;
  
  QueryPos := Pos('?', Url);
  if QueryPos = 0 then
  begin
    Path := Url;
    Query := '';
  end else
  begin
    Path := Copy(Url, 1, QueryPos - 1);
    Query := Copy(Url, QueryPos, Length(Url) - QueryPos);
  end;
end;



class procedure TDnHttpParser.ParseAbsoluteUrl(const Url: String; var Protocol, User, Password,
                                        Host, Port, Path, Query: String;
                                        var UserExists, PasswordExists: Boolean);
var LastDelimiterPos, Fp: Integer;
    Lexem: String;
    Delimiter: String;
    //PossiblePassword,
    //PossibleHost: String;
    //PossiblePasswordExists: Boolean;
    QueryStart, PathStart: PChar;
    //URLLen: Integer;
begin
  Protocol := ''; User := ''; Password := '';
  Host := ''; Port := ''; Query := '';
  UserExists := False; PasswordExists := False;


  GetLexem(Url, 1, Lexem, Fp);
  LastDelimiterPos := Fp;
  GetDelimiter(Url, Fp, Delimiter, Fp); 
  if Delimiter = '://' then
  begin
    Protocol := LowerCase(Lexem);
    GetLexem(Url, Fp, Lexem, Fp); 
    LastDelimiterPos := Fp;
    GetDelimiter(Url, Fp, Delimiter, Fp); 
  end else
    Protocol := LowerCase('http');
  if Delimiter = '@' then
  begin
    UserExists := True;
    User := Lexem;

    GetLexem(Url, Fp, Lexem, Fp);
    LastDelimiterPos := Fp;
    GetDelimiter(Url, Fp, Delimiter, Fp);
    if Delimiter = ':' then
    begin
      Password := Lexem; PasswordExists := True;
      GetLexem(Url, Fp, Lexem, Fp);
      LastDelimiterPos := Fp;
      GetDelimiter(Url, Fp, Delimiter, Fp);
    end;
  end else
  if Delimiter = ':' then
  begin
    PasswordExists := True; Password := Lexem;
    GetLexem(Url, Fp, Lexem, Fp);
    LastDelimiterPos := Fp;
    GetDelimiter(Url, Fp, Delimiter, Fp);
  end;

  while Delimiter = '.' do
  begin
    Host := Host + Lexem + Delimiter;
    GetLexem(Url, Fp, Lexem, Fp);
    GetDelimiter(Url, Fp, Delimiter, Fp);
  end;
  Host := Host + Lexem;

  if Delimiter = ':' then
  begin //port
    GetLexem(Url, Fp, Lexem, Fp);
    LastDelimiterPos := Fp;
    GetDelimiter(Url, Fp, Delimiter, Fp);
    Port := Lexem;
  end;
  //LastDelimiterPos := Fp;
  QueryStart := StrScan(PChar(Url) + LastDelimiterPos-1, '?');
  PathStart := StrScan(PChar(Url) + LastDelimiterPos-1, '/');
  if QueryStart = Nil then
  begin
    //QueryExists := False;
    Query := '';
    if PathStart = Nil then
      Path := ''
    else
    begin
      Path := Copy(Url, PathStart - PChar(Url) + 1, Length(Url) - (PathStart - PChar(Url)));
    end;
  end else
  begin
    //QueryExists := True
    Query := Copy(Url, QueryStart - PChar(Url) + 1, Length(Url) - (QueryStart - PChar(Url)));
    if PathStart = Nil then
      Path := ''
    else begin
      Path := Copy(Url, PathStart - PChar(Url) + 1, QueryStart - PathStart);
    end;
  end;
end;

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

end.