求救!!留言板代码(30分)

  • 主题发起人 主题发起人 ltqlyy125
  • 开始时间 开始时间
L

ltqlyy125

Unregistered / Unconfirmed
GUEST, unregistred user!
[8D][blue][/blue]我刚学的,想作用DELPHI个留言板,各位大虾有没有相关例子或代码参考一下
 
hubdog的葵花宝典有:
 

用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区分其为哪项数据,其数值为留言板页面传输数据项的顺序号。

---- 数据存储方式我采用文本文件存储,如果网友的主页人气鼎盛也可考虑改用数据库存储。

---- 以下是完整的程序代码

---- 在DELPHI3,IIS4.0/PWS,IE4.0中运行通过。
///////////////////////////////////////////////////////////////////////
步骤:
简单的实现方法:
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>

3。在html中实现 isapi的连接,并且里利用web server(如:IIS) 建立服务
4. 其他方法有很多,请各位打虾多多交流
源码:
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['conten
t'];
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+'(' +
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;
//
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.
 
接受答案了.
 
后退
顶部