home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Internet / ISAPITER.DPR < prev    next >
Encoding:
Text File  |  1999-08-11  |  4.2 KB  |  153 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       NSAPI to ISAPI interface library                }
  6. {                                                       }
  7. {       Copyright (c) 1997,98 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. {$IMAGEBASE $40000000}
  12.  
  13. library ISAPIter;
  14.  
  15. uses
  16.   SysUtils,
  17.   Classes,
  18.   NSAPI,
  19.   {$IFDEF NETSCAPE3}
  20.   NS30Fix,
  21.   {$ENDIF}
  22.   {$IFDEF NETSCAPE35}
  23.   NS35Fix,
  24.   {$ENDIF}
  25.   {$IFDEF NETSCAPE36}
  26.   NS36Fix,
  27.   {$ENDIF}
  28.   NSToIS;
  29.  
  30. {$R *.RES}
  31.  
  32. function GetDocumentRoot(os: PHttpdObjSet): string;
  33. var
  34.   obj: PHttpdObject;
  35.   dt: PDtable;
  36.   dir: PDirective;
  37.   I, J: Integer;
  38. begin
  39.   Result := '';
  40.   if os <> nil then
  41.   begin
  42.     obj := objset_findbyname('default', nil, os);
  43.     if obj <> nil then
  44.     begin
  45.       dt := obj.dt;
  46.       for I := 0 to obj.nd - 1 do
  47.       begin
  48.         dir := dt.inst;
  49.         for J := 0 to dt.ni - 1 do
  50.         begin
  51.           if (dir <> nil) and (dir.param <> nil) then
  52.             if CompareText(NSstr2String(pblock_findval('fn', dir.param)), 'document-root') = 0 then
  53.             begin
  54.               Result := NSstr2String(pblock_findval('root', dir.param));
  55.               Exit;
  56.             end;
  57.           Inc(dir);
  58.         end;
  59.         Inc(dt);
  60.       end;
  61.     end;
  62.   end;
  63. end;
  64.  
  65. const
  66.   sInternalServerError = '<html><title>Internal Server Error 500</title>'#13#10 +
  67.     '<h1>Internal Server Error 500</h1><hr>'#13#10 +
  68.     'Exception: %s<br>'#13#10 +
  69.     'Message: %s<br></html>'#13#10;
  70.  
  71. function HandleServerException(E: Exception; pb: PPblock; sn: PSession; rq: Prequest): Integer;
  72. var
  73.   ResultText: string;
  74.   ContentLen: Integer;
  75. begin
  76.   if net_isalive(sn.csd) then
  77.   begin
  78.     http_status(sn, rq, PROTOCOL_SERVER_ERROR, PChar(E.Message));
  79.     ResultText := Format(sInternalServerError, [E.ClassName, E.Message]);
  80.     ContentLen := Length(ResultText);
  81.     param_free(pblock_remove('content-type', rq.srvhdrs));
  82.     pblock_nvinsert('content-type', 'text/html', rq.srvhdrs);
  83.     pblock_nninsert('content-length', ContentLen, rq.srvhdrs);
  84.     if http_start_response(sn, rq) <> REQ_NOACTION then
  85.       net_write(sn.csd, PChar(ResultText), ContentLen);
  86.   end;
  87.   Result := REQ_ABORTED;
  88. end;
  89.  
  90. procedure terminate_isapi(parameter: Pointer); cdecl; export;
  91. begin
  92.   DoneISAPIApplicationList;
  93. end;
  94.  
  95. function init_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  96. begin
  97.   InitISAPIApplicationList;
  98.   magnus_atrestart(terminate_isapi, nil);
  99.   Result := REQ_PROCEED;
  100. end;
  101.  
  102. function handle_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  103. var
  104.   DLLPath: string;
  105.   ISAPIApplication: TISAPIApplication;
  106.   ISAPISession: TISAPISession;
  107. begin
  108.   try
  109.     DLLPath := UnixPathToDosPath(NSstr2String(pblock_findval('dll-path', rq.vars)));
  110.     InitISAPIApplicationList;
  111.     ISAPIApplication := ISAPIApplicationList.LoadApplication(DLLPath);
  112.     ISAPISession := TISAPISession.Create(pb, sn, rq, ISAPIApplication);
  113.     try
  114.       ISAPISession.ProcessExtension;
  115.       Result := REQ_PROCEED;
  116.     finally
  117.       ISAPISession.Free;
  118.     end;
  119.   except
  120.     Result := HandleServerException(Exception(ExceptObject), pb, sn, rq);
  121.   end;
  122. end;
  123.  
  124. function check_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  125. var
  126.   Path, PathInfo: string;
  127. begin
  128.   try
  129.     Path := NSstr2String(pblock_findval('path', rq.vars));
  130.     pblock_nvinsert('dll-path', PChar(Path), rq.vars);
  131.     PathInfo := NSstr2String(pblock_findval('path-info', rq.vars));
  132.     pblock_nvinsert('path-translated', PChar(GetDocumentRoot(rq.os) + PathInfo), rq.vars);
  133.     Result := REQ_PROCEED;
  134.   except
  135.     Result := HandleServerException(Exception(ExceptObject), pb, sn, rq);
  136.   end;
  137. end;
  138.  
  139. function log_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  140. begin
  141.   InitISAPIApplicationList;
  142.   Result := ISAPIApplicationList.InitLog(pb, sn, rq);
  143. end;
  144.  
  145. exports
  146.   handle_isapi,
  147.   check_isapi,
  148.   log_isapi,
  149.   init_isapi;
  150.  
  151. begin
  152. end.
  153.