rtcphp.pas

来自「Delphi快速开发Web Server」· PAS 代码 · 共 677 行 · 第 1/2 页

{
  @html(<b>)
  PHP Scripting
  @html(</b>)
  - Copyright (c) Danijel Tkalcec
  @html(<br><br>)

  Based on 'PHP 4 Delphi'
    by Serhiy Perevoznyk
    <serge_perevoznyk(at)hotmail.com>
    <http://users.chello.be/ws36637>
  @html(<br>)

  You have to download and install PHP separately.
  It is not included in the package.
  You can download the latest version of PHP from
    <http://www.php.net/downloads.php>
  @html(<br>)

  For more information on the PHP Group and the PHP project,
  please see <http://www.php.net>.
}

unit rtcPHP;

{$INCLUDE rtcDefs.inc}

interface

uses
  rtcTrashcan,
  
  Windows, SysUtils, Classes,

  rtcLog,
  
  rtcInfo,
  rtcPHPTypes,

  rtcThrPool;

type
  { @abstract(All exceptions raised by PHP class will be of this type)
    @exclude }
  EPHPError = class(Exception);

  { @abstract(Provides access to PHP5 file scripting)
    Can be easily used with @Link(TRtcHttpServer) to add
    PHP5 functionality to your HTTP Server. You can create
    as many @name components as you need, as long as each
    of them is created from a different thread. @longcode(#
    IMPORATANT:
      When using TRtcPHP, especially in a multithreaded server,
      YOU HAVE TO create a (temporary) component before processing a
      request and destroy it after the request has been processed.

    NOTE:
      There will be NO EXECUTION SPEED DRAWBACKS from this approach,
      because there is no special initialization in TRtcPHP constructor.
      The only thing that is being initialized in the TRtcPHP
      component are the properties you have to pass to the component.
      Everyting else is initialized from the StatupPHP procedure.

    EXAMPLE:

      function Parse_PHP(Sender:TRtcHttpServer;
                         const PhpFileName, DocRoot:string;
                         var Header:string):string;
        var
          PHP:TRtcPHP;
        begin
        // Create the PHP sripting component
        PHP:=TRtcPHP.Create;
        try
          // Prepare the script for execution
          PHP.FileName:=PhpFileName;
          PHP.DocumentRoot:=DocRoot;

          PHP.LocalAddr:=Sender.LocalAddr;
          PHP.LocalPort:=Sender.LocalPort;
          PHP.PeerAddr:=Sender.PeerAddr;
          PHP.PeerPort:=Sender.PeerPort;

          PHP.Request:=Sender.Request;
          PHP.RequestBody:=Sender.Read;

          // Execute the script
          Result:=PHP.Execute;

          // Get HTTP Header prepared by PHP
          Header:=PHP.ResultHeader;
        finally
          // Release the PHP scripting component
          PHP.Free;
          end;
        end; #) }
  TRtcPHP = class
  private
    FRequest:TRtcRequest;

    FRequestBody : string;

    FPeerAddr:string;
    FPeerPort:string;
    FLocalAddr : string;
    FLocalPort : string;

    FDocumentRoot : string;
    FResultHeader : string;

    FSessionActive : boolean;
    TSRMLS_D  : pppointer;

    FBuffer : TStringList;
    FBufferSize : integer;

    FFileName : string;

    procedure StartupRequest; virtual;
    procedure ShutdownRequest; virtual;

  protected
    { PHP reads posted Body content chunk-wise.
      This variable is used by TRtcPHP to track
      how much of our RequestBody is already out.
      @exclude }
    RequestBodyOut:integer;

  public
    { Create the PHP scripting object }
    constructor Create;
    { Destroy object }
    destructor Destroy; override;

    { EXECUTE the script from file @Link(FileName).
      Before calling Execute, the PHP Library has to
      be initialized by calling @Link(StartupPHP) and
      all TRtcPHP properties have to be filled with valid data.
      Additionally to the resulting HTML page, PHP generates a
      HTML header, accessible from the @Link(ResultHeader) property,
      immediatelly after calling @name.
      @return(HTML output as string) }
    function  Execute : string;

    { SET: Filename to execute, including full path (no relative paths!). }
    property  FileName  : string read FFileName write FFileName;

    { SET: Request information, needed for script execution.
      When using TRtcPHP to execute server-side PHP scripts, simply assign
      the @Link(TRtcDataServer.Request) object from your @Link(TRtcHttpServer)
      connection component.
      This information is used to fill PHP variables. }
    property  Request: TRtcRequest read FRequest write FRequest;

    { SET: Local IP address. Same as @Link(TRtcConnection.LocalAddr).
      When using PHP with a connection component, simply assign the
      connection component's @Link(TRtcConnection.LocalAddr) property.
      This information is used to fill PHP variables. }
    property  LocalAddr : string read FLocalAddr write FLocalAddr;
    { SET: Local Port. Same as @Link(TRtcConnection.LocalPort).
      When using PHP with a connection component, simply assign the
      connection component's @Link(TRtcConnection.LocalAddr) property.
      This information is used to fill PHP variables. }
    property  LocalPort : string read FLocalPort write FLocalPort;
    { SET: Peer (remote PC) Address. Same as @Link(TRtcConnection.PeerAddr).
      When using PHP with a connection component, simply assign the
      connection component's @Link(TRtcConnection.PeerAddr) property.
      This information is used to fill PHP variables. }
    property  PeerAddr:string read FPeerAddr write FPeerAddr;
    { SET: Peer (remote PC) Port. Same as @Link(TRtcConnection.PeerPort).
      When using PHP with a connection component, simply assign the
      connection component's @Link(TRtcConnection.PeerPort) property.
      This information is used to fill PHP variables. }
    property  PeerPort:string read FPeerPort write FPeerPort;
    { SET: WebServer's Document Root folder.
      You should set this to your HttpServer's Document Root folder.
      This information is used to fill PHP variables. }
    property  DocumentRoot:string read FDocumentRoot write FDocumentRoot;

    { SET: HTTP Request Body, which was posted after the HTTP Header
      (also called Document Content). Before executing a PHP Request,
      wait for the whole Request to arrive at the server,
      so you can pass the whole Request Body to PHP.
      This information is used to fill PHP variables. }
    property  RequestBody : string read FRequestBody write FRequestBody;

    { GET: HTTP Request Header generated by PHP.
      For a HTTP Server to process PHP scripts correctly,
      in addition to passing all HTTP properties to the PHP scripting component,
      you have to return this header back to the client when sending the result. }
    property  ResultHeader : string read FResultHeader write FResultHeader;
  end;

{ Before you can use TRtcPHP components,
  you have to initialize the PHP Library by calling this procedure.
  This is usually done from the OnListenStart event handler
  of your Server connection component.

  @param(DLLFolder - Folder in which the DLL file for PHP5 resides)
  @param(IniFolder - Folder in which the INI file for PHP5 resides) }
procedure StartupPHP(DLLFolder,IniFolder:string);

{ To uninitialize the PHP Library, you should call this procedure.
  This is usually done from the OnListenStop event handler
  of your Server connection component. }
procedure ShutDownPHP;

implementation

uses
  memBinList,
  rtcSyncObjs;

var
  module_active : boolean = False;

  delphi_sapi_module : sapi_module_struct;
  ini_folder : string;
  CS:TRtcCritSec;
  ThrList:TBinList;

procedure InitResource;
  var
    p:pointer;
  begin
  CS.Enter;
  try
    if ThrList.search(GetCurrentThreadID)>0 then
      raise EPHPError.Create('InitResource: One thread, multiple resources.');
    p:=ts_resource_ex(0,nil);
    ThrList.insert(GetCurrentThreadID, longword(p));
  finally
    CS.Leave;
    end;
  end;

procedure FreeResource;
  var
    a:longword;
  begin
  CS.Enter;
  try
    a:=ThrList.search(GetCurrentThreadID);
    if a>0 then
      ThrList.remove(GetCurrentThreadID)
    else
      raise EPHPError.Create('FreeResource: Resource not existing.');
  finally
    CS.Leave;
    end;
  end;

function GetResource:pointer;
  var
    a:longword;
  begin
  Result:=nil;
  CS.Enter;
  try
    a:=ThrList.search(GetCurrentThreadID);
    if a>0 then
      Result:=pointer(a)
    else
      raise EPHPError.Create('GetResource: Undefined resource Thread!');
  finally
    CS.Leave;
    end;
  end;

function php_delphi_startup(sapi_module : Psapi_module_struct) : integer; cdecl;
  begin
  result := php_module_startup(sapi_module, nil, 0);
  end;

function php_delphi_deactivate(p : pointer) : integer; cdecl;
  begin
  result := 0;
  end;

function php_delphi_ub_write(str : ppointer; len : uint; p : pointer) : integer; cdecl;
  var
    ts : pointer;
    php : TRtcPHP;
    gl : psapi_globals_struct;
    s : string;
  begin
  try
    Result := 0;

    ts := GetResource;
    if not assigned(ts) then Exit;
    gl := GetSAPIGlobals(ts);
    if not assigned(gl) then Exit;
    php := TRtcPHP(gl^.server_context);
    if not assigned(php) then Exit;

    SetLength(s, len);
    if len>0 then
      Move(str^, s[1], len);

    try
      php.FBuffer.Add(s);
      Inc(php.FBufferSize, length(s));
    except
      end;

    Result := len;
  except
    on E:Exception do
      begin
      Log('Write callback',E,'PHP');
      Result:=0;
      end;
    end;
  end;

procedure php_delphi_register_variables(val : pzval; p : pointer); cdecl;
  var
    php : TRtcPHP;
    gl : psapi_globals_struct;
    ts : pointer;
    i : integer;
    vname, vval:string;
  begin
  try
    ts := GetResource;
    if not assigned(ts) then Exit;
    gl := GetSAPIGlobals(ts);
    if not assigned(gl) then Exit;
    php := TRtcPHP(gl^.server_context);
    if not assigned(php) then Exit;

    php_register_variable('SERVER_SOFTWARE', 'www.realthinclient.com', val, p);
    php_register_variable('SERVER_SIGNATURE', 'RealThinClient Library (c) Danijel Tkalcec', val, p);
    php_register_variable('SERVER_PROTOCOL', 'HTTP/1.1', val, p);

    if assigned(php.Request) then
      begin
      php_register_variable('REQUEST_METHOD',PChar(php.Request.Method), val, p);