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

  • 相关阅读:
    React在componentDidMount里面发送请求
    React 术语词汇表
    React里受控与非受控组件
    React和Vue等框架什么时候操作DOM
    【LeetCode】79. Word Search
    【LeetCode】91. Decode Ways
    【LeetCode】80. Remove Duplicates from Sorted Array II (2 solutions)
    【LeetCode】1. Two Sum
    【LeetCode】141. Linked List Cycle (2 solutions)
    【LeetCode】120. Triangle (3 solutions)
  • 原文地址:https://www.cnblogs.com/xalion/p/2312401.html
Copyright © 2011-2022 走看看