dxhttpservercore.pas

Well known and usefull component for delphi 7

unit DXHTTPServerCore;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXHTTPServerCore
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2003
//    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-2003
//               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: (4th Generation Code)
// ========================================================================
//  Description: implements HTTP (HyperText Transport Protocol)
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

{$I DXSock.def}

uses
   DXSocket,
   Classes,
   DXServerCore,
   DXISAPI,
   DXHTTPHeaderTools;

// RFC2068, Response Codes
const
   MaxStatusCodes=40;
   StatusCodes:array[0..MaxStatusCodes] of record
      Code:Integer;
      Msg:string
   end=
   ((Code:100;Msg:'Continue') ,
      (Code:101;Msg:'Switching Protocols') ,
      (Code:200;Msg:'OK') ,
      (Code:201;Msg:'Created') ,
      (Code:202;Msg:'Accepted') ,
      (Code:203;Msg:'Non-Authoritative Information') ,
      (Code:204;Msg:'No Content') ,
      (Code:205;Msg:'Reset Content') ,
      (Code:206;Msg:'Partial Content') ,
      (Code:300;Msg:'Multiple Choices') ,
      (Code:301;Msg:'Moved Permanently') ,
      (Code:302;Msg:'Moved Temporarily') ,
      (Code:303;Msg:'See Other') ,
      (Code:304;Msg:'Not Modified') ,
      (Code:305;Msg:'Use Proxy') ,
      (Code:306;Msg:'Unused') ,
      (Code:307;Msg:'Temporary Redirect') ,
      (Code:400;Msg:'Bad Request') ,
      (Code:401;Msg:'Unauthorized') ,
      (Code:402;Msg:'Payment Required') ,
      (Code:403;Msg:'Forbidden') ,
      (Code:404;Msg:'Not Found') ,
      (Code:405;Msg:'Method Not Allowed') ,
      (Code:406;Msg:'Not Acceptable') ,
      (Code:407;Msg:'Proxy Authentication Required') ,
      (Code:408;Msg:'Request Time-out') ,
      (Code:409;Msg:'Conflict') ,
      (Code:410;Msg:'Gone') ,
      (Code:411;Msg:'Length Required') ,
      (Code:412;Msg:'Precondition Failed') ,
      (Code:413;Msg:'Request Entity Too Large') ,
      (Code:414;Msg:'Request-URI Too Large') ,
      (Code:415;Msg:'Unsupported Media Type') ,
      (Code:416;Msg:'Requested Range Not Satisfiable') ,
      (Code:417;Msg:'Expectation Failed') ,
      (Code:500;Msg:'Internal Server Error') ,
      (Code:501;Msg:'Not Implemented') ,
      (Code:502;Msg:'Bad Gateway') ,
      (Code:503;Msg:'Service Unavailable') ,
      (Code:504;Msg:'Gateway Time-out') ,
      (Code:505;Msg:'HTTP Version Not Supported') ) ;

type
   HTTPTBasicEvent=procedure (ClientThread:TDXClientThread;HeaderInfo:PHeaderInfo;var EnableKeepAlive:Boolean) of object;
   HTTPTOtherEvent=procedure (ClientThread:TDXClientThread;HeaderInfo:PHeaderInfo;var Handled:Boolean) of object;

   TDXHTTPServerCore=class (TDXServerCore)
   private
      fOnCommandGET:HTTPTBasicEvent;// GET <file> HTTP/1.0
      fOnCommandPOST:HTTPTBasicEvent;// POST <file> HTTP/1.0
      fOnCommandHEAD:HTTPTBasicEvent;// HEAD <file> HTTP/1.0
      fOnCommandCHECKOUT:HTTPTBasicEvent;
      fOnCommandSHOWMETHOD:HTTPTBasicEvent;
      fOnCommandPUT:HTTPTBasicEvent;
      fOnCommandDELETE:HTTPTBasicEvent;
      fOnCommandLINK:HTTPTBasicEvent;
      fOnCommandUNLINK:HTTPTBasicEvent;
      fOnCommandCHECKIN:HTTPTBasicEvent;
      fOnCommandTEXTSEARCH:HTTPTBasicEvent;
      fOnCommandSPACEJUMP:HTTPTBasicEvent;
      fOnCommandSEARCH:HTTPTBasicEvent;
      fOnCommandOPTIONS:HTTPTBasicEvent;
      fOnCommandTRACE:HTTPTBasicEvent;
      fOnCommandCONNECT:HTTPTBasicEvent;
      fOnCommandPATCH:HTTPTBasicEvent;
      fOnCommandOther:HTTPTOtherEvent;
      fSupportKeepAlive:Boolean;
      fDXISAPI:TDXISAPI;
   protected
      procedure SetOnCommandGET (value:HTTPTBasicEvent) ;
      procedure SetOnCommandPOST (value:HTTPTBasicEvent) ;
      procedure SetOnCommandHEAD (value:HTTPTBasicEvent) ;
      procedure SetOnCommandCHECKOUT (value:HTTPTBasicEvent) ;
      procedure SetOnCommandSHOWMETHOD (value:HTTPTBasicEvent) ;
      procedure SetOnCommandPUT (value:HTTPTBasicEvent) ;
      procedure SetOnCommandDELETE (value:HTTPTBasicEvent) ;
      procedure SetOnCommandLINK (value:HTTPTBasicEvent) ;
      procedure SetOnCommandUNLINK (value:HTTPTBasicEvent) ;
      procedure SetOnCommandCHECKIN (value:HTTPTBasicEvent) ;
      procedure SetOnCommandTEXTSEARCH (value:HTTPTBasicEvent) ;
      procedure SetOnCommandSPACEJUMP (value:HTTPTBasicEvent) ;
      procedure SetOnCommandSEARCH (value:HTTPTBasicEvent) ;
      procedure SetOnCommandOPTIONS (value:HTTPTBasicEvent) ;
      procedure SetOnCommandTRACE (value:HTTPTBasicEvent) ;
      procedure SetOnCommandCONNECT (value:HTTPTBasicEvent) ;
      procedure SetOnCommandPATCH (value:HTTPTBasicEvent) ;
   public
      constructor Create (AOwner:TComponent) ;
{$IFNDEF OBJECTS_ONLY}override;
{$ENDIF}
      destructor Destroy;override;
      procedure ProcessSession (ClientThread:TDXClientThread) ;
      procedure AddBasicEvent (Command:string;EventProc:HTTPTBasicEvent) ;
      function HeaderText (StatusCode:Integer) :string;//2.0.12
      procedure Start;override;
      procedure Stop;override;
   published
      property SupportKeepAlive:Boolean read fSupportKeepAlive
         write fSupportKeepAlive;
      property OnCommandGET:HTTPTBasicEvent read fOnCommandGET
         write SetOnCommandGET;
      property OnCommandPOST:HTTPTBasicEvent read fOnCommandPOST
         write SetOnCommandPOST;
      property OnCommandHEAD:HTTPTBasicEvent read fOnCommandHEAD
         write SetOnCommandHEAD;
      property OnCommandCHECKOUT:HTTPTBasicEvent read fOnCommandCHECKOUT
         write SetOnCommandCHECKOUT;
      property OnCommandSHOWMETHOD:HTTPTBasicEvent read fOnCommandSHOWMETHOD
         write SetOnCommandSHOWMETHOD;
      property OnCommandPUT:HTTPTBasicEvent read fOnCommandPUT
         write SetOnCommandPUT;
      property OnCommandDELETE:HTTPTBasicEvent read fOnCommandDELETE
         write SetOnCommandDELETE;
      property OnCommandLINK:HTTPTBasicEvent read fOnCommandLINK
         write SetOnCommandLINK;
      property OnCommandUNLINK:HTTPTBasicEvent read fOnCommandUNLINK
         write SetOnCommandUNLINK;
      property OnCommandCHECKIN:HTTPTBasicEvent read fOnCommandCHECKIN
         write SetOnCommandCHECKIN;
      property OnCommandTEXTSEARCH:HTTPTBasicEvent read fOnCommandTEXTSEARCH
         write SetOnCommandTEXTSEARCH;
      property OnCommandSPACEJUMP:HTTPTBasicEvent read fOnCommandSPACEJUMP
         write SetOnCommandSPACEJUMP;
      property OnCommandSEARCH:HTTPTBasicEvent read fOnCommandSEARCH
         write SetOnCommandSEARCH;
      property OnCommandOPTIONS:HTTPTBasicEvent read fOnCommandOPTIONS
         write SetOnCommandOPTIONS;
      property OnCommandTRACE:HTTPTBasicEvent read fOnCommandTRACE
         write SetOnCommandTRACE;
      property OnCommandCONNECT:HTTPTBasicEvent read fOnCommandCONNECT
         write SetOnCommandCONNECT;
      property OnCommandPATCH:HTTPTBasicEvent read fOnCommandPATCH
         write SetOnCommandPATCH;
      property OnCommandOther:HTTPTOtherEvent read fOnCommandOther
         write fOnCommandOther;
      property ISAPIServer:TDXISAPI read fDXISAPI
         write fDXISAPI;
   end;

implementation

uses
   DXSock,
   SysUtils,
   DXString;

type
   PHTTPBasicEvent=^THTTPBasicEvent;
   THTTPBasicEvent=record
      Tag:Integer;
      Command:string;
      EventProcedure:HTTPTBasicEvent;
   end;

///////////////////////////////////////////////////////////////////////////////
//CREATE:
//       Define the Default Port number to Listen On.
///////////////////////////////////////////////////////////////////////////////

constructor TDXHTTPServerCore.Create (AOwner:TComponent) ;
begin
   inherited Create (AOwner) ;
   ServerPort:=80;
   Timeout:=30000;
end;

///////////////////////////////////////////////////////////////////////////////
//DESTROY:
//        Destory this object.
///////////////////////////////////////////////////////////////////////////////

destructor TDXHTTPServerCore.Destroy;
var
   PBasicEvent:PHTTPBasicEvent;

begin
   if Assigned (fEventArray) then begin
      while fEventArray.Count>0 do begin
         case PHTTPBasicEvent (fEventArray[0]) .Tag of
            1:begin
                  PBasicEvent:=fEventArray[0];
                  Dispose (PBasicEvent) ;
               end;
         end;
         fEventArray.Delete (0) ;
      end;
   end;
   inherited Destroy;
end;

procedure TDXHTTPServerCore.AddBasicEvent (Command:string;EventProc:HTTPTBasicEvent) ;
var
   PBasicEvent:PHTTPBasicEvent;
   Loop:Integer;

begin
   Command:=Uppercase (Command) ;
   Loop:=0;
   while Loop<fEventArray.Count do begin
      if PHTTPBasicEvent (fEventArray[Loop]) .Command=Command then begin
         PHTTPBasicEvent (fEventArray[Loop]) .EventProcedure:=EventProc;
         Exit;
      end
      else Inc (Loop) ;
   end;
   New (PBasicEvent) ;
   PBasicEvent.Tag:=1;// Denotes Event in fEventArray is a TBasicEvent!
   PBasicEvent.Command:=Command;
   PBasicEvent.EventProcedure:=EventProc;
   fEventArray.Add (PBasicEvent) ;
end;

procedure TDXHTTPServerCore.SetOnCommandGET (value:HTTPTBasicEvent) ;
begin
   fOnCommandGET:=Value;
   AddBasicEvent ('GET',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandPOST (value:HTTPTBasicEvent) ;
begin
   fOnCommandPOST:=Value;
   AddBasicEvent ('POST',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandHEAD (value:HTTPTBasicEvent) ;
begin
   fOnCommandHEAD:=Value;
   AddBasicEvent ('HEAD',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandCHECKOUT (value:HTTPTBasicEvent) ;
begin
   fOnCommandCHECKOUT:=Value;
   AddBasicEvent ('CHECKOUT',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandSHOWMETHOD (value:HTTPTBasicEvent) ;
begin
   fOnCommandSHOWMETHOD:=Value;
   AddBasicEvent ('SHOWMETHOD',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandPUT (value:HTTPTBasicEvent) ;
begin
   fOnCommandPUT:=Value;
   AddBasicEvent ('PUT',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandDELETE (value:HTTPTBasicEvent) ;
begin
   fOnCommandDELETE:=Value;
   AddBasicEvent ('DELETE',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandLINK (value:HTTPTBasicEvent) ;
begin
   fOnCommandLINK:=Value;
   AddBasicEvent ('LINK',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandUNLINK (value:HTTPTBasicEvent) ;
begin
   fOnCommandUNLINK:=Value;
   AddBasicEvent ('UNLINK',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandCHECKIN (value:HTTPTBasicEvent) ;
begin
   fOnCommandCHECKIN:=Value;
   AddBasicEvent ('CHECKIN',Value) ;
end;

procedure TDXHTTPServerCore.SetOnCommandTEXTSEARCH (value:HTTPTBasicEvent) ;
begin