home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d3456 / KBMWABD.ZIP / WABD_ISAPI.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-29  |  10KB  |  331 lines
  1. unit WABD_ISAPI;
  2. {$ifndef VER100} // CBuilder only
  3. {$ObjExportAll On}
  4. {$endif}
  5.  
  6. interface
  7.  
  8. uses Windows, SysUtils, Classes, Forms, StdCtrls,
  9.      WABD_Request, WABD_HTMLRequest, WABD_Response, WABD_HTMLResponse, WABD_Utils,
  10.      ISAPI2;
  11.  
  12. type
  13.    TServerVar = record
  14.       REMOTE_ADDR       : string;
  15.       REMOTE_HOST       : string;
  16.       REMOTE_USER       : string;
  17.       SERVER_NAME       : string;
  18.       SERVER_PORT       : string;
  19.       SERVER_PROTOCOL   : string;
  20.       SERVER_SOFTWARE   : string;
  21.       CONTENT_TYPE      : string;
  22.       CONTENT_LENGTH    : string;
  23.       SCRIPT_NAME       : string;
  24.       ACCEPT            : string;
  25.       QUERY_STRING      : string;
  26.       ALL               : string;
  27.    end;
  28.  
  29.    TWABD_ISAPIHTMLRequest = class(TWABD_CustomHTMLRequest)
  30.    protected
  31.       function GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean; override;
  32.    public
  33.       ECB: TEXTENSION_CONTROL_BLOCK;
  34.  
  35.       constructor Create(const ECB: TEXTENSION_CONTROL_BLOCK; MaxSize:integer);
  36.       procedure Parse; override;
  37.    end;
  38.  
  39.    TWABD_ISAPIHTMLResponse = class(TWABD_CustomHTMLResponse);
  40.  
  41.    TWABD_Callback = procedure(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse) of object;
  42.    TWABD_Term_Callback = function(Flags:Longint):boolean of object;
  43.  
  44. function RunningLocal: boolean;
  45. procedure SetRunLocal(b: boolean);
  46.  
  47. // These functions are required to interface with ISAPI
  48. function GetExtensionVersion(var Ver: THSE_VERSION_INFO):boolean; stdcall;
  49. function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):DWORD; stdcall;
  50. function Hook_HttpExtensionProc(p: pointer):DWORD; stdcall;
  51. function TerminateExtension(dwFlags:DWORD):boolean; stdcall;
  52.  
  53. // This method should be called on DLL load, after the main form has been created.
  54. procedure WABD_Startup;
  55.  
  56. // This method should be called on DLL unload.
  57. procedure WABD_Shutdown;
  58.  
  59. // These are ISAPI Help functions
  60. function  ISAPI_GetOneVar(var ECB: TEXTENSION_CONTROL_BLOCK; const VarName: string): string;
  61. procedure ISAPI_GetServerVars(var ECB: TEXTENSION_CONTROL_BLOCK; var sv: TServerVar);
  62.  
  63. procedure Register_WABD_Callback(Callback: TWABD_Callback);
  64. procedure Register_WABD_Term_Callback(Callback: TWABD_Term_Callback);
  65.  
  66. exports
  67.    GetExtensionVersion,
  68.    HttpExtensionProc,
  69.    TerminateExtension;
  70.  
  71. implementation
  72.  
  73. uses WABD_Objects;
  74.  
  75. var
  76.    RunLocal       : boolean;
  77.    WABD_Callback  : TWABD_Callback;
  78.    WABD_Term_Callback  : TWABD_Term_Callback;
  79.    TerminateExtensionCalled:boolean;
  80.  
  81. const
  82.    ContTypeURL = 'application/x-www-form-urlencoded';
  83.    ContTypeMF  = 'multipart/form-data';
  84.  
  85. {$ifdef KBM}
  86. procedure _WABD_DoLoad(parent:TComponent);
  87. var
  88.    i:integer;
  89. begin
  90.      with parent do
  91.      begin
  92.           for i:=0 to componentcount-1 do
  93.           begin
  94.                if components[i] is TWABD_SessionMgr then
  95.                begin
  96.                     with TWABD_SessionMgr(components[i]) do
  97.                          if AutoLoad then Load;
  98.                end
  99.                else if components[i] is TWABD_Admin then
  100.                begin
  101.                     with TWABD_Admin(components[i]) do
  102.                          if AutoLoad then Load;
  103.                end
  104.                else if components[i] is TWABD_Setup then
  105.                begin
  106.                     with TWABD_Setup(components[i]) do
  107.                          if AutoLoad then Load;
  108.                end;
  109.  
  110.                _WABD_DoLoad(components[i]);
  111.           end;
  112.      end;
  113. end;
  114. {$endif}
  115.  
  116. procedure WABD_Startup;
  117. begin
  118. {     // Loop through all components in application and do their load.
  119.      _WABD_DoLoad(Forms.Application);
  120. }
  121. end;
  122.  
  123. procedure WABD_Shutdown;
  124. begin
  125.      if (not TerminateExtensionCalled) then TerminateExtension(0);
  126.  
  127.      WABD_Callback:=nil;
  128.      WABD_Term_Callback:=nil;
  129.  
  130.      // Shutdown the application in an orderly manner.
  131.      with Forms.Application do
  132.      begin
  133.          if Handle <> 0 then ShowOwnedPopups(Handle, False);
  134.           ShowHint := False;
  135.           Destroying;
  136.           DestroyComponents;
  137.      end;
  138.      with Application do
  139.      begin
  140.           Destroying;
  141.           DestroyComponents;
  142.           free;
  143.      end;
  144.      Application:=nil;
  145. end;
  146.  
  147. procedure Register_WABD_Callback(Callback: TWABD_Callback);
  148. begin
  149.    WABD_Callback := Callback;
  150. //   DLLProc:=@DLLHandler;
  151. end;
  152.  
  153. procedure Register_WABD_Term_Callback(Callback: TWABD_Term_Callback);
  154. begin
  155.    WABD_Term_Callback := Callback;
  156. end;
  157.  
  158. function RunningLocal: boolean;
  159. begin
  160.    Result := RunLocal;
  161. end;
  162.  
  163. procedure SetRunLocal(b: boolean);
  164. begin
  165.    RunLocal := b;
  166. end;
  167.  
  168. // ****************************************************************
  169. // ISAPI Interface Functions
  170.  
  171. function GetExtensionVersion(var Ver: THSE_VERSION_INFO):boolean; stdcall;
  172. begin
  173.   Ver.dwExtensionVersion := HSE_VERSION_MINOR or (HSE_VERSION_MAJOR shl 16);
  174.   Ver.lpszExtensionDesc  := 'BCB 3..5,Delphi 2..5 ISAPI DLL';   // Description
  175.   Result := True;
  176. end;
  177.  
  178. function TerminateExtension(dwFlags:DWORD):boolean; stdcall;
  179. begin
  180.      if not assigned(WABD_Term_Callback) then result:=true
  181.      else Result:=WABD_Term_Callback(dwFlags);
  182.      TerminateExtensionCalled:=true;
  183. end;
  184.  
  185. function Hook_HttpExtensionProc(p: pointer):DWORD;
  186. begin
  187.     Result := HttpExtensionProc(PEXTENSION_CONTROL_BLOCK(p)^);
  188. end;
  189.  
  190. function HttpExtensionProc( var ECB: TEXTENSION_CONTROL_BLOCK ):DWORD; stdcall;
  191. var
  192.   ResStr : string;
  193.   StrLen : DWORD;
  194.   Status : integer;
  195.   Request : TWABD_ISAPIHTMLRequest;
  196.   Response : TWABD_ISAPIHTMLResponse;
  197. begin
  198.    if ECB.dwVersion <> $DEADF00D then RunLocal := False;
  199.  
  200. //   Start := GetTickCount;
  201.    ECB.lpszLogData      := 'Delphi DLL Log';
  202.  
  203.    // Build request.
  204.    Status:=WABD_STATUS_OK;
  205.    if Assigned(WABD_Callback) then
  206.    begin
  207.         Request:=TWABD_ISAPIHTMLRequest.Create(ECB,-1);
  208.         Response:=TWABD_ISAPIHTMLResponse.Create;
  209.         try
  210.            Request.Parse;
  211.            WABD_Callback(Request,Response);
  212.            Status:=Response.Status;
  213.            ResStr:=Response.FormatResponse;
  214.         finally
  215.            Request.Free;
  216.            Response.Free;
  217.         end;
  218.    end
  219.    else
  220.       ResStr := 'WABD Callback not registered!';
  221.  
  222.    ECB.dwHTTPStatusCode := Status;
  223.    StrLen := Length(ResStr);
  224.    ECB.WriteClient(ECB.ConnID, Pointer(ResStr), StrLen, 1); // Syncrone write.
  225.    Result := HSE_STATUS_SUCCESS;
  226. end;
  227.  
  228.  
  229. // ****************************************************************
  230. // ISAPI Helper Functions
  231.  
  232. function  ISAPI_GetOneVar(var ECB: TEXTENSION_CONTROL_BLOCK; const VarName: string): string;
  233. var
  234.   StrLen : DWORD;
  235.   Buf    : array[0..1024] of char;
  236. begin
  237.    StrLen := Sizeof(Buf);
  238.    ECB.GetServerVariable(ECB.ConnID, PChar(VarName), @Buf, StrLen);
  239.    Result := Buf;
  240. end;
  241.  
  242.  
  243. procedure ISAPI_GetServerVars(var ECB: TEXTENSION_CONTROL_BLOCK; var sv: TServerVar);
  244. begin
  245.    sv.REMOTE_ADDR     := ISAPI_GetOneVar(ECB, 'REMOTE_ADDR');
  246.    sv.REMOTE_HOST     := ISAPI_GetOneVar(ECB, 'REMOTE_HOST');
  247.    sv.REMOTE_USER     := ISAPI_GetOneVar(ECB, 'REMOTE_USER');
  248.    sv.SERVER_NAME     := ISAPI_GetOneVar(ECB, 'SERVER_NAME');
  249.    sv.SERVER_PORT     := ISAPI_GetOneVar(ECB, 'SERVER_PORT');
  250.    sv.SERVER_PROTOCOL := ISAPI_GetOneVar(ECB, 'SERVER_PROTOCOL');
  251.    sv.SERVER_SOFTWARE := ISAPI_GetOneVar(ECB, 'SERVER_SOFTWARE');
  252.    sv.CONTENT_TYPE    := ISAPI_GetOneVar(ECB, 'CONTENT_TYPE');
  253.    sv.CONTENT_LENGTH  := ISAPI_GetOneVar(ECB, 'CONTENT_LENGTH');
  254.    sv.SCRIPT_NAME     := ISAPI_GetOneVar(ECB, 'SCRIPT_NAME');
  255.    sv.ACCEPT          := ISAPI_GetOneVar(ECB, 'HTTP_ACCEPT');
  256.    sv.QUERY_STRING    := ISAPI_GetOneVar(ECB, 'QUERY_STRING');
  257.    sv.ALL             := ISAPI_GetOneVar(ECB, 'ALL_HTTP');
  258. end;
  259.  
  260. // ========================================================================
  261. // ISAPI HTML Request handling.
  262. // ========================================================================
  263. constructor TWABD_ISAPIHTMLRequest.Create(const ECB: TEXTENSION_CONTROL_BLOCK; MaxSize:integer);
  264. begin
  265.      inherited Create(MaxSize);
  266.      Self.ECB:=ECB;
  267. end;
  268.  
  269. function TWABD_ISAPIHTMLRequest.GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean;
  270. var
  271.    sz:Cardinal;
  272. begin
  273.      sz:=BufSize;
  274.      Result:=ECB.ReadClient(ECB.ConnID,Buffer,sz);
  275.      BufSize:=sz;
  276. end;
  277.  
  278. procedure TWABD_ISAPIHTMLRequest.Parse;
  279. var
  280.    p:integer;
  281.    boundary:string;
  282.    sHeaders:string;
  283.    sContentType:string;
  284. begin
  285.      // Extract variables from server.
  286.      FDLLName:=ISAPI_GetOneVar(ECB,'SCRIPT_NAME');
  287.      FRemoteHost:=ISAPI_GetOneVar(ECB,'REMOTE_HOST');
  288.      FRemoteAddr:=ISAPI_GetOneVar(ECB,'REMOTE_ADDR');
  289.      FRemoteUser:=ISAPI_GetOneVar(ECB,'REMOTE_USER');
  290.      FAuth:=ISAPI_GetOneVar(ECB,'HTTP_AUTHORIZATION');
  291.      sHeaders:=ISAPI_GetOneVar(ECB,'ALL_HTTP');
  292.      FSize:=ECB.cbTotalBytes;
  293.      sContentType:=ISAPI_GetOneVar(ECB,'CONTENT_TYPE');
  294.      p:=pos(';',sContentType);
  295.      if (p>0) then FContentType:=copy(sContentType,1,p-1)
  296.      else FContentType:=sContentType;
  297.  
  298.      // Get headers.
  299.      Headers.Clear;
  300.      ParseHeaders(PChar(sHeaders),length(sHeaders),FHeaders);
  301.  
  302.      // Parse query strings.
  303.      Query.Clear;
  304.      ParseURLEncoded(ECB.lpszQueryString,'&',FQuery);
  305.  
  306.      // Check if multipart, parse that too.
  307.      if (LowerCase(FContentType)=ContTypeMF) then
  308.      begin
  309.           p:=Pos('boundary=',LowerCase(sContentType));
  310.           if p>0 then
  311.           begin
  312.                boundary:='--'+trim(copy(sContentType,p+9,length(sContentType)));
  313.                ParseMultipart(ECB.lpbData,ECB.cbAvailable,boundary,FQuery);
  314.           end;
  315.      end
  316.      else
  317.          ParseURLEncoded(ECB.lpbData,'&',FQuery);
  318.  
  319.      // Get cookies.
  320.      Cookies.Clear;
  321.      ParseCookies;
  322. end;
  323.  
  324. initialization
  325.    RunLocal       := True;
  326.    WABD_Callback  := nil;
  327.    TerminateExtensionCalled:=false;
  328. end.
  329.  
  330.  
  331.