zoukankan      html  css  js  c++  java
  • 使用delphi 开发 web(二)动态脚本的实现

       看了前面的文章同学,都会认为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

  • 相关阅读:
    maven:读取程序版本号的三种方案
    有无目标的人生差10倍!赶紧和娃把新年计划做起来
    都怎么了,其实早就知道,但是一直没有找到答案……
    python添加tab键功能
    电影观后感
    ipset批量配置iptables
    Oracle 触发器,事物
    Oracle PL/SQL高级应用 视图 同义词 序列
    Oracle PL/SQL高级应用 存储过程
    Oracle PL/SQL高级应用 游标
  • 原文地址:https://www.cnblogs.com/xalion/p/2312401.html
Copyright © 2011-2022 走看看