看了前面的文章同學，都會認為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 對象。
運行結果如下：
如果大家想體驗一下更多的功能和效果，可以訪問一下網站