dxhttpheadertools.pas

Well known and usefull component for delphi 7

unit DXHTTPHeaderTools;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXHTTPHeaderTools
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (3rd Generation Code)
// ========================================================================
//  Description:
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

uses
  DXString,
  Classes;

{$I DXSock.def}

Type
  PHeaderInfo=^THeaderInfo;
  THeaderInfo=Record
    ContentLength:Integer;
    Raw:String;       // Original Header Request
    Protocol:String;
    Method:String;    //GET, HEAD, etc.  All caps!!!
    URI:String;
    PhysPath:String;
    Allow:String;
    AuthType:String;  // BASIC
    AuthName:String;
    AuthPass:String;
    Date:String;
    Pragma:String;
    CacheControl:String;
    Connection:String;
    TransferEncoding:String;
    Upgrade:String;
    Via:String;
    Host:String;      // multiple domains on single IP!
    From:String;
    IfModSince:String;
    IfMatch:String;
    IfNoneMatch:String;
    IfRange:String;
    IfUnModSince:String;
    MaxForwards:String;
    ProxyAuthorization:String;
    KeepAlive:String;
    PublicCache:String; // 2.3 renamed field!
    Range:String;
    Referer:String;
    UserAgent:String;
    ContentType:String;
    Accept:String;
    AcceptCharset:String;
    AcceptEncoding:String;
    AcceptLanguage:String;
    ClientName:String;
    ClientAddr:String;
    ClientHost:String;
    Cookie:String;
    QueryString:String;
    Weferer:String;
    WserAgent:String;
    Forwarded:String;
    ForwardedFor:String;
    ProxyConnection:String;
    CacheInfo:String;
    PostData:String;  // 3.0
    HostRootPath:String;  // needed for SSI+ Banner routines and ISAPI Variables
    All_RAW:String; // needed for trace, and ISAPIs!
    All_HTTP:String;
    Unknown:String;
  end;

  TDXHTTPHeaderTools = class(TDXComponent)
  private
    fSessionHeader:PHeaderInfo;
  protected
    Function FindUnknownHeader(ServerVariable:String):String;
    Procedure ReplaceUnknownHeader(ServerVariable, VariableValue:String);
    Function UnknownHeaderExists(ServerVariable:String):Boolean;
  public
    constructor Create(AOwner:TComponent); {$IFNDEF OBJECTS_ONLY} override; {$ENDIF}
    Destructor Destroy; override;
    Procedure Init(HTTPHeader:PHeaderInfo);
    // 2.0.12
    Function HeaderGetString(ServerVariable:String):String;
    Function HeaderGetInteger(ServerVariable:String):Integer;
    Function HeaderDataExists(ServerVariable:String):Boolean;
    Function QueryGetString(ServerVariable:String):String;
    Function QueryGetInteger(ServerVariable:String):Integer;
    Function QueryDataExists(ServerVariable:String):Boolean;

    Function AddHeader(ServerVariable, VariableValue:String):Boolean;
    Function SetHeader(ServerVariable, VariableValue:String):Boolean;
    Function ToStrings:TStrings;

  published
  end;

implementation

Uses
   SysUtils;

constructor TDXHTTPHeaderTools.Create(AOwner:TComponent);
Begin
   Inherited Create(AOwner);
end;

Destructor TDXHTTPHeaderTools.Destroy;
Begin
   Inherited Destroy;
end;

Procedure TDXHTTPHeaderTools.Init(HTTPHeader:PHeaderInfo);
Begin
   fSessionHeader:=HTTPHeader;
   fSessionHeader^.ContentLength:=0;
End;

Function TDXHTTPHeaderTools.HeaderGetString(ServerVariable:String):String;
Var
   Ch:Char;
   Ws:String;
   URI2:String;

Begin
   Result:='';
   Ws:=Uppercase(ServerVariable);
   If Ws='' then Exit; //2.0.11
   If (Copy(Ws,1,5)='HTTP_') then Begin
      Delete(Ws,1,5); // 3.0
   End;
   Ch:=Ws[1];
   With fSessionHeader^ do
   Case Ch of
      'A':If (Ws='ALLOW') then Result:=Allow
          Else If (Ws='ALL_RAW') then Result:=All_Raw // .9k & 2.3b
          Else If (Ws='ALL_HTTP') then Result:=All_HTTP // 3.0
          Else If (Ws='AUTHTYPE') or (Ws='AUTH_TYPE') then Result:=AuthType
          Else If (Ws='AUTHNAME') or (Ws='AUTH_NAME') or (Ws='AUTH_USER') then Result:=AuthName
          Else If (Ws='AUTHPASS') or (Ws='AUTH_PASS') or (Ws='AUTH_PASSWORD') then Result:=AuthPass
          Else If (Ws='ACCEPT') then Result:=Accept
          Else If (Ws='ACCEPT_CHARSET') or (Ws='ACCEPTCHARSET') then Result:=AcceptCharset
          Else If (Ws='ACCEPT_ENCODING') or (Ws='ACCEPTENCODING') then Result:=AcceptEncoding
          Else If (Ws='ACCEPT_LANGUAGE') or (Ws='ACCEPTLANGUAGE') then Result:=AcceptLanguage
          Else Result := FindUnknownHeader(ServerVariable);
      'C':If (Ws='CONTENT_LENGTH') or (Ws='CONTENTLENGTH') then Result:=IntegerToString(ContentLength)
          Else If (Ws='CACHECONTROL') or (Ws='CACHE_CONTROL') then Result:=CacheControl
          Else If (Ws='CACHE_INFO') then Result:=CacheInfo
          Else If (Ws='CONNECTION') then Result:=Connection
          Else If (Ws='CONTENT_TYPE') or (Ws='CONTENTTYPE') then Result:=ContentType
          Else If (Ws='CLIENTNAME') or (Ws='CLIENT_NAME') then Result:=ClientName
          Else If (Ws='CLIENTADDR') or (Ws='CLIENT_ADDR') then Result:=ClientAddr
          Else If (Ws='COOKIE') then Result:=Cookie
          Else Result := FindUnknownHeader(ServerVariable);
      'D':If (Ws='DATE') then Result:=Date
          Else Result := FindUnknownHeader(ServerVariable);
      'F':If (Ws='FROM') then Result:=From
          Else If (Ws='FORWARDED') then Result:=Forwarded
          Else If (Ws='FORWARDED_FOR') then Result:=ForwardedFor
          Else Result := FindUnknownHeader(ServerVariable);
      'H':If (Ws='HOST') then Begin
             Result:=Host;
             If CharPos('@',Result)>0 then Delete(Result,1,CharPos(':',Result));
             If CharPos(':',Result)>0 then Delete(Result,CharPos(':',Result),Length(Result));
          End
          Else If (Ws='HTTPS') then Result:='off'
          Else Result := FindUnknownHeader(ServerVariable);
      'I':If (Ws='IFMODSINCE') or (Ws='IF_MODSINCE') or (Ws='IF_MOD_SINCE') then Result:=IfModSince
          Else If (Ws='IFMATCH') or (Ws='IF_MATCH') then Result:=IfMatch
          Else If (Ws='IFNONEMATCH') or (Ws='IF_NONEMATCH') or (Ws='IF_NONE_MATCH') then Result:=IfNoneMatch
          Else If (Ws='IFRANGE') or (Ws='IF_RANGE') then Result:=IfRange
          Else If (Ws='IFUNMODSINCE') or (Ws='IF_UNMODSINCE') or (Ws='IF_UNMOD_SINCE') then Result:=IfUnModSince
          Else Result := FindUnknownHeader(ServerVariable);
      'K':If (Ws='KEEPALIVE') or (Ws='KEEP_ALIVE') then Result:=KeepAlive
          Else Result := FindUnknownHeader(ServerVariable);
      'M':If (Ws='METHOD') then Result:=Method
          Else If (Ws='MAXFORWARDS') or (Ws='MAX_FORWARDS') then Result:=MaxForwards
          Else Result := FindUnknownHeader(ServerVariable);
      'P':If (Ws='PROTOCOL') then Result:=Protocol
          Else If (Ws='PRAGMA') then Result:=Pragma
          Else if (Ws='PROXYAUTHORIZATION') or (Ws='PROXY_AUTHORIZATION') then Result:=ProxyAuthorization
          Else if (Ws='PUBLIC') then Result:=PublicCache
          Else if (Ws='PROXY_CONNECTION') then Result:=ProxyConnection
          Else Result := FindUnknownHeader(ServerVariable);
      'Q':If (Ws='QUERYSTRING') or (Ws='QUERY_STRING') then Result:=QueryString
          Else Result := FindUnknownHeader(ServerVariable);
      'R':If (Ws='RANGE') then Result:=Range
          Else If (Ws='REFERER') or (Ws='REFERRER') or (Ws='REFFERER') then Result:=Referer
          Else If (Ws='REQUEST_METHOD') then Result:=Method
          Else If (Ws='REMOTE_NAME') or (Ws='REMOTE_HOST') then Result:=ClientName
          Else If (Ws='REMOTE_ADDR') then Result:=ClientAddr
          Else If (Ws='REQUEST_URI') then Begin
             URI2:=ToUnixSlashes(URI);
             If CharPos('/',URI2)=0 then Result:='/'+URI2
             Else Begin
                If Copy(URI2,1,1)<>'/' then URI2:='/'+URI2;
                Result:=URI2; // 4/2/2002 Copy(URI2,1,PosLastChar('/',URI2));
             End;
          End
          Else Result := FindUnknownHeader(ServerVariable);
      'S':If (Ws='SERVER_PROTOCOL') then Result:=Protocol
          Else If (Ws='SERVER_NAME') then Begin
             Result:=Host;
             If CharPos('@',Result)>0 then Delete(Result,1,CharPos(':',Result));
             If CharPos(':',Result)>0 then Delete(Result,CharPos(':',Result),Length(Result));
          End
          Else If (Ws='SERVER_PORT_SECURE') then Result:='0'
          Else Result := FindUnknownHeader(ServerVariable);
      'T':If (Ws='TRANSFERENCODING') or (Ws='TRANSFER_ENCODING') then Result:=TransferEncoding
          Else Result := FindUnknownHeader(ServerVariable);
      'U':If (Ws='URI') then Begin
             URI2:=ToUnixSlashes(URI);
             If CharPos('/',URI2)=0 then Result:='/'+URI2
             Else Begin
                If Copy(URI2,1,1)<>'/' then URI2:='/'+URI2;
                Result:=URI2; // 4/2/2002 Copy(URI2,1,PosLastChar('/',URI2));
             End;
          End
          Else If (Ws='URL') then Begin
             URI2:=ToUnixSlashes(URI);
             If Copy(URI2,1,1)='/' then Result:=URI2
             Else Result:='/'+URI2;
          End
          Else If (Ws='UPGRADE') then Result:=Upgrade
          Else if (Ws='USERAGENT') or (Ws='USER_AGENT') then Result:=UserAgent
          Else Result := FindUnknownHeader(ServerVariable);
      'V':If (Ws='VIA') then Result:=Via
          Else Result := FindUnknownHeader(ServerVariable);
      'W':If (Ws='WEFERER') then Result:=Weferer
          Else If (Ws='WSER_AGENT') then Result:=WserAgent
          Else Result := FindUnknownHeader(ServerVariable);
       Else
          Result := FindUnknownHeader(ServerVariable);
   End;
End;

Function TDXHTTPHeaderTools.HeaderGetInteger(ServerVariable:String):Integer;
Var
   Ch:Char;
   Ws:String;

Begin
   Result:=0;
   Ws:=Uppercase(ServerVariable);
   If Ws='' then Exit; // 2.0.11
   Ch:=Ws[1];
   With fSessionHeader^ do
   Case Ch of
      'C':If (Ws='CONTENT_LENGTH') or (Ws='CONTENTLENGTH') then Result:=ContentLength;
   End;
End;

Function TDXHTTPHeaderTools.HeaderDataExists(ServerVariable:String):Boolean;
Begin
   Result:=HeaderGetString(ServerVariable)<>'';
End;

// 2.0.12
Function TDXHTTPHeaderTools.QueryGetString(ServerVariable:String):String;
Var