看了前面的文章同学，都会认为delphi 开发web比较麻烦，没有PHP 和ASP 方便。

因为每次要改动网页的内容，就要重新编译一次，重新发布一次，这样也太麻烦了。那么我们就

做一个类似PHP 的动态web 服务器吧，一次编译发布后，就不用再改了，网站内容需要变化时，只

需要修改脚本就可以了。

先看看下面的代码：

<%

var

   i:integer;

begin

for i:=1 to 10 do

  print('ok');

%>

 <p> 你好<p>

<%

 end.

%>

非常像PHP 吧，不过语法是Pascal.我们把这个代码保存成test.psp(psp=pascal script page).

那么由于要解释pascal 脚本，我们需要一个pascal 脚本解释器，目前支持delphi 的pascal 脚本解释器

主要有fastscript,pascalscript,tms script 和paxcompiler.我选择使用速度最快的、稳定性最好的paxcompiler.

当然需要把paxcompiler 封装一下，使其可以读入psp 文件并进行解释输出HTML.

unit paxWebScriptPP;

interface


uses
  SysUtils, Classes, HTTPProd , paxWebScripter,PaxCompiler, PaxProgram;

type
  TpaxPageProducer = class(TCustomPageProducer)
  private
    FcompileFile:Tfilename;
    FWebScripter: TpaxWebScripter;
    function GetOnPrint:  TPaxPrintEvent;
    procedure SetOnPrint(const Value:  TPaxPrintEvent );
     function GetOnInclude: TPaxCompilerIncludeEvent;
    procedure SetOnInclude(Value: TPaxCompilerIncludeEvent);

    procedure SetCompileFile(const Value: TFileName);


  protected

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ContentFromStream(Stream: TStream): string; override;

    property WebScripter: TpaxWebScripter read FWebScripter;

    function ContentFromCompileFile:string;
    function CompileToFile(Aoutfilename:Tfilename):string;

  published
    property HTMLDoc;
    property HTMLFile;

    Property CompileFileName:Tfilename read FcompileFile write SetCompileFile;


    property OnPrint: TPaxPrintEvent read GetOnPrint write SetOnPrint;

    property OnInclude: TPaxCompilerIncludeEvent read GetOnInclude write SetOnInclude;

  end;

然后在webbroke 里面根据浏览器发送的请求处理，完成脚本的运行。当然了在系统初始化时先要注册一些

常用的函数和类。

    initialization

    g_UnitList := TUnitList.Create;
    g_UnitList.AddClass(Twm);
    g_UnitList.Sort;
    RegisterUnits(g_UnitList, GlobalImportTable);
  // 以上代码使用于delphi 2010 以后，直接利用delphi 本身的RTTI 功能，注册需要使用的类


  RegisterHeader(0,'function Utf8ToAnsi(const S: String): string;',@utf8toansi);
  RegisterHeader(0,'function myExtractStrings(Separators: Char; Content: string;var Strings: TStrings): Integer;',@myExtractStrings);
  RegisterHeader(0,'function getmin(date1,date2:string):integer;', @getmin);
  RegisterHeader(0,'function getstringbylen(src:string;len:integer):string;',@getstringbylen);
  RegisterHeader(0,'function MD5(const s: string): string;', @MD5);
  RegisterHeader(0, 'function IPValid(ip1,ip2,myip:string):boolean;', @IPValid);
  RegisterHeader(0, 'function Now: TDateTime;', @now);

// 注册自己的过程

加入现在URL的为 http://www.51delphi.com/web?path=test

处理URL

 procedure Twm.wmWebActionItem1Action(Sender: TObject; Request: TWebRequest;
  Response: TWebResponse; var Handled: Boolean);
var
  path, s, LFilename : string;
  fn: string;
  fnindex: string;
  ts: tstringlist;
  showtime: Boolean;
  istart, iend: LongWord;
  i:integer;
begin
 {$IFDEF INDYSERVER}
    pathname := pathnamefix + pathdelim +
      copy(UnixPathToDosPath(mypath), 2, 100);

{$ELSE}
    pathname := pathnamefix + pathdelim + copy(mypath, 2, 100);
{$ENDIF}

   fnindex := pathname + pathdelim + 'index.html';
   cookpath := webpath + mypath; // web 为路径
   path := Request.QueryFields.Values['path'];

  if path = '' then
    begin
      path := 'index';
      if FileExists(fnindex) then // 有index.html
      begin
         response.ContentStream:=TFileStream.Create(fnindex, fmOpenRead + fmShareDenyWrite);
         Exit;
      end;

    end;

      if path = 'genindex' then // 生成index 页
    begin
      procindex;
      Response.Content := '首页生成成功！';
      Exit;
    end;

    if path = 'prochtml' then // 生成静态页面
    begin
      if Request.QueryFields.Values['file'] = '' then
      begin
        Response.Content := '请输入文件名！';
        Exit;
      end;
      path := Request.QueryFields.Values['file'];
      fn := pathname + pathdelim + path + '.psp';
      if not FileExists(fn) then
      begin
        Response.Content := '文件名不存在！';
        Exit;
      end;
      fn := path;
      prochtml(fn);
      Response.Content := '页面生成成功！';
      Exit;
    end;


   qlist := TClasslist.Create; // 这个是用来在脚本里面实现动态生成Query.
   try

      show.WebScripter.Scripter.Reset;
      show.WebScripter.Scripter.RegisterVariable(0,'request:TWebRequest;',@Request);
      show.WebScripter.Scripter.RegisterVariable(0,'response:TWebResponse;',@Response); //注册request 和response,以便在脚本里面运行。
      show.WebScripter.Scripter.RegisterVariable(0,'wm:Twm;', @self);
      

    fn := pathname + pathdelim + path + '.html';
    if FileExists(fn) then
    begin
       response.ContentStream:=TFileStream.Create(fn, fmOpenRead + fmShareDenyWrite);
      Exit;
    end;

    fn := pathname + pathdelim + path + '.psp';

    if Request.QueryFields.Values['debug'] = 'true' then
      debug := True;
     showtime := False;
    if Request.QueryFields.Values['showtime'] = 'true' then
      showtime := True;



    if not FileExists(fn) then
    begin
      if debug then
      begin
        Response.Content := '找不到你要的文件:' + fn;
        Exit;
      end
      else
      begin
        Response.Content := '找不到你要的文件';
        Exit;
      end;
    end;
    show.HTMLFile := fn;
    if not showtime then
     begin
        Response.Content := show.Content;
    end
    else
    begin
      istart := GetTick;
      s := show.Content;
      iend := GetTick;
      Response.Content := s + '<p>' + IntToStr(iend - istart) + '毫秒<p>';

    end;
  
  finally
    for i := 0 to qlist.Count - 1 do
    begin
      if Twebquery(qlist[i]) <> nil then
        Twebquery(qlist[i]).Free;
    end;
    qlist.Free;
  end;

end;

OK，  大功告成。

以上就实现了脚本的运行，并可以处理request 和response 对象。

运行结果如下：

如果大家想体验一下更多的功能和效果，可以访问一下网站

www.xasyu.cn