DOC

BLUBIRD WEB SITE CHAT

By Leroy Wagner,2014-03-07 08:46
11 views 0
BLUBIRD WEB SITE CHAT

我想用DELPHI编一个WEB留言板,ISAPI,步骤如何?

    发信人: bigkey (天堂鸟), 信区: Delphi

     : Re: 我想用DELPHI编一个WEB留言板,ISAPI,步骤如何?

    发信站: BBS 水木清华站 (Wed Dec 2 13:48:27 1998) WWW-POST 步骤:

    简单的实现方法:

    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返回相应位置的

    字串

     chathtmldoc属性中写入:

<#chat> {notes: chat is a stirng returned by your program }

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']

     +'

    Time is'+Datetimetostr(NOW)

     +'

    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);

    i,count:integer; var

     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+'

'+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+'

    '+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+'

'+table1.fieldbyname('name').asstring+':

    '+

     table1.fieldbyname('content').asstring+'(' +

     table1.FieldByName('ip').asstring+' '+table1.Fieldbyname('tim

    e').asstr

    ing+')';

     table1.Next;

     end;

     replacetext:=chattxt;

     end

     else

     begin

     for i:=1 to 20 do

     begin

     chattxt:=chattxt+'

'+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.

    【在 pitts (痛并快乐着) 的大作中提到:

    :

     rt

    --

    抽刀断水水更流?nbsp;

    举杯浇愁愁更愁

    :?BBS 水木清华※来源

     bbs.net.tsinghua.edu.cn?[FROM: 202.119.200.113]

Report this document

For any questions or suggestions please email
cust-service@docsford.com