看了前面的文章同学，都会认为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 对象。
运行结果如下：
如果大家想体验一下更多的功能和效果，可以访问一下网站