Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/d3456/KBMWABD.ZIP/WABD_ISAPI.pas

Pascal/Delphi Source File | 2001-06-29 | 9.7 KB | 331 lines

unit WABD_ISAPI;
{$ifndef VER100} // CBuilder only
{$ObjExportAll On}
{$endif}

interface

uses Windows, SysUtils, Classes, Forms, StdCtrls,
     WABD_Request, WABD_HTMLRequest, WABD_Response, WABD_HTMLResponse, WABD_Utils,
     ISAPI2;

type
   TServerVar = record
      REMOTE_ADDR       : string;
      REMOTE_HOST       : string;
      REMOTE_USER       : string;
      SERVER_NAME       : string;
      SERVER_PORT       : string;
      SERVER_PROTOCOL   : string;
      SERVER_SOFTWARE   : string;
      CONTENT_TYPE      : string;
      CONTENT_LENGTH    : string;
      SCRIPT_NAME       : string;
      ACCEPT            : string;
      QUERY_STRING      : string;
      ALL               : string;
   end;

   TWABD_ISAPIHTMLRequest = class(TWABD_CustomHTMLRequest)
   protected
      function GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean; override;
   public
      ECB: TEXTENSION_CONTROL_BLOCK;

      constructor Create(const ECB: TEXTENSION_CONTROL_BLOCK; MaxSize:integer);
      procedure Parse; override;
   end;

   TWABD_ISAPIHTMLResponse = class(TWABD_CustomHTMLResponse);

   TWABD_Callback = procedure(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse) of object;
   TWABD_Term_Callback = function(Flags:Longint):boolean of object;

function RunningLocal: boolean;
procedure SetRunLocal(b: boolean);

// These functions are required to interface with ISAPI
function GetExtensionVersion(var Ver: THSE_VERSION_INFO):boolean; stdcall;
function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):DWORD; stdcall;
function Hook_HttpExtensionProc(p: pointer):DWORD; stdcall;
function TerminateExtension(dwFlags:DWORD):boolean; stdcall;

// This method should be called on DLL load, after the main form has been created.
procedure WABD_Startup;

// This method should be called on DLL unload.
procedure WABD_Shutdown;

// These are ISAPI Help functions
function  ISAPI_GetOneVar(var ECB: TEXTENSION_CONTROL_BLOCK; const VarName: string): string;
procedure ISAPI_GetServerVars(var ECB: TEXTENSION_CONTROL_BLOCK; var sv: TServerVar);

procedure Register_WABD_Callback(Callback: TWABD_Callback);
procedure Register_WABD_Term_Callback(Callback: TWABD_Term_Callback);

exports
   GetExtensionVersion,
   HttpExtensionProc,
   TerminateExtension;

implementation

uses WABD_Objects;

var
   RunLocal       : boolean;
   WABD_Callback  : TWABD_Callback;
   WABD_Term_Callback  : TWABD_Term_Callback;
   TerminateExtensionCalled:boolean;

const
   ContTypeURL = 'application/x-www-form-urlencoded';
   ContTypeMF  = 'multipart/form-data';

{$ifdef KBM}
procedure _WABD_DoLoad(parent:TComponent);
var
   i:integer;
begin
     with parent do
     begin
          for i:=0 to componentcount-1 do
          begin
               if components[i] is TWABD_SessionMgr then
               begin
                    with TWABD_SessionMgr(components[i]) do
                         if AutoLoad then Load;
               end
               else if components[i] is TWABD_Admin then
               begin
                    with TWABD_Admin(components[i]) do
                         if AutoLoad then Load;
               end
               else if components[i] is TWABD_Setup then
               begin
                    with TWABD_Setup(components[i]) do
                         if AutoLoad then Load;
               end;

               _WABD_DoLoad(components[i]);
          end;
     end;
end;
{$endif}

procedure WABD_Startup;
begin
{     // Loop through all components in application and do their load.
     _WABD_DoLoad(Forms.Application);
}
end;

procedure WABD_Shutdown;
begin
     if (not TerminateExtensionCalled) then TerminateExtension(0);

     WABD_Callback:=nil;
     WABD_Term_Callback:=nil;

     // Shutdown the application in an orderly manner.
     with Forms.Application do
     begin
         if Handle <> 0 then ShowOwnedPopups(Handle, False);
          ShowHint := False;
          Destroying;
          DestroyComponents;
     end;
     with Application do
     begin
          Destroying;
          DestroyComponents;
          free;
     end;
     Application:=nil;
end;

procedure Register_WABD_Callback(Callback: TWABD_Callback);
begin
   WABD_Callback := Callback;
//   DLLProc:=@DLLHandler;
end;

procedure Register_WABD_Term_Callback(Callback: TWABD_Term_Callback);
begin
   WABD_Term_Callback := Callback;
end;

function RunningLocal: boolean;
begin
   Result := RunLocal;
end;

procedure SetRunLocal(b: boolean);
begin
   RunLocal := b;
end;

// ****************************************************************
// ISAPI Interface Functions

function GetExtensionVersion(var Ver: THSE_VERSION_INFO):boolean; stdcall;
begin
  Ver.dwExtensionVersion := HSE_VERSION_MINOR or (HSE_VERSION_MAJOR shl 16);
  Ver.lpszExtensionDesc  := 'BCB 3..5,Delphi 2..5 ISAPI DLL';   // Description
  Result := True;
end;

function TerminateExtension(dwFlags:DWORD):boolean; stdcall;
begin
     if not assigned(WABD_Term_Callback) then result:=true
     else Result:=WABD_Term_Callback(dwFlags);
     TerminateExtensionCalled:=true;
end;

function Hook_HttpExtensionProc(p: pointer):DWORD;
begin
    Result := HttpExtensionProc(PEXTENSION_CONTROL_BLOCK(p)^);
end;

function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):DWORD; stdcall;
var
  ResStr : string;
  StrLen : DWORD;
  Status : integer;
  Request : TWABD_ISAPIHTMLRequest;
  Response : TWABD_ISAPIHTMLResponse;
begin
   if ECB.dwVersion <> $DEADF00D then RunLocal := False;

//   Start := GetTickCount;
   ECB.lpszLogData      := 'Delphi DLL Log';

   // Build request.
   Status:=WABD_STATUS_OK;
   if Assigned(WABD_Callback) then
   begin
        Request:=TWABD_ISAPIHTMLRequest.Create(ECB,-1);
        Response:=TWABD_ISAPIHTMLResponse.Create;
        try
           Request.Parse;
           WABD_Callback(Request,Response);
           Status:=Response.Status;
           ResStr:=Response.FormatResponse;
        finally
           Request.Free;
           Response.Free;
        end;
   end
   else
      ResStr := 'WABD Callback not registered!';

   ECB.dwHTTPStatusCode := Status;
   StrLen := Length(ResStr);
   ECB.WriteClient(ECB.ConnID, Pointer(ResStr), StrLen, 1); // Syncrone write.
   Result := HSE_STATUS_SUCCESS;
end;


// ****************************************************************
// ISAPI Helper Functions

function  ISAPI_GetOneVar(var ECB: TEXTENSION_CONTROL_BLOCK; const VarName: string): string;
var
  StrLen : DWORD;
  Buf    : array[0..1024] of char;
begin
   StrLen := Sizeof(Buf);
   ECB.GetServerVariable(ECB.ConnID, PChar(VarName), @Buf, StrLen);
   Result := Buf;
end;


procedure ISAPI_GetServerVars(var ECB: TEXTENSION_CONTROL_BLOCK; var sv: TServerVar);
begin
   sv.REMOTE_ADDR     := ISAPI_GetOneVar(ECB, 'REMOTE_ADDR');
   sv.REMOTE_HOST     := ISAPI_GetOneVar(ECB, 'REMOTE_HOST');
   sv.REMOTE_USER     := ISAPI_GetOneVar(ECB, 'REMOTE_USER');
   sv.SERVER_NAME     := ISAPI_GetOneVar(ECB, 'SERVER_NAME');
   sv.SERVER_PORT     := ISAPI_GetOneVar(ECB, 'SERVER_PORT');
   sv.SERVER_PROTOCOL := ISAPI_GetOneVar(ECB, 'SERVER_PROTOCOL');
   sv.SERVER_SOFTWARE := ISAPI_GetOneVar(ECB, 'SERVER_SOFTWARE');
   sv.CONTENT_TYPE    := ISAPI_GetOneVar(ECB, 'CONTENT_TYPE');
   sv.CONTENT_LENGTH  := ISAPI_GetOneVar(ECB, 'CONTENT_LENGTH');
   sv.SCRIPT_NAME     := ISAPI_GetOneVar(ECB, 'SCRIPT_NAME');
   sv.ACCEPT          := ISAPI_GetOneVar(ECB, 'HTTP_ACCEPT');
   sv.QUERY_STRING    := ISAPI_GetOneVar(ECB, 'QUERY_STRING');
   sv.ALL             := ISAPI_GetOneVar(ECB, 'ALL_HTTP');
end;

// ========================================================================
// ISAPI HTML Request handling.
// ========================================================================
constructor TWABD_ISAPIHTMLRequest.Create(const ECB: TEXTENSION_CONTROL_BLOCK; MaxSize:integer);
begin
     inherited Create(MaxSize);
     Self.ECB:=ECB;
end;

function TWABD_ISAPIHTMLRequest.GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean;
var
   sz:Cardinal;
begin
     sz:=BufSize;
     Result:=ECB.ReadClient(ECB.ConnID,Buffer,sz);
     BufSize:=sz;
end;

procedure TWABD_ISAPIHTMLRequest.Parse;
var
   p:integer;
   boundary:string;
   sHeaders:string;
   sContentType:string;
begin
     // Extract variables from server.
     FDLLName:=ISAPI_GetOneVar(ECB,'SCRIPT_NAME');
     FRemoteHost:=ISAPI_GetOneVar(ECB,'REMOTE_HOST');
     FRemoteAddr:=ISAPI_GetOneVar(ECB,'REMOTE_ADDR');
     FRemoteUser:=ISAPI_GetOneVar(ECB,'REMOTE_USER');
     FAuth:=ISAPI_GetOneVar(ECB,'HTTP_AUTHORIZATION');
     sHeaders:=ISAPI_GetOneVar(ECB,'ALL_HTTP');
     FSize:=ECB.cbTotalBytes;
     sContentType:=ISAPI_GetOneVar(ECB,'CONTENT_TYPE');
     p:=pos(';',sContentType);
     if (p>0) then FContentType:=copy(sContentType,1,p-1)
     else FContentType:=sContentType;

     // Get headers.
     Headers.Clear;
     ParseHeaders(PChar(sHeaders),length(sHeaders),FHeaders);

     // Parse query strings.
     Query.Clear;
     ParseURLEncoded(ECB.lpszQueryString,'&',FQuery);

     // Check if multipart, parse that too.
     if (LowerCase(FContentType)=ContTypeMF) then
     begin
          p:=Pos('boundary=',LowerCase(sContentType));
          if p>0 then
          begin
               boundary:='--'+trim(copy(sContentType,p+9,length(sContentType)));
               ParseMultipart(ECB.lpbData,ECB.cbAvailable,boundary,FQuery);
          end;
     end
     else
         ParseURLEncoded(ECB.lpbData,'&',FQuery);

     // Get cookies.
     Cookies.Clear;
     ParseCookies;
end;

initialization
   RunLocal       := True;
   WABD_Callback  := nil;
   TerminateExtensionCalled:=false;
end.