用Delphi制作留言板
现在很多朋友都有了自己的个人主页。有一个留言板主页与访问者交流一下可能是很多网友愿望。但留言板主页不同与一般主页，它不但有主页部分而且还要有数据存储功能。其实用DELPHI的CGI应用程序可以轻松的制作留言板主页。用ELPHI开发CGI应用程序不但可以实现ASP，HTML很难实现的低层操作，而且简化了CGI应用程序开发过程。
1.选择Delphi的菜单File|New，在New标签中选择“Web Server Application”。 然后在选择“CGI Stand-alone executable"，创建一个CGI应用程序。（如果想创建ISAPI或NSAPI应用程序，只需选择“ISAPI/NSAPI Dynamic Link Library”，后几步操作不变。）
2.系统自动创建一个非可视的WebModule1组件，我们按以下步骤给程序添加控制和代码：
（1）、双击WebModule1的Actions属性，弹出“Editing WebModule1.Actions”对话框；
（2）、单击Add按钮，添加一个新行WebActionItem1
（3）、单击WebActionItem1，在Object Inspector中将WebActionItem1的Default属性设置为True；这样设置使访问CGI.EXE时直接访问此页面。
（4）、单击Add按钮，添加一个新行WebActionItem2
（5）、单击WebActionItem2，在Object Inspector中将WebActionItem2的PathInfo属性设置为“\Info”；即访问此页面的路径为CGI.EXE\Info。
（6）、在Object Inspector中双击WebActionItem1的OnAction事件，添加代码。将留言板页面的HTML语句赋给Response.Content属性，使用户访问WEB服务器应用程序时显示。
（7）、在Object Inspector中双击WebActionItem2的OnAction事件，添加代码处理留言板页面传回的信息，同时显示相关信息通知用户。其中涉及Request.ContentFields.Values['index']及Request.ContentFields.Strings[counts]两个属性的应用。
Request.ContentFields.Values['UserName']是指留言板页面中name="UserName"的控件中的数据信息。
Request.ContentFields.Strings[Counts]是指留言板页面传过来各项数据及对应的控件名。以Counts区分其为哪项数据，其数值为留言板页面传输数据项的顺序号。
数据存储方式我采用文本文件存储，如果网友的主页人气鼎盛也可考虑改用数据库存储。
以下是完整的程序代码
步骤：
1.创建一个webserver容器，在File|new中选择ispai
2.放上chat：Tpageproducer chatview:Tpageproducer //others look up my source code
3.在editing webserver.action 中写入pubchat /chat, pubchat1 /view
在chatHTMLTag事件中写程序，tagparams传入,replacetext返回相应位置的字串
在chat的htmldoc属性中写入：
<HTML>
<HEAD>
<TITLE>Blubird Web Site chat</TITLE>
</HEAD>
<BODY>
<H4>
<P>
<#chat> {notes: chat is a stirng returned by your program }
<P>
</H4>
<HR>
</BODY>
4.在html中实现 isapi的连接,并且里利用web server（如：IIS） 建立服务
源码：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBTables, DBWeb,
ExtCtrls;
type
Twebserver = class(TWebModule)
PageProducer1: TPageProducer;
PageProducer2: TPageProducer;
chat: TPageProducer;
DataSource1: TDataSource;
Table1: TTable;
chatview: TPageProducer;
procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings;
var ReplaceText: String);
procedure webserverWebitem1Action(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure chatHTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings;
var ReplaceText: String);
procedure webserverpubchatAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure webserverCreate(Sender: TObject);
procedure webserverpubchat1Action(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure PageProducer2HTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings;
var ReplaceText: String);
private
chattxt:string;
{ Private declarations }
public
{ Public declarations }
end;
var
webserver: Twebserver;
implementation
{$R *.DFM}
procedure Twebserver.PageProducer1HTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
if comparetext(tagstring,'info')=0 then
begin
replacetext:='your adress is :'+Request.ContentFields.Values['adress']
+'<P>Time is'+Datetimetostr(NOW) +'<P>your name is '+Request.ContentFields.Values['name'];
end;
end;
procedure Twebserver.webserverWebitem1Action(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
if request.ContentFields.Values['name']<>'' then
Response.content:=pageproducer1.content
else
Response.content:=pageproducer2.content
end;
procedure Twebserver.chatHTMLTag(Sender: TObject; Tag: TTag; const TagString: String; TagParams: TStrings; var ReplaceText: String);
var
i,count:integer;
begin
chattxt:='';
if comparetext(tagstring,'chat')=0 then
begin
table1.Edit;
table1.first;
table1.insert;
table1.FieldByName('name').asstring:=Request.ContentFields.Values['name'];
table1.FieldByName('content').asstring:=Request.ContentFields.Values['content'];
table1.FieldByName('ip').asstring:=Request.RemoteAddr;
Table1.fieldbyname('time').asstring:=timetostr(NOW);
table1.Post;
count:=table1.RecordCount;
table1.first;
if count<20 then
begin
for i:=1 to count do
begin
chattxt:=chattxt+'<HR><P>'+table1.fieldbyname('name').asstring+'说：'+
table1.fieldbyname('content').asstring+'(' + able1.FieldByName('ip').asstring+' '+table1.Fieldbyname('time').asstring+')';
table1.Next;
end;
replacetext:=chattxt;
end
else
begin
for i:=1 to 20 do
begin
chattxt:=chattxt+'<HR><P>'+table1.fieldbyname('name').asstring+'说:'+
table1.fieldbyname('content').asstring+ '('+ table1.FieldByName('ip').asstring+' '+table1.Fieldbyname('time').asstring+')';
table1.Next;
end;
replacetext:=chattxt;
end;
end;
if comparetext(tagstring,'view')=0 then
begin
count:=table1.RecordCount;
table1.first;
if count<20 then
begin
for i:=1 to count do
begin
chattxt:=chattxt+'<HR><P>'+table1.fieldbyname('name').asstring+'说：'+
table1.fieldbyname('content').asstring+'(' + table1.FieldByName('ip').asstring+' '+table1.Fieldbyname('time').asstr
ing+')';
table1.Next;
end;
replacetext:=chattxt;
end
else
begin
for i:=1 to 20 do
begin
chattxt:=chattxt+'<HR><P>'+table1.fieldbyname('name').asstring+'说:'+
table1.fieldbyname('content').asstring+ '('+ table1.FieldByName('ip').asstring+' '+table1.Fieldbyname('time').
asstring+')';
table1.Next;
end;
replacetext:=chattxt;
end;
end;
end;
procedure Twebserver.webserverpubchatAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
if request.ContentFields.Values['name']<>'' then
Response.content:=chat.Content;
end;
procedure Twebserver.webserverCreate(Sender: TObject);
var
i:integer;
begin
chattxt:='';
table1.Active:=true;
table1.first;
for i:=1 to 20 do
begin
table1.next;
end;
while not table1.Eof do
begin
table1.Delete;
table1.next;
end;
end;
procedure Twebserver.webserverpubchat1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.content:=chatview.Content;
end;
end.