alhttpcommon.pas

Description: common http function that can be use by HTTP Component

    FContentType := Alg001('Content-Type');
    FDate := Alg001('Date');
    FETag := Alg001('ETag');
    FExpires := Alg001('Expires');
    FLastModified := Alg001('Last-Modified');
    FLocation := Alg001('Location');
    FPragma := Alg001('Pragma');
    FProxyAuthenticate := Alg001('Proxy-Authenticate');
    FRetryAfter := Alg001('Retry-After');
    FServer := Alg001('Server');
    FTrailer := Alg001('Trailer');
    FTransferEncoding := Alg001('Transfer-Encoding');
    FUpgrade := Alg001('Upgrade');
    FVary := Alg001('Vary');
    FVia := Alg001('Via');
    FWarning := Alg001('Warning');
    FWWWAuthenticate := Alg001('WWW-Authenticate');

    FCookies.clear;
    J := aRawHeaderLst.IndexOfName('Cookie');
    If J >= 0 then begin
      ALExtractHTTPFields([';'], [' '], PChar(aRawHeaderLst.Values['Cookie']), Cookies, True);
      aRawHeaderLst.Delete(j);
    end;

    If aRawHeaderLst.Count > 0 then begin
      AStatusLine := aRawHeaderLst[0]; //"HTTP/1.1 200 OK"
      FHttpProtocolVersion := trim(AlStringFetch(AstatusLine,' '));
      FStatusCode := trim(AlStringFetch(AstatusLine,' '));
      FReasonPhrase := trim(AstatusLine);
    end
    else begin
      FStatusCode := '';
      FHttpProtocolVersion := '';
      FReasonPhrase := '';
    end;

    FCustomHeaders.clear;
    For j := 0 to aRawHeaderLst.count - 1 do
      If trim(aRawHeaderLst[j]) <> '' then
        FCustomHeaders.Add(aRawHeaderLst[j]);

    FRawHeaderText := aRawHeaderText;
  finally
    aRawHeaderLst.Free;
  end;
end;

{**********************************************************}
procedure TALHTTPResponseHeader.AssignTo(Dest: TPersistent);
begin
  if Dest is TALHTTPResponseHeader then begin
    with Dest as TALHTTPResponseHeader do begin
      FAcceptRanges := Self.FAcceptRanges;
      FAge := Self.FAge;
      FAllow := Self.FAllow;
      FCacheControl := Self.FCacheControl;
      FConnection := Self.FConnection;
      FContentEncoding := Self.FContentEncoding;
      FContentLanguage := Self.FContentLanguage;
      FContentLength := Self.FContentLength;
      FContentLocation := Self.FContentLocation;
      FContentMD5 := Self.FContentMD5;
      FContentRange := Self.FContentRange;
      FContentType := Self.FContentType;
      FDate := Self.FDate;
      FETag := Self.FETag;
      FExpires := Self.FExpires;
      FLastModified := Self.FLastModified;
      FLocation := Self.FLocation;
      FPragma := Self.FPragma;
      FProxyAuthenticate := Self.FProxyAuthenticate;
      FRetryAfter := Self.FRetryAfter;
      FServer := Self.FServer;
      FTrailer := Self.FTrailer;
      FTransferEncoding := Self.FTransferEncoding;
      FUpgrade := Self.FUpgrade;
      FVary := Self.FVary;
      FVia := Self.FVia;
      FWarning := Self.FWarning;
      FWWWAuthenticate := Self.FWWWAuthenticate;
      FRawHeaderText := Self.FRawHeaderText;
      FStatusCode := Self.FStatusCode;
      FHttpProtocolVersion := Self.FHttpProtocolVersion;
      FReasonPhrase := Self.FReasonPhrase;
      FCustomHeaders.Assign(Self.FCustomHeaders);
      FCookies.Assign(Self.FCookies);
    end;
  end
  else inherited AssignTo(Dest);
end;




///////////////////////////////////////////////////////////////////////////////////////
////////// TALHTTPClientRequestHeader /////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////

{**********************************************************}
constructor TALHTTPRequestHeader.Create(AOwner: TComponent);
Begin
  inherited create(AOwner);
  fCustomHeaders:= TstringList.create;
  fCustomHeaders.Delimiter := ':';
  FCookies := TALHTTPRequestCookieCollection.Create(Self, TALHTTPRequestCookie);
  FOnchange := nil;
  clear;
  fAccept := 'text/html, */*';
end;

{**************************************}
destructor TALHTTPRequestHeader.Destroy;
begin
  fCustomHeaders.free;
  Fcookies.Free;
  inherited;
end;

{***********************************}
procedure TALHTTPRequestHeader.Clear;
begin
  fAccept := '';
  fAcceptCharSet := '';
  fAcceptEncoding := '';
  fAcceptLanguage := '';
  fAllow := '';
  fAuthorization := '';
  fCacheControl := '';
  fConnection := '';
  fContentEncoding := '';
  fContentLanguage := '';
  fContentLength := '';
  fContentLocation := '';
  fContentMD5 := '';
  fContentRange := '';
  fContentType := '';
  fDate := '';
  fExpect := '';
  fExpires := '';
  fFrom := '';
  fHost := '';
  fIfMatch := '';
  fIfModifiedSince := '';
  fIfNoneMatch := '';
  fIfRange := '';
  fIfUnmodifiedSince := '';
  fLastModified := '';
  fMaxForwards := '';
  fPragma := '';
  fProxyAuthorization := '';
  fRange := '';
  fReferer := '';
  fTE := '';
  fTrailer := '';
  fTransferEncoding := '';
  fUpgrade := '';
  fUserAgent := '';
  fVia := '';
  fWarning := '';
  fCustomHeaders.clear;
  FCookies.Clear;
  DoChange(-1);
end;

{**************************************************************}
procedure TALHTTPRequestHeader.DoChange(propertyIndex: Integer);
begin
  if assigned(FonChange) then FonChange(Self,propertyIndex);
end;

{******************************************************************************************************}
procedure TALHTTPRequestHeader.SetHeaderValueByPropertyIndex(const Index: Integer; const Value: string);

  {--------------------------------------}
  procedure alg001(Var AProperty: String);
  Begin
    If AProperty <> Value then begin
      AProperty := Value;
      DoChange(Index);
    end;
  end;

begin
  Case index of
    0: alg001(FAccept);
    1: alg001(FAcceptCharSet);
    2: alg001(FAcceptEncoding);
    3: alg001(FAcceptLanguage);
    4: alg001(FAllow);
    5: alg001(FAuthorization);
    6: alg001(FCacheControl);
    7: alg001(FConnection);
    8: alg001(FContentEncoding);
    9: alg001(FContentLanguage);
    10: alg001(FContentLength);
    11: alg001(FContentLocation);
    12: alg001(FContentMD5);
    13: alg001(FContentRange);
    14: alg001(FContentType);
    15: alg001(FDate);
    16: alg001(fExpect);
    17: alg001(FExpires);
    18: alg001(FFrom);
    19: alg001(FHost);
    20: alg001(FIfMatch);
    21: alg001(FIfModifiedSince);
    22: alg001(fIfNoneMatch);
    23: alg001(fIfRange);
    24: alg001(fIfUnmodifiedSince);
    25: alg001(fLastModified);
    26: alg001(fMaxForwards);
    27: alg001(FPragma);
    28: alg001(FProxyAuthorization);
    29: alg001(FRange);
    30: alg001(FReferer);
    31: alg001(fTE);
    32: alg001(FTrailer);
    33: alg001(FTransferEncoding);
    34: alg001(FUpgrade);
    35: alg001(FUserAgent);
    36: alg001(FVia);
    37: alg001(FWarning);
  end;
end;

{*****************************************************}
Function TALHTTPRequestHeader.GetRawHeaderText: String;
Var i : integer;
  s: string;
begin
  Result := '';
  If trim(fAccept) <> '' then result := result + 'Accept: ' + trim(FAccept) + #13#10;
  If trim(fAcceptCharSet) <> '' then result := result + 'Accept-Charset: ' + trim(FAcceptCharSet) + #13#10;
  If trim(fAcceptEncoding) <> '' then result := result + 'Accept-Encoding: ' + trim(FAcceptEncoding) + #13#10;
  If trim(fAcceptLanguage) <> '' then result := result + 'Accept-Language: ' + trim(FAcceptLanguage) + #13#10;
  If trim(fAllow) <> '' then result := result + 'Allow: ' + trim(FAllow) + #13#10;
  If trim(fAuthorization) <> '' then result := result + 'Authorization: ' + trim(FAuthorization) + #13#10;
  If trim(fCacheControl) <> '' then result := result + 'Cache-Control: ' + trim(FCacheControl) + #13#10;
  If trim(fConnection) <> '' then result := result + 'Connection: ' + trim(FConnection) + #13#10;
  If trim(fContentEncoding) <> '' then result := result + 'Content-Encoding: ' + trim(FContentEncoding) + #13#10;
  If trim(fContentLanguage) <> '' then result := result + 'Content-Language: ' + trim(FContentLanguage) + #13#10;
  If trim(fContentLength) <> '' then result := result + 'Content-Length: ' + trim(FContentLength) + #13#10;
  If trim(fContentLocation) <> '' then result := result + 'Content-Location: ' + trim(FContentLocation) + #13#10;
  If trim(fContentMD5) <> '' then result := result + 'Content-MD5: ' + trim(FContentMD5) + #13#10;
  If trim(fContentRange) <> '' then result := result + 'Content-Range: ' + trim(FContentRange) + #13#10;
  If trim(fContentType) <> '' then result := result + 'Content-Type: ' + trim(FContentType) + #13#10;
  If trim(fDate) <> '' then result := result + 'Date: ' + trim(FDate) + #13#10;
  If trim(fExpect) <> '' then result := result + 'Expect: ' + trim(FExpect) + #13#10;
  If trim(fExpires) <> '' then result := result + 'Expires: ' + trim(FExpires) + #13#10;
  If trim(fFrom) <> '' then result := result + 'From: ' + trim(FFrom) + #13#10;
  If trim(fHost) <> '' then result := result + 'Host: ' + trim(FHost) + #13#10;
  If trim(fIfMatch) <> '' then result := result + 'If-Match: ' + trim(FIfMatch) + #13#10;
  If trim(fIfModifiedSince) <> '' then result := result + 'If-Modified-Since: ' + trim(FIfModifiedSince) + #13#10;
  If trim(fIfNoneMatch) <> '' then result := result + 'If-None-Match: ' + trim(fIfNoneMatch) + #13#10;
  If trim(fIfRange) <> '' then result := result + 'If-Range: ' + trim(fIfRange) + #13#10;
  If trim(fIfUnmodifiedSince) <> '' then result := result + 'If-Unmodified-Since: ' + trim(fIfUnmodifiedSince) + #13#10;
  If trim(fLastModified) <> '' then result := result + 'Last-Modified: ' + trim(fLastModified) + #13#10;
  If trim(fMaxForwards) <> '' then result := result + 'Max-Forwards: ' + trim(fMaxForwards) + #13#10;
  If trim(fPragma) <> '' then result := result + 'Pragma: ' + trim(FPragma) + #13#10;
  If trim(fProxyAuthorization) <> '' then result := result + 'Proxy-Authorization: ' + trim(FProxyAuthorization) + #13#10;
  If trim(fRange) <> '' then result := result + 'Range: ' + trim(FRange) + #13#10;
  If trim(fReferer) <> '' then result := result + 'Referer: ' + trim(FReferer) + #13#10;
  If trim(fTE) <> '' then result := result + 'TE: ' + trim(fTE) + #13#10;
  If trim(fTrailer) <> '' then result := result + 'Trailer: ' + trim(FTrailer) + #13#10;
  If trim(fTransferEncoding) <> '' then result := result + 'Transfer-Encoding: ' + trim(FTransferEncoding) + #13#10;
  If trim(fUpgrade) <> '' then result := result + 'Upgrade: ' + trim(FUpgrade) + #13#10;
  If trim(fUserAgent) <> '' then result := result + 'User-Agent: ' + trim(FUserAgent) + #13#10;
  If trim(fVia) <> '' then result := result + 'Via: ' + trim(FVia) + #13#10;
  If trim(fWarning) <> '' then result := result + 'Warning: ' + trim(FWarning) + #13#10;
  For i := 0 to FCustomHeaders.count - 1 do
  begin
    s := FCustomHeaders.names[i];
    if (trim(s) <> '') and (trim(FCustomHeaders.Values[s]) <> '') then
      result := result + FCustomHeaders.names[i] + ': ' + trim(FCustomHeaders.Values[s]) + #13#10;
  end;

  For i := 0 to FCookies.count - 1 do
    If trim(FCookies[i].Name) <> '' then
      result := result + 'Set-Cookie: ' + trim(FCookies[i].GetHeaderValue) + #13#10;
end;

{****************************************************************************}
procedure TALHTTPRequestHeader.SetRawHeaderText(const aRawHeaderText: string);
Var aRawHeaderLst: TstringList;
    j: integer;

  {-------------------------------------}
  Function AlG001(aName: String): String;
  Var i: Integer;
  bFound: boolean;
  index: integer;
  Begin
    result := '';
    bFound:= false;