dxcgi.pas

Well known and usefull component for delphi 7

unit DXCGI;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXCGI
//       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: Implementation of Common Gateway Interface Shells for HTTP
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

uses
   DXHTTPHeaderTools,
   Classes;

{$I DXAddons.def}

{$WARNINGS OFF}
{$HINTS OFF}
type
   // new as of Dec 1st, 2003:
   PExtraVariables=^TExtraVariables;
   TExtraVariables=Record
      APPL_MD_PATH:String;
      APPL_PHYSICAL_PATH:String;
      INSTANCE_META_DATA:String;
      SERVER_SOFTWARE:String;
      SERVER_VERSION:String;
      SERVER_PORT:String;
   End;
   {$IFDEF OBJECTS_ONLY}
   // TDXCGI allows your servers to spawn a CGI (Common Gateway
   // Interface) application. Automatically passing standard input
   // and the required information via environmental variables to
   // the application. And automatically receiving the standard
   // \output and standard error.
   //
   //
   //
   // Summary
   // Support the execution of a Common Gatewaye Interface
   // application from yuor application.
   TDXCGI=class
      {$ELSE}
   TDXCGI=class(TComponent)
      {$ENDIF}
   private
      // Private declarations
   protected
      // Protected declarations
   public
      // Public declarations
      {$IFDEF OBJECTS_ONLY}
      constructor Create;
      {$ELSE}
      constructor Create(AOwner:TComponent); override;
      {$ENDIF}
      destructor Destroy; override;
      // <B>CGIProgram</B> should be set the full program name,
      // including extension. e.g. welcome.exe<B>
      //
      //
      //
      // PathToCGI</B> should be set to the full qualified path, where
      // the CGIProgram resides.<B>
      //
      //
      //
      // HeaderInfo</B> (optional) should be set to the PHeaderInfo
      // from the HTTP Server Core if this is a web based application.
      // Set to NIL otherwise.<B>
      //
      //
      //
      // \Output</B> will contain the standard output from the
      // application, even if it is a graphical file.<B>
      //
      //
      //
      // ErrorMsg</B> will contain the standard error output from the
      // application - if an error has occured.
      //
      //
      //
      // \Returns:
      //
      // True if the CGI application has been successfully called,
      // executed and returned with no operating system error. This
      // does not mean the CGI successfully ran as planned.
      //
      //
      //
      // False if the CGI application was not found, was a GUI
      // application, returned an operating system error. In this case
      // refer to the ErrorMsg variable.
      //
      //
      //
      // \See Also
      //
      // <LINK TDXCGI.ExecuteGUIScript, ExecuteGUIScript>
      //
      //
      //
      // Summary
      // Execute a standard CGI application.
      function ExecuteScript(const CGIProgram, PathToCGI:string;
         HeaderInfo:PHeaderInfo;ExtraVariables:PExtraVariables; var Output, ErrorMsg:string):Boolean;
      // <B>CGIProgram</B> should be set the full program name,
      // including extension. e.g. welcome.exe<B>
      //
      //
      //
      // PathToCGI</B> should be set to the full qualified path, where
      // the CGIProgram resides.<B>
      //
      //
      //
      // HeaderInfo</B> (optional) should be set to the PHeaderInfo
      // from the HTTP Server Core if this is a web based application.
      // Set to NIL otherwise.<B>
      //
      //
      //
      // \Output</B> will contain the standard output from the
      // application, even if it is a graphical file.<B>
      //
      //
      //
      // ErrorMsg</B> will contain the standard error output from the
      // application - if an error has occured.
      //
      //
      //
      // \Returns:
      //
      // True if the CGI application has been successfully called,
      // executed and returned with no operating system error. This
      // does not mean the CGI successfully ran as planned.
      //
      //
      //
      // False if the CGI application was not found, returned an
      // operating system error. In this case refer to the ErrorMsg
      // variable.<B>
      //
      //
      //
      // \Note</B> this call ignores any GUI related errors. As some
      // CGI engines supported by the Borland compilers are based upon
      // TForm, and thus report as a GUI application, even though they
      // are CGI applications.
      //
      //
      //
      // \See Also
      //
      // <LINK TDXCGI.ExecuteScript, ExecuteScript>
      //
      //
      //
      // Summary
      // Execute a GUI based CGI application.
      function ExecuteGUIScript(const CGIProgram, PathToCGI:string;
         HeaderInfo:PHeaderInfo;ExtraVariables:PExtraVariables; var Output, ErrorMsg:string):Boolean;
   published
   end;

implementation

uses
{$IFNDEF LINUX}
   Windows,
{$ENDIF}
   DXString,
   SysUtils;

type
   TPipeReadStdThread=class(TThread)
      Error:Boolean;
      HPipe:DWORD;
      s:string;
      procedure Execute; override;
   end;

   TPipeWriteStdThread=class(TThread)
      HPipe:DWORD;
      s:string;
      procedure Execute; override;
   end;

   TPipeReadErrThread=class(TThread)
      HPipe:DWORD;
      s:string;
      procedure Execute; override;
   end;

procedure TPipeWriteStdThread.Execute;
var
   j:DWORD;
   slen:Integer;

begin
   slen:=Length(s);
   if slen>0 then
      WriteFile(HPipe, s[1], slen, j, nil);
end;

procedure TPipeReadErrThread.Execute;
var
   ss:ShortString;
   j:DWORD;

begin
   repeat
      if not ReadFile(HPipe, ss[1], 250, j, nil) then Break;
      ss[0]:=Char(j);
      s:=s+ss;
   until Terminated;
end;

procedure TPipeReadStdThread.Execute;
var
   j:DWORD;
   ss:ShortString;

begin
   repeat
      if not ReadFile(HPipe, ss[1], 250, j, nil) then Break;
      ss[0]:=Char(j);
      s:=s+ss;
   until Terminated;
   j:=GetLastError
end;

{$IFDEF OBJECTS_ONLY}

constructor TDXCGI.Create;
{$ELSE}

constructor TDXCGI.Create(AOwner:TComponent);
{$ENDIF}
begin
   {$IFDEF OBJECTS_ONLY}
   inherited Create;
   {$ELSE}
   inherited Create(AOwner);
   {$ENDIF}
end;

destructor TDXCGI.Destroy;
begin
   inherited Destroy;
end;

function TDXCGI.ExecuteScript(const CGIProgram, PathToCGI:string;
   HeaderInfo:PHeaderInfo;ExtraVariables:PExtraVariables; var Output, ErrorMsg:string):Boolean;
var
   Security:TSecurityAttributes;
   StdIn_Read, StdIn_Write:THandle;
   StdOut_Read, StdOut_Write:THandle;
   StdErr_Read, StdErr_Write:THandle;
   StartupInfo:TStartupInfo;
   Status:Boolean;
   ProcessInformation:TProcessInformation;
   PipeReadStdThread:TPipeReadStdThread;
   PipeWriteStdThread:TPipeWriteStdThread;
   PipeReadErrThread:TPipeReadErrThread;
   Actually:DWORD;
   ActualIn:ShortString;

   function GetEnvStr:string;
   var
      AuxS:string;
      p:PByteArray;
      j:Integer;

      procedure Add(const Name, Value:string);
      begin
         if Value<>'' then Result:=Result+Name+'='+Value+#0;
      end;

   begin
      p:=Pointer(GetEnvironmentStrings);
      j:=0;
      while (p^[j]<>0)or(p^[j+1]<>0) do
         Inc(j);
      Inc(j);
      SetLength(Result, j);
      FastMove(p^, Result[1], j);
      FreeEnvironmentStrings(Pointer(p));
      If Copy(Result,1,6)= '=::=::' then Delete(Result,1,8);
      if Assigned(HeaderInfo) then begin
//         AuxS:=ToUnixSlashes(AddbackSlash(PathToCGI));
         AuxS:=HeaderInfo^.URI; // Dec-1-2003 OZZ
         Add('PATH_INFO', AuxS);
         if AuxS<>'' then AuxS:=AddbackSlash(PathToCGI);
         Add('PATH_TRANSLATED', AuxS);
         Add('REMOTE_HOST', HeaderInfo^.ClientHost);
         Add('REMOTE_ADDR', HeaderInfo^.ClientAddr);
         Add('GATEWAY_INTERFACE', 'CGI/1.2');
         Add('SCRIPT_NAME', HeaderInfo^.URI);