alhttpcommon.pas

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

    for i:= 0 to aRawHeaderLst.Count - 1 do
    begin
      index := pos(aname, aRawHeaderLst[i]);
      if index = 1 then
      begin
        bFound := true;
        break;
      end;
    end;

    if bFound then
    begin
      result := copy(aRawHeaderLst[i], index + Length(aName) + 1, Length(aRawHeaderLst[i]));
      result := trim(result);
      aRawHeaderLst.Delete(i);
    end;
    {
    I := aRawHeaderLst.IndexOfName(aName);
    If I >= 0 then Begin
      result := Trim(aRawHeaderLst.Values[aName]);
      aRawHeaderLst.Delete(i);
    end
    else result := '';
    }
  end;

begin
  aRawHeaderLst := TstringList.create;
  try
    aRawHeaderLst.Delimiter := ':';
    aRawHeaderLst.Text := aRawHeaderText;

    fAccept := Alg001('Accept');
    fAcceptCharSet := Alg001('Accept-Charset');
    fAcceptEncoding := Alg001('Accept-Encoding');
    fAcceptLanguage := Alg001('Accept-Language');
    fAllow := Alg001('Allow');
    fAuthorization := Alg001('Authorization');
    fCacheControl := Alg001('Cache-Control');
    fConnection := Alg001('Connection');
    fContentEncoding := Alg001('Content-Encoding');
    fContentLanguage := Alg001('Content-Language');
    fContentLength := Alg001('Content-Length');
    fContentLocation := Alg001('Content-Location');
    fContentMD5 := Alg001('Content-MD5');
    fContentRange := Alg001('Content-Range');
    fContentType := Alg001('Content-Type');
    fDate := Alg001('Date');
    fExpect := Alg001('Expect');
    fExpires := Alg001('Expires');
    fFrom := Alg001('From');
    fHost := Alg001('Host');
    fIfMatch := Alg001('If-Match');
    fIfModifiedSince := Alg001('If-Modified-Since');
    fIfNoneMatch := Alg001('If-None-Match');
    fIfRange := Alg001('If-Range');
    fIfUnmodifiedSince := Alg001('If-Unmodified-Since');
    fLastModified := Alg001('Last-Modified');
    fMaxForwards := Alg001('Max-Forwards');
    fPragma := Alg001('Pragma');
    fProxyAuthorization := Alg001('Proxy-Authorization');
    fRange := Alg001('Range');
    fReferer := Alg001('Referer');
    fTE := Alg001('TE');
    fTrailer := Alg001('Trailer');
    fTransferEncoding := Alg001('Transfer-Encoding');
    fUpgrade := Alg001('Upgrade');
    fUserAgent := Alg001('User-Agent');
    fVia := Alg001('Via');
    fWarning := Alg001('Warning');

    FCookies.clear;
    J := aRawHeaderLst.IndexOfName('Set-Cookie');
    While J >= 0 do begin
      If trim(aRawHeaderLst.Values['Set-Cookie']) <> '' then
        Cookies.Add.HeaderValue := Trim(aRawHeaderLst.Values['Set-Cookie']);
      aRawHeaderLst.Delete(j);
      J := aRawHeaderLst.IndexOfName('Set-Cookie');
    end;

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

    DoChange(-1);
  finally
    aRawHeaderLst.Free;
  end;
end;

{*********************************************************}
procedure TALHTTPRequestHeader.AssignTo(Dest: TPersistent);
begin
  if Dest is TALHTTPRequestHeader then begin
    with Dest as TALHTTPRequestHeader do begin
      fAccept := self.fAccept;
      fAcceptCharSet := self.fAcceptCharSet;
      fAcceptEncoding := self.fAcceptEncoding;
      fAcceptLanguage := self.fAcceptLanguage;
      fAllow := self.fAllow;
      fAuthorization := self.fAuthorization;
      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;
      fExpect := self.fExpect;
      fExpires := self.fExpires;
      fFrom := self.fFrom;
      fHost := self.fHost;
      fIfMatch := self.fIfMatch;
      fIfModifiedSince := self.fIfModifiedSince;
      fIfNoneMatch := self.fIfNoneMatch;
      fIfRange := self.fIfRange;
      fIfUnmodifiedSince := self.fIfUnmodifiedSince;
      fLastModified := self.fLastModified;
      fMaxForwards := self.fMaxForwards;
      fPragma := self.fPragma;
      fProxyAuthorization := self.fProxyAuthorization;
      fRange := self.fRange;
      fReferer := self.fReferer;
      fTE := self.fTE;
      fTrailer := self.fTrailer;
      fTransferEncoding := self.fTransferEncoding;
      fUpgrade := self.fUpgrade;
      fUserAgent := self.fUserAgent;
      fVia := self.fVia;
      fWarning := self.fWarning;
      fCustomHeaders.assign(self.fCustomHeaders);
      FCookies.Assign(self.fCookies);
      Dochange(-1);
    end;
  end
  else inherited AssignTo(Dest);
end;

{*************************************************************************************}
procedure TALHTTPRequestHeader.SetCookies(const Value: TALHTTPRequestCookieCollection);
begin
  FCookies.Assign(Value);
end;

{*********************************************************************}
procedure TALHTTPRequestHeader.SetCustomHeaders(const Value: Tstrings);
begin
  FCustomHeaders.Assign(Value);
end;



///////////////////////////////////////////////////////////////////////////////////////
////////// Http Misc function /////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////

{************************************************}
function ALHTTPDecode(const AStr: String): String;
Var s: String;
Begin
  {HTTPDecode from HTTPApp unit}
  S := httpDecode(aStr);

  {To Handle UTF8 Encoded Char}
  Result := utf8decode(S);
  If result = '' then result := s;
End;

{*****************************************************}
function ALHTTPEncodeParam(const AStr: String): String;
begin
  {finally HTTPEncode from HTTP APP is OK}
  Result := HTTPEncode(AStr);
end;

{***********************************************************}
procedure ALHTTPEncodeParamNameValues(ParamValues: TStrings);
var i: Integer;
    LPos: integer;
    LStr: string;
begin
  for i := 0 to ParamValues.Count - 1 do begin
    LStr := ParamValues[i];
    LPos := AlPos('=', LStr);
    if LPos > 0 then ParamValues[i] := AlCopyStr(LStr, 1, LPos-1) + '=' + ALHTTPEncodeParam(AlCopyStr(LStr, LPos+1, MAXINT));
  end;
end;

{********************************************************}
{Parses a multi-valued string into its constituent fields.
 ExtractHTTPFields is a general utility to parse multi-valued HTTP header strings into separate substrings.
 *Separators is a set of characters that are used to separate individual values within the multi-valued string.
 *WhiteSpace is a set of characters that are to be ignored when parsing the string.
 *Content is the multi-valued string to be parsed.
 *Strings is the TStrings object that receives the individual values that are parsed from Content.
 *StripQuotes determines whether the surrounding quotes are removed from the resulting items. When StripQuotes is true, surrounding quotes are
  removed before substrings are added to Strings.
 Note:	Characters contained in Separators or WhiteSpace are treated as part of a value substring if the substring is surrounded by single
 or double quote marks. HTTP escape characters are converted using the HTTPDecode function.}
procedure ALExtractHTTPFields(Separators, WhiteSpace: TSysCharSet; Content: PChar; Strings: TStrings; StripQuotes: Boolean = False);
begin
  ALExtractHeaderFields(Separators, WhiteSpace, Content, Strings, True, StripQuotes);
end;

{************************************************************}
Function AlExtractShemeFromUrl(aUrl: String): TInternetScheme;
var URLComp: TURLComponents;
    P: PChar;
begin
  FillChar(URLComp, SizeOf(URLComp), 0);
  URLComp.dwStructSize := SizeOf(URLComp);
  URLComp.dwHostNameLength := 1;
  P := PChar(aUrl);
  if InternetCrackUrl(P, 0, 0, URLComp) then Result := UrlComp.nScheme
  else result := INTERNET_SCHEME_UNKNOWN;
end;

{******************************************************}
Function AlExtractHostNameFromUrl(aUrl: String): String;
var URLComp: TURLComponents;
    P: PChar;
begin
  FillChar(URLComp, SizeOf(URLComp), 0);
  URLComp.dwStructSize := SizeOf(URLComp);
  URLComp.dwHostNameLength := 1;
  P := PChar(aUrl);
  if InternetCrackUrl(P, 0, 0, URLComp) then Result := AlCopyStr(aUrl, URLComp.lpszHostName - P + 1, URLComp.dwHostNameLength) // www.mysite.com
  else result := '';
end;

{**********************************************************************************}
Function AlRemoveAnchorFromUrl(aUrl: String; Var aAnchor: String): String; overload;
var URLComp: TURLComponents;
    P: PChar;
begin
  FillChar(URLComp, SizeOf(URLComp), 0);
  URLComp.dwStructSize := SizeOf(URLComp);
  URLComp.dwExtraInfoLength := 1;
  P := PChar(aUrl);
  If InternetCrackUrl(P, 0, 0, URLComp) then begin
    aAnchor := AlCopyStr(aUrl, URLComp.lpszExtraInfo - P + 1, URLComp.dwExtraInfoLength); // #foo
    If alCharPos('#',aAnchor) = 1 then Result := AlCopyStr(aUrl, 1, length(aurl) - length(aAnchor)) // www.mysite.com/blabla.htm
    else begin
      result := aUrl;
      aAnchor := '';
    end;
  end
  else begin
    result := aUrl;
    aAnchor := '';
  end;
end;

{*************************************************************}
Function AlRemoveAnchorFromUrl(aUrl: String): String; overload;
var aAnchor: String;
begin
  result := AlRemoveAnchorFromUrl(aUrl,aAnchor);
end;

{**********************************************************}
function AlCombineUrl(RelativeUrl, BaseUrl: String): String;
var  S: String;
     Size: Dword;
begin
  case AlExtractShemeFromUrl(RelativeUrl) of

    {relative path.. so try to combine the url}
    INTERNET_SCHEME_PARTIAL,
    INTERNET_SCHEME_UNKNOWN,
    INTERNET_SCHEME_DEFAULT: begin
                               Size := INTERNET_MAX_URL_LENGTH;
                               SetLength(s, Size);
                               if InternetCombineUrl(PChar(BaseUrl), PChar(RelativeUrl), @s[1], size, ICU_BROWSER_MODE or ICU_no_encode) then begin
                                 SetLength(s, Size);
                                 Result := s;
                               end
                               else result := RelativeUrl;
                             end;

    {not a relative path}
    else result := RelativeUrl;

  end;
end;

end.