Delphi(7 和2006 2007) 下用开发 WEB...

Delphi(7和 2006、2007) 下用 IntraWeb开发WEB程序应用实战

作者：高勇

2007年 10月 22日星期一

目录目录...................................................................................................................................................................2 第一章 IntraWeb 基础 ......................................................................................................................................4

1．1 IntraWeb简介 ...................................................................................................................................4 1．2 IntraWeb9.x的安装 ..........................................................................................................................4 1．3 我的第一个 IntraWeb程序 ..............................................................................................................4 1．4 IntraWeb开发成果预览 ...................................................................................................................8 1．5 Windows下 IntraWeb开发后的发布 ...........................................................................................11 1．6 IntraWeb低版本的源码如何在高版本中运行 .............................................................................13

第二章 AppMode 下的实用开发指南...........................................................................................................14 2．1 建立一个以独立的应用程序的形式发布的程序 .........................................................................14 2．4 IntraWeb程序.exe与.dll两种发布形式的相互转换....................................................................25 2．5 用 html模板美化我们的程序........................................................................................................27 2．7 IntraWeb程序开发经验小结 .........................................................................................................30

第三章 Intraweb编程专题讲座......................................................................................................................32 3．1 用虚拟键盘输入密码.....................................................................................................................32 3．2 IntraWeb数据库报表解决方案之一 .............................................................................................35 3．3 IntraWeb数据库报表解决方案之二 .............................................................................................49 3．4 在 IntraWeb中轻松实现通用的 HTML文本编辑器 ...................................................................55 3．5 让超级链接变成可向服务器传递参数的按钮 .............................................................................58 3．6 实现网页复杂提示信息框.............................................................................................................62 3．7 实现网页中的目录树.....................................................................................................................66 3．8 用窗口继承的方法实现网页中的导航条(即每页都有的信息)...................................................70 3．9 用 html模板格式化输出数据库中的数据....................................................................................80 3．10 用自己的代码实现表格翻页控件...............................................................................................84 3．11 窗口切换详解...............................................................................................................................92 3．12 窗口之间数据参数传递详解.......................................................................................................95 3．13 使用 Cookies在客户端保存数据................................................................................................99 3．14 让 IE的后退按钮重新发挥作用 ...............................................................................................101 3．15 用 Frame来实现各页面的公共菜单.........................................................................................103 3．16 用 realone插件来播放声音（视频） .......................................................................................105

第四章完整应用实例讲解...........................................................................................................................107 4．1 一个电影网站的出生之旅...........................................................................................................107

4.1.1 网站模板与运行界面.............................................................................................................107 4.1.2 程序代码全面解析.................................................................................................................116 4.1.2.1 ServerController单元 ........................................................................................................116 4.1.2.2 UserSessionUnit单元 ........................................................................................................135 4.1.2.3 FBaseform单元 .................................................................................................................137 4.1.2.4 FMainForm单元................................................................................................................144 4.1.2.5 FlistForm单元 ...................................................................................................................147 4.1.2.6 FRegForm单元..................................................................................................................152 4.1.2.7 FplayForm单元 .................................................................................................................156 4.1.2.8 FSystem单元 .....................................................................................................................158 4.1.2.9 FUserForm单元 ................................................................................................................164

4.1.2.10 Fadminform单元 .............................................................................................................168 4.1.2.11 FControl单元...................................................................................................................172

4．2 一个英语教学网站的综合编程.................................................................................................186 4.2.1 网站整体设计简要说明.........................................................................................................186 4.2.2 unit ServerController导读....................................................................................................186 4.2.3 unit UserSessionUnit导读 ....................................................................................................187 4.2.4 unit MainMenu1导读 ...........................................................................................................189 4.2.5 unit Uindex导读 ...................................................................................................................192 4.2.6 unit Upart2导读....................................................................................................................210 4.2.7 unit Upart3导读....................................................................................................................214 4.2.8 unit Upart4导读....................................................................................................................216 4.2.9 unit Unitcsyd（测试园地）导读 .........................................................................................219 4.2.10 unit UShenQingZhuCe（申请注册）导读 ........................................................................235 4.2.11 unit UYongHuXinXiChaXun（用户信息查询，对应当前用户信息查询修改菜单）导读...........................................................................................................................................................239 4.2.12 unit UYongHuGuanLi（用户管理）导读 .........................................................................242 4.2.13 unit UxiazaiYuYin（下载语音，对应音像剪接菜单）导读 ...........................................248

第五章 Intraweb编程通用框架....................................................................................................................293 5．1 使用通用框架的目的...................................................................................................................293 5．2 通用框架的基本结构...................................................................................................................293 5．3 通用函数导读与讲解...................................................................................................................295 5．4 使用框架的注意事项...................................................................................................................300

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．1 IntraWeb简介作者：高勇

版权为作者所有集结出版请与作者联系地址：西安市金花北路 16号邮编：710032 电话：029-84755132，13572934967 索要所有源代码请与作者联系

第 4页/共 301页

第一章 IntraWeb 基础

1．1 IntraWeb简介 IntraWeb是 Delphi里开发 BS程序最好的工具。从 Delphi7开始，它就正式成为 Delphi的一个组

件，当时的版本为 5.0.43。目前已经推出 9.0以上版本了。它是 AtoZed Software 公司的产品，其网址为 http://www.atozedsoftware.com。产品更新很快，是一个快速开发 BS程序的好工具，从某种意义上讲，它可以与.NET相抗衡。用 IntraWeb 开发 Web 应用，与使用 Delphi 开发普通程序几乎一样，这样，一个优秀的 Delphi

程序员经过简单的实践就可以成为优秀的Web应用开发员，所有的 Delphi所给你的习惯和经验都可以得以保留，这真是一件很美妙的事情。用 IntraWeb做Web开发时，程序员可以不懂 HTML、JavaScript语言，就可以开发出比 ASP，

JSP和.NET等工具开发的Web 应用还要好，如果懂，那就是如虎添翼，开发出来的Web 应用就更好了。本书不以 Delphi7自带的版本来讲解，而是以它的 9.0.15(注：2007年 5月最高版本)版本来讲解。

IntraWeb9.x已经开始支持 Ajax技术了。

1．2 IntraWeb9.x的安装 1、打开 Delphi 7 ，选择 component 菜单，点击 install packages，在弹出的对话框中找到有

IntraWeb的那个选项，选中它，点击 remove按钮，一路确定，直至完成 Intraweb5.0的卸载。一定要先卸载，这是经验(有其它版本的也是一样操作)。

2、先关闭 Delphi 7，再双击 iw9.0.15.exe（可以从 http://www.atozedsoftware.com 下载）进行IntraWeb 9.0.15的安装，选择相应的 Delphi版本，全部一路默认即可。这样安装的是体验版本，但用来学习不会有什么问题的。Delphi 2006安装的是 8.0版本了。Delphi 2007安装的是 9.0.14版本了。IntraWeb在 Delphi 7、Delphi 2006和 Delphi 2007下是类似的。本书提供的所有源代码可以在 Delphi 2006和 Delphi 2007编译通过，随书光盘也提供有 Delphi

2006和 Delphi 2007下的源代码。

图 1-1 IntraWeb 9.0.15安装图标

1．3 我的第一个 IntraWeb程序 1、打开 Delphi 7，点击 file->new->other，在弹出对话框中选择 IntraWeb选项卡，选择 IntraWeb

Application Wizard，点击 Ok。

http://www.atozedsoftware.com

http://www.atozedsoftware.com

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．3 我的第一个 IntraWeb程序作者：高勇


第 5页/共 301页

图 1-2 IntraWeb选项卡

2、在弹出对话框中点击 Ok。

图 1-3 IntraWeb 程序向导

3、点击 file->save，将文件分别保存为 Umain.pas，UserSessionUnit.pas，ServerController.pas，Project1.dpr。

4、切换到 Umain的主窗口，从 IW Standard选项卡上布置相应的控件如 IEForm1窗口所示。光盘中有源代码，可以打开，将鼠标放在窗口控件上即可知道是什么控件。这是 Delphi基本知识，在此不作过多讲述。控件的Caption属性都作了修改，IWRegion1的 visible属性改为 false，这样 IWRegion1内的所有控件在网页显示时是不可见的。IWURL1的 UseTarget属性改为 true,这是为了在新窗口中打开这个链接，IWURL1的 URL属性中输入 http://www.2ccc.com。其它的属性都没有改变。

5、双击登录按钮，为登录按钮的 onClick事件填写代码，如下所示：

http://www.2ccc.com



第 6页/共 301页

procedure TIWForm1.IWButton1Click(Sender: TObject); begin self.WebApplication.ShowMessage(IWEdit1.Text + '你好，欢迎你登录'); //用对话框的形式显示 IWEdit1中输入的内容和“你好，欢迎你登录”。 IWRegion1.Visible := true;//显示 IWRegion1和它内部的控件。 end; 6、双击提交按钮，为提交按钮的 onClick事件填写代码，如下所示： procedure TIWForm1.IWButton2Click(Sender: TObject); begin self.WebApplication.ShowMessage('你好，你提交的内容是：'+IWMemo1.Text); //用对话框的形式显示 “你好，你提交的内容是：”和在 IWMemo1中输入的内容。 IWRegion1.Visible := false; //隐藏 IWRegion1和它内部的控件。 end;

图 1-4 Umain的主窗口

7、程序已经完成，单击 Delphi的运行按钮：程序运行后如图 1-5所示。

图 1-5 IntraWeb调试信息窗口



第 7页/共 301页

8、单击按钮，即可看到浏览器页面，如图 1-6所示：

图 1-6 浏览器页面 1

输入姓名，点击登录，如图 1-7所示：


点击确定后，点击“这里可以下载 IntraWeb”链接，即可在新窗口中打开 IWURL1的 URL属性中输入的网址。在输入框中输入“我要所有的程序”，点击提交后如图 1-8所示：

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．4 IntraWeb开发成果预览作者：高勇


第 8页/共 301页


这个程序很简单，但是很能说明问题，用 IntraWeb开发Web应用和用 Delphi开发普通程序没有什么太大的区别。以前用 Delphi开发普通应用能够实现的功能，现在都可以在Web应用里实现。我是一个 Delphi 迷。我很喜欢她的简洁与友好。对于我来说，用她编程简直就是一种艺术，一种

享受。我也很喜欢她的语言，可读性极好，看一个好的 Delphi程序就像阅读一篇迷人的小说；此外，我最迷恋她的开发速度，我用过很多的编程工具，但当我碰上 Delphi之后，我就对她一见钟情了。不知从何时起，我喜欢上了编写 Web 程序。虽然我那时已编写过单页上万行代码的 ASP 程序，

但我还是不喜欢 ASP，我一直在 Delphi的王国里苦苦寻找我的Web程序公主，直到有一天，我发现了她 IntraWeb之后，我就全身心的投入了她的怀抱。

IntraWeb是用来开发 Internet/Intranet应用的工具，已经发展到 9.0.15了。的确，IntraWeb是一个非常优秀的 Web 开发工具。她的开发跟普通的应用程序开发几乎一模一样，我原来的经验和习惯都可以继续，我不用离开 Delphi。让我们一起来开始我们的 IntraWeb之旅吧。

1．4 IntraWeb开发成果预览为了进一步了解 IntraWeb功能的强大，进一步加强我们学习 IntraWeb的决心，我们在光盘的 1.4

文件夹中有一些做好的程序，可以打开看看。现给出几个截图如下。注意：请将 1.4 文件夹拷贝到硬盘，并将所有文件的只读属性去掉后再运行程序。因为刻录光盘

后所有文件都变成只读了。 1、英语资源站点登录电影网站的用户名和密码都是 admin。程序有哪些功能，请慢慢体会。程序占用了 90端口.在运行时请确保此端口没被其它程序占用。让 IE支持COOKIE 操作步骤右击 Internet Explorer--浏览器--选择隐私--设置COOKIE权限为中。图 1-9只是其主界面，详情请打开程序自己看。



第 9页/共 301页

图 1-9英语资源站点



第 10页/共 301页

2、英语听力学习站点管理员的卡号与密码都是 admin。程序有哪些功能，请慢慢体会。一个用 DELPHI开发的高效.安全 B/S类型的研究生英语听说教学系统要有卡号与用户名请点击申请卡号按钮。30秒即可申请完毕。系统运行的最低要求： 1、请确保你的系统已经安装了 RealOne播放器 10，如果没有请先下载。 2、请升级浏览器为 IE6.0以上。 3、请先安装好网卡。程序占用了 8080端口.在运行时请确保此端口没被其它程序占用。此系统可以发布为单机版本，也可发布为网络版本。双击 server.exe就可以运行。图 1-10和图 1-11只是其两个界面的一部分，详情请打开程序自己

看。

图 1-10英语听力学习站点主界面 1

图 1-11英语听力学习站点主界面 2

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．5 Windows下 IntraWeb开发后的发布作者：高勇


第 11页/共 301页

怎么样？心动了吧。那就和我一起学习，共同提高吧！

1．5 Windows下 IntraWeb开发后的发布 Windows下 IntraWeb的发布有两种形式：（要求机器已正确安装网卡驱动） 1、前面所有的例子都是同一种发布形式。即程序编译后是.exe 结尾的，在机器上双击启动这个

exe 服务器就可以了。客户端只要输入相应的网址就可以访问我们的程序。在默认情况下，IntraWeb就是这样的：自带服务器。通过上面的练习，我们应该已经掌握了第一种发布形式。

2、(这里看不懂没有关系，后面会有实例讲解)另一种发布形式是工程编译后是.dll结尾的，这要用windows的 IIS作为服务器，这就要求安装 IIS服务器，通过 IIS发布后就可以被客户端访问了。我们假设网站根目录文件夹为 e, 192.168.8.2为本机的 IP，dll文件名为 index.dll。发布方法介绍：将整个 e 文件夹发布成为一个虚拟目录，例如：http://192.168.8.2/e/，访问权限设为读取，应用

程序权限设为执行（包括脚本），总之就是和发布 ASP程序一样的：在 e文件夹上点击右键，选择共享和安全，在弹出的新窗口中选择 web共享选项卡，点击共享文件夹，在弹出的窗口中选择访问权限设为读取，应用程序权限设为执行（包括脚本），点击确定回到前一个窗口，再点击确定即可。（以上

虚拟目录中的 192.168.8.2为本机的 IP。）如在WIN2003中，还要进行以下操作：在我的电脑上点击右键，选择管理，在弹出的新窗口中展服务和应用程序，再展开 Internet信息服务（IIS）管理器，点击Web服务扩展，将所有未知 ISAPI扩展，Active Server Pages和在服务器端的包含文件都设为允许。（如没有打 sp1 补丁还要：在网站上点击右键，选择属性，选择服务选项卡，将以 IIS5.0 隔离模式运行 WWW 服务选上，点击确定即可。）再展开默认网站，选择 e，点击右键，选择属性，选择目录安全性选项卡，在身份验证和访问控制框中点击编辑，在弹出的新窗口中选上启用匿名访问，再点

确定，在文档选项卡中选择启用默认文档，右边点击添加，加入 index.asp,index.dll,default.asp(如果没有的话就添加)。在虚拟目录选项卡中点击配置按钮，点击选项，把启用父路径选上，确定返回，执行权限选择脚本和可执行文件，应用程序选中（共用）。再确定退出。如果要删除、修改 index.dll文件，则要求重新启动 IIS服务：在 internet信息服务点击右键，点击

所有任务，点击重新启动 IIS，执行完毕即可。如果程序发布时该硬盘分区为 NTFS文件系统的话（如果是 Fat32格式，则不用进行如下操作），

还要设置权限，否则程序可能运行不正常，如不能更新数据库，写入硬盘临时文件等等。进行如下两

步操作即可：（1）第一步：打开工具菜单下的文件夹选项，如图 1-12所示：不要选择“使用简单文件共享（推

荐）”这一项。

http://192.168.8.2/e/

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．5 Windows下 IntraWeb开发后的发布作者：高勇


第 12页/共 301页

图 1-12 文件夹选项对话框

（2）第二步：右击要发布的文件夹，选择属性，如图 1-13 所示。在安全选项卡中添加 Internet来宾帐户，给其权限为图中所示。

图 1-13 属性对话框

如果没有进行以上设置，如果程序访问修改数据库的话，则可能会出现如图 1-14所示出错提示：

图 1-14 出错提示对话框 1

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 1．6 IntraWeb低版本的源码如何在高版本中运行作者：高勇


第 13页/共 301页

如果程序要更改某个文件的话，则可能出现如图 1-15所示出错提示：


1．6 IntraWeb低版本的源码如何在高版本中运行在一般情况下，高版本是向下兼容的。但在实际转换时，要注意以下技巧(我们以 4.1文件夹中程

序为例，从版本从 7.2.41转换到 9.0.15)： 1、用安装好的高版本打开低版本的源码工程文件：exe.dpr； 2、选择打开所有的 PAS文件，如图 1-16所示。

图 1-16打开所有的 PAS文件

3、打开有可能出现以下类似提示框，如图 1-17所示，请选择 Igore All按钮。不管出现多少个都

这样选择。打开完毕后请随便移动一下任何一个窗口，再编译运行，如果没有出错，则转换成功，保

存所有文件即可。

图 1-17打开时的出错提示

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．1 建立一个以独立的应用程序的形式发布的程序作者：高勇


第 14页/共 301页

第二章 AppMode 下的实用开发指南

2．1 建立一个以独立的应用程序的形式发布的程序这里的完整不是指功能，而是指用 IntraWeb 开发一个应用级的Web程序的过程（这里暂不讨论

如何进行数据库的编程，后面有专题讲解，这里先讲一些过程技巧）。这个例子我提供了完整的源代码，存放在文件 2.1 中。在开发程序的过程中我会解答很多遇到的

实际问题，我不讲理论，注重实际应用，请大家对应查找相关注释。以下从 0开始我们的旅程： 1、打开 Delphi 7，点击 file->new->other，在弹出对话框（图 2-1）中选择 IntraWeb选项卡，选

择 IntraWeb Application Wizard，点击 Ok。注：每一个 IntraWeb应用都是从这里开始的。


2、在弹出对话框（图 2-2）中点击 Ok。注：选项的默认值是很实用的，一般不用更改。左边的程序类型我们选择的是独立的程序（StandAlone Application），也就是说程序编译完了之后是自带服务器的 exe 结尾的形式。右边选择的是创建用户对话，并包括数据模块（Create User Session(Include DataModule)），这是什么意思呢？可以这们理解，因为 IntraWeb创建的Web应用是可以多人同时使用的，每个人总要保存一些只属于自己的信息，而且要能在不同的网页上面传递参数，所以选择这个

以后程序就会自动创建一个单元 UserSessionUnit，这个单元就相当于是服务器分配给每个登录这个Web 应用的人一个独立的、保密的存贮空间，它里面的数据（编程者自己定义的数据、“数据模块”即可以包括数据库一些控件，与 Delphi的普通应用时的数据模块是一样的）只有这个人才能使用，而且能够在各个页面之间传递。相当于服务器给每个登录者一个存放自己共用信息的地方，这块地方是服

务器在你登录时自动创建的，你离开后会被自动销毁。这也就是 ASP里常常提到的 Session（会话）。



第 15页/共 301页


3、点击 file->save，将文件分别保存为 Unit1.pas，UserSessionUnit.pas，ServerController.pas，Project1.dpr。我全部默认名称保存的。如果页面不多，这样做也很好。当然，自己改名是完全可以的。

4、1、打开 Delphi 7，点击 file->new->other，在弹出对话框中选择 IntraWeb选项卡，选择 New Form，点击 Ok。

5、在弹出的对话框（图 2-3）中点击 Ok按钮。

图 2-3 窗口类型选择对话框

6、保存为 Unit2.pas，相同的方法，再新建一个保存为 Unit3.pas。 7、从 IW Standard选项卡上布置相应的控件并修改每个 Caption属性如图 2-4所示。



第 16页/共 301页

图 2-4三个窗口的界面

8、如何在各个页面之间跳转：以下是 UserSessionUnit单元的代码，说明如下。 unit UserSessionUnit; interface uses IWUserSessionBase, SysUtils, Classes,IWAppForm;//加黑部分是新加的 type TIWUserSession = class(TIWUserSessionBase) private { Private declarations } Public

//这就是我们定义参数和函数的地方，每个用户登录后都会独立创建一个 { Public declarations } procedure Move(AFormClass: TIWAppFormClass);//我们定义的一个打开新页面的函数 end; implementation uses IWInit, ServerController;//这一行请一定要加入，每个Web应用的这个单元都加上就是了 {$R *.dfm} procedure TIWUserSession.Move(AFormClass: TIWAppFormClass); begin TIWAppForm(WebApplication.ActiveForm).Free;//关闭当前页面 AFormClass.Create(WebApplication).Show;//显示要打开的页面，AFormClass参数为要打开的



第 17页/共 301页

窗口的 name 前面加个 T就行了。下面有说明 end; end. 9、Unit1.pas 所对应的窗口三个按钮的代码。注：请在每个单元中 uses ServerController,

UserSessionUnit;当然，要调用的单元更要加入了。 {$R *.dfm} procedure TIWForm1.IWButton1Click(Sender: TObject); begin UserSession.Move(TIWForm2);//打开窗口 2，即 Unit2.pas所对应的窗口 //IWForm2是这个窗口的 name，前面加上 T就行了 end; procedure TIWForm1.IWButton2Click(Sender: TObject); begin UserSession.Move(TIWForm3);//打开窗口 3，即 Unit3.pas所对应的窗口 //IWForm3是这个窗口的 name，前面加上 T就行了 end; procedure TIWForm1.IWButton3Click(Sender: TObject); begin self.WebApplication.Terminate('你退出程序了。'); {这句可以主动关闭 session，释放所占用服务器的内存，如果没有这一句，或者用户不按这个按

钮而是直接关闭 IE，那 session就只能等其时间到了自动关闭。ServerController单元里可以设置这个参数：IWServerController.SessionTimeout，填入的数字以分钟为单位。在其它的窗口内也可以主动赋值，例如：“IWServerController.SessionTimeout:=5;”。}

end; 其它窗口类似，请打开源代码自己看。 10、运行查看结果如图 2-5所示：

图 2-5 运行后主界面（页面 1）

点击打开页面 2按钮，如图 2-6所示：

图 2-6页面 2



第 18页/共 301页

打开页面 3也是类似的。点击退出程序后如图 2-7所示：

图 2-7退出程序页面

11、改变程序运行的主窗口（网站主页面），如果我想把页面 2在程序运行时就显示那要怎么办呢？

现在页面 1为主窗口，请看其单元的 initialization部分： initialization TIWForm1.SetAsMainForm;//将当前窗口设为主窗口，TIWForm1为页面 1窗口 name前加 T 如果要改为页面 2，则要先删除以上两句，再在页面 2的单元代码最后一个 end.前加上以下两句： initialization TIWForm2.SetAsMainForm; //将当前窗口设为主窗口，TIWForm2为页面 2窗口 name前加 T 12、对 ServerController单元进行综合设置：（注：192.200.9.81是我调试时我的计算机的 IP，你

使用时请将以下 192.200.9.81改为你自己的 IP，如果是单机没有联网，可以使用 127.0.0.1） AppName：这个属性为Web应用程序指定一个名称（请填写英文字符），请尽量保证此名称的唯

一性，如果两个应用的名称相同则它们不能同时运行在一个系统中。 AllowSubFolders：请选择 true。这将允许程序使用下级文件夹（例如 files文件夹下还可以新建无

数级文件夹）。有利于我们的编程。 BoundIP：（发布成 exe 形式时有效）填写将要发布的服务器的 IP，如果空着，则自动被设为

127.0.0.1，这样就只能本机访问了，其它用户通过 internet 不能访问。如果 IntraWeb 是体验版本的话，这个值会被固定为 127.0.0.1，不管你改为多少，如果服务器没有网络，则用指定的 IP打开会出错。它出现在 IE地址里（加黑部分）http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。

ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal，当你用到数据库时，如果默认为 ciNone会出错。否则会出错，这是经验。

ExeCmd：可以任意指定（请用英文字符），默认为“exec”。它出现在 IE地址里 EXEC（加黑部分）：http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。

Port：指定端口，只要是当前计算机没有使用的端口都可以。如果 IntraWeb是体验版本的话，则修改无效，且每次运行端口都会自动改变。它出现在 IE地址的 IP加冒号的后面，如下所示 8888（加黑部分）http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。

SessionTimeout：设置一个等待时间，单位为分钟。因为要为每个用户创建一个 Session，如果永远保留，那服务器的内存开支就太大了。因此设置一个时间，如果在这时间之内用户没有与服务器

进行交互，则认为用户已经离开了，程序就会关闭他的 Session。这个时间如果太少，则可能导致用户不能正常使用，太长了又浪费资源，120 分钟较为合适（还是具体情况具体分析吧，主要看当前页面你认为用户最长应该保留多少时间）。

SessionTrackingMethod：如果不想 IE地址太长的话，请选择 tmHidden，这样 Session的 ID就不会出现在 IE地址里了，它被隐藏在网页里（网址最后的那一串经常变动的字符就没有了）。其它的属性取默认值就行了。 13、如何访问我们的程序：先运行 Project1.exe，在客户端的 IE地址里写入：http:// BoundIP: Port

即可。例如我们把以上属性改为：BoundIP为 192.200.9.81有(这里假设你的机器的本身设定的 IP为

http://127.0.0.1:8888/

http://127.0.0.1



第 19页/共 301页

192.200.9.81，请根据自己的实际情况更改)，Port 为 886(一般情况下是随便设定，只要该端口没有被你的机器的某个程序已使用 )， ExeCmd 为 IloveYou(只能是英文，随便你设定 )，SessionTrackingMethod为 tmHidden，AppName为 ILoveYou(只能是英文，随便你设定)。则客户端的访问地址为：http://192.200.9.81:866，如图 2-8所示：

图 2-8 用服务器的 IP和指定端口访问程序

http://192.200.9.81:866



第 20页/共 301页

2．2建立一个以 iis作为发布器发布的程序

在一般情况下，我们都是先建立 StandAlone Application程序，即可以直接运行的 exe模式，如2.1节所述。在 windows下，我们一般在 2000或者 2003下用 IIS发布。这样我们就需要建立 ISAPE Extension程序。即以 dll形式发布的程序。以下我们将 2.1的程序转换成 dll的形式。这个例子我提供了完整的源代码，存放在文件 2.1 中。在开发程序的过程中我会解答很多遇到的

实际问题，我不讲理论，注重实际应用，请大家对应查找相关注释。以下从 0开始我们的旅程： 1、打开 Delphi 7，点击 file->new->other，在弹出对话框（图 2-9）中选择 IntraWeb选项卡，选

择 IntraWeb Application Wizard，点击 Ok。注：每一个 IntraWeb应用都是从这里开始的。


2、在弹出对话框（图 2-10）中点击 Ok。注：选项的默认值是很实用的，一般不用更改。左边的程序类型我们选择的是 ISAPE Extension，也就是说程序编译完了之后是自带服务器的 dll 结尾的形式。




第 21页/共 301页

3、点击上图的 ok 按钮后，先不要保存工程文件，请先点击图 2-11 中的按钮，出现图 2-12

所示对话框。选择其中的一个点击 ok按钮，在出现的提示框中再点击 yes，如果提示保存请选择不要保存。再执行相同的操作两次，把对话框中的 3个都删除。之后请保存工程文件为 Project1_dll.dpr，

保存目录选择 2.1 文件夹。再点击按钮，出现图 2-13 所示对话框，选择所有 exe 程序所用到的

pas文件，再点击打开按钮，再保存所有即可。

图 2-11 delphi工具条

图 2-12 remove from project对话框

图 2-13 add to project对话框

编译，Delphi会提示，如图 2-14：



第 22页/共 301页

图 2-14 编译.dll时的出错提示恭喜，Delphi 已经编译生成了一个 Project1_dll.dll 文件，至此我们的一个文件夹中就同时有两个

发布方式的工程了，平时调试程序时用 exe的 Project1.dpr工程，要发成 dll时用 Project1_dll.dpr工程，只需要象上面那样加入在 exe中新建立的 pas文件即可(即执行 add to project对话框)。



第 23页/共 301页

2．3 IntraWeb程序在 IIS下的发布如何发布.dll 版本呢？此处只讲 XP 下的操作，2000 下是类似的。注：发布到不同的系统，以下

参数是要特别注意的，ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。否则会出错，这是经验。只能用 IIS发布。步骤如下：在文件夹 2.1上点击右键，选择共享和安全，选择Web共享选项卡，

进行如图 2-15相同的设置。然后一路按确定即可。

图 2-15 文件共享和安全对话框

在我的电脑上点击右键，选择管理，出现图 2-16，在我们的新网站 iloveyou上点击右键，选择属性，在目录安全性中点击编辑，进行如图相同的设置。

图 2-16 计算机管理对话框



第 24页/共 301页

这就完成的网站的设置。在 IE 中输入 http://192.200.9.81/iloveyou/index.dll，按下回车，就会出

现图 2-17所示的运行主页面。IP地址 192.200.9.81可以用指向它的域名来代替。Iloveyou是网站的别名，相当于文件夹 2.1。

图 2-17 .dll版本的运行主页面

发布运行过之后，要删除或修改 index.dll要先重新启动 IIS服务。图 2-18演示了如何重新启动 IIS

服务器。（此时不要在 IE中再次运行 http://192.200.9.81/iloveyou/index.dll，否则又要重新启动 IIS）

图 2-18 重新启动 IIS

要达到修改 index.dll文件的目的，也可以如图 2-19 结束 dllhost.exe进程。这只是在编程过程中

的一些调试小技巧。要注意的是 dllhost.exe的用户名要是以 IWAM_开头的。

图 2-19 结束 dllhost.exe进程

http://192.200.9.81/iloveyou/index.dll

http://192.200.9.81/iloveyou/index.dll

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．4 IntraWeb程序.exe与.dll两种发布形式的相互转换作者：高勇


第 25页/共 301页

2．4 IntraWeb程序.exe与.dll两种发布形式的相互转换

我们可以将程序转换成.dll 形式发布(它们可以互相转换)。仍以 2.1 文件夹下的程序为例，将Project1.dpr拷贝一份改名为Project1_dll.dpr，打开它进行修改。有如下几步要做：将program Project1变成 library Project1_dll，将 Forms变成 ISAPIApp，将 IWMain变成 IWInitISAPI，在 begin之前加入以下 4句：

exports GetExtensionVersion, HttpExtensionProc, TerminateExtension; 将 begin与 end之间的

Application.Initialize; Application.CreateForm(TformIWMain, formIWMain); Application.Run; 3行内容换成 IWRun; 如下是两者的区别：这是.exe版本： program Project1; uses Forms, IWMain, ServerController in 'ServerController.pas' {IWServerController: TIWServerController}, Unit1 in 'Unit1.pas' {IWForm1: TIWFormModuleBase}, UserSessionUnit in 'UserSessionUnit.pas' {IWUserSession: TIWUserSessionBase}, Unit2 in 'Unit2.pas' {IWForm2: TIWAppForm}, Unit3 in 'Unit3.pas' {IWForm3: TIWAppForm}; {$R *.res} begin Application.Initialize; Application.CreateForm(TformIWMain, formIWMain); Application.Run; end. 这是.dll版本： library Project1_dll; uses ISAPIApp, IWInitISAPI, UserSessionUnit in 'UserSessionUnit.pas' {IWUserSession: TIWUserSessionBase},

ServerController in 'ServerController.pas' {IWServerController: TIWServerControllerBase}, Unit1 in 'Unit1.pas' {IWForm1: TIWAppForm}, Unit2 in 'Unit2.pas' {IWForm2: TIWAppForm},

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．4 IntraWeb程序.exe与.dll两种发布形式的相互转换作者：高勇


第 26页/共 301页

Unit3 in 'Unit3.pas' {IWForm3: TIWAppForm}; {$R *.RES} exports GetExtensionVersion, HttpExtensionProc, TerminateExtension; begin IWRun; end. 改完之后进行编译，Delphi会提示，如图 2-20：

图 2-20 编译.dll时的出错提示不要理会，Delphi 已经编译生成了一个 Project1_dll.dll 文件，将其改为我们所喜欢的名字，例如

index.dll。目的是为了发布时客户端的访问地址好记。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．5 用 html模板美化我们的程序作者：高勇


第 27页/共 301页

2．5 用 html模板美化我们的程序

1）在 IWForm1窗口是加入 IWTemplateProcessorHTML1控件（从 IW Control选项卡中选取，第一个就是）。

2）再将 IWForm1窗口的 LayoutMgr属性设为 IWTemplateProcessorHTML1。 3）在 2.1.1 文件夹中建立 files 和 templates 文件夹（这两个文件名是固定的，不要改变），files

是一个很特别的文件夹，IntraWeb程序将所有可访问的资源（图片，文件等）都放在 files文件夹中。Templates 文件夹是默认的 html 模板的存放地。我们用别的编辑网页的软件建立一个模板放在templates文件夹中。它的结尾要是.html，且文件名要与其对应的窗口名一样。我们这里只对 IWForm1窗口进行美化。为其编辑的模板文件为 IWForm1.html。那窗口上的控件是如何进入到模板中的呢？只要将窗口中的控件的name放入{%%}中间即可。例如，控件 IWLabel1的模板标记为{%IWLabel1%}，将{%IWLabel1%}直接写在网页模板里，在页面显示时，IntraWeb会将{%IWLabel1%}用控件 IWLabel1的内容替换掉。图 2-21将 IWForm1窗口中的 4个控件标记到模板中了。注：模板中所有引用的图片都要放在 files文件夹中，且只能用相对路径。

图 2-21 编辑中的模板

以下是运行时的页面 1，如图 2-22所示：

图 2-22 应用模板后实际页面 1

其它的窗口也是采用相同的方法来进行美化。通过这种方式，做Web应用时，美工和编程就可以

一并进行了。而且是分开的，不同的美工设计可以得到不同的网站样式。而程序却不用修改。用 IIS服务器发布也是一样的效果。



第 28页/共 301页

2．6 IntraWeb的 exe程序中开发自己的服务器界面

怎样开发自己的服务器界面？以下请参考文件夹 2.2内的源代码。接上一个例子： 1、新建立一个普通 Delphi窗口，将 IW Control选项卡上的 IWStandAloneServer1控件放入其中。

这个窗口中的编程与普通 Delphi内的编程是一样的。窗口中的控件布置如图 2-23所示：

图 2-23 开发中的服务器主界面 2、三个按钮以及 IWStandAloneServer1控件的相应事件代码如下： {$R *.dfm} procedure TForm4.Button1Click(Sender: TObject);//打开 IE begin IWStandAloneServer1.Run;//在 IE中运行我们的Web应用 end; procedure TForm4.Button2Click(Sender: TObject); begin close;//关闭本窗口，同时 IWStandAloneServer1被销毁，Web服务器被停止 end; procedure TForm4.IWStandAloneServer1NewSession(Sender: TObject);//当一个用户登录时 begin Label2.Caption := '当前在线' + inttostr(IWStandAloneServer1.ActiveSessions) + '人'; {当前存在多少个 Session就应该有多少人。但是不一定准确，如果登录的客户没有主动点击退出

程序按钮而是直接关闭 IE，这就会告造成误差。因为 Session 要等待一个相应的时间(IWServerController.SessionTimeout所设定的值)后才会自动关闭，这样 Session数才会减去 1。}

end; procedure TForm4.Button3Click(Sender: TObject); begin IWStandAloneServer1.ClearSessions;//将所有的 Session关闭 //已经登录的人将会被迫退出，只能重新登录 Label2.Caption := '当前在线' + inttostr(IWStandAloneServer1.ActiveSessions) + '人'; //刷新当前在线人数的显示 end; procedure TForm4.IWStandAloneServer1CloseSession(Sender: TObject);//当一个用户退出时



第 29页/共 301页

begin Label2.Caption := '当前在线' + inttostr(IWStandAloneServer1.ActiveSessions) + '人'; //刷新当前在线人数的显示 end; 3、在运行编译之前，请先注释掉“Application.CreateForm(TformIWMain, formIWMain);”如图 2-24

所示：（要用默认的则请注释掉它下面一句，即我们刚才新建的窗口）

图 2-24 注释掉调用默认窗口的语句 4、运行程序如图 2-25所示：

图 2-25 自己开发的服务器运行时界面

这是一个普通的 windows窗口，在上面你可以添加你想添加的任何功能，如版权信息，软件注册，演示版本时间或次数限制，最小化到托盘，是不随开机启动等等所有 Delphi普通开发的所有功能（可以使用丰富的第三方控件）。只为过这只能在服务器一台机器上使用，客户端是看不到的。文件夹 1.4中的英语听力学习站点的服务器运行时界面就是自己编写的，如图 2-26所示。

图 2-26 自己开发的服务器运行时界面

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．7 IntraWeb程序开发经验小结作者：高勇


第 30页/共 301页

2．7 IntraWeb程序开发经验小结 1、开发 IntraWeb程序时请先用默认方式创建，exe形式的便于调试，如要用 IIS发布，可以方便

的转换成 dll形式。 2、新建工程，窗口等都是：点击 file->new->other，在弹出对话框（图 2-21）中选择 IntraWeb

选项卡，再选择自己相应的模块点击确定。IntraWeb 在 Delphi 中相对比较独立，从编程一开始，就用自己的模块来建立，在编程的过程中请尽量使用其自己的控件。（IntraWeb数据库的编程时与 Delphi的数据库编程类似）

图 2-21 IntraWeb选项卡 3、建立一个新的工程时，请选择默认选项，IntraWeb 为我们已经考虑得很周到了。默认选项里

会包括 UserSessionUnit，这将大大方便我们编程时的各个窗口之间的数据交换。它像 windows的剪贴板，要传递数据时，第一个窗口先将数据存贮在 UserSessionUnit的某一个变量中（相当于 windows的复制），所有的窗口就可以随时使用保存在 UserSessionUnit的变量值了（相当于 windows的粘贴）。这是最简便的一种方式。

4、对 ServerController 单元进行综合设置：（注：192.200.9.81是我调试时我的计算机的 IP，你使用时请将以下 192.200.9.81改为你自己的 IP，如果是单机没有联网，可以使用 127.0.0.1）

AppName：这个属性为Web应用程序指定一个名称（请填写英文字符），请尽量保证此名称的唯一性，如果两个应用的名称相同则它们不能同时运行在一个系统中。

AllowSubFolders：请选择 true。这将允许程序使用下级文件夹（例如 files文件夹下还可以新建无数级文件夹）。有利于我们的编程。

BoundIP：（发布成 exe 形式时有效）填写将要发布的服务器的 IP，如果空着，则自动被设为127.0.0.1，这样就只能本机访问了，其它用户通过 internet 不能访问。如果 IntraWeb 是体验版本的话，这个值会被固定为 127.0.0.1，不管你改为多少，如果服务器没有网络，则用指定的 IP打开会出错。它出现在 IE地址里（加黑部分）http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。

ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal，当你用到数据库时，如果默认为 ciNone会出错。否则会出错，这是经验。

ExeCmd：可以任意指定（请用英文字符），默认为“exec”。它出现在 IE地址里 EXEC（加黑部分）：http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。

Port：指定端口，只要是当前计算机没有使用的端口都可以。如果 IntraWeb是体验版本的话，则

http://127.0.0.1:8888/

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 2．7 IntraWeb程序开发经验小结作者：高勇


第 31页/共 301页

修改无效，且每次运行端口都会自动改变。它出现在 IE地址的 IP加冒号的后面，如下所示 8888（加黑部分）http://127.0.0.1:8888/EXEC/0/1qjam290b8qz3l17gsfk51vhfkxp。


进行交互，则认为用户已经离开了，程序就会关闭他的 Session。这个时间如果太少，则可能导致用户不能正常使用，太长了又浪费资源，120 分钟较为合适（还是具体情况具体分析吧，主要看当前页面你认为用户最长应该保留多少时间）。

SessionTrackingMethod：如果不想 IE地址太长的话，请选择 tmHidden，这样 Session的 ID就不会出现在 IE地址里了，它被隐藏在网页里（网址最后的那一串经常变动的字符就没有了）。其它的属性取默认值就行了。 5、网站根目录请先建立如下文件夹：files（存放所有要用的文件）, templates（存放页面美化模

板）。 6、模板文件名的格式为：窗口 name.html，文件内不支持 ASP 代码，支持 JavaScript 代码。

IWRegion控件内的所有控件与 IWRegion是一个整体，不能再在模板中有 IWRegion内的控件标记。也就是说，{% IWRegion%}标记就包括了 IWRegion 和其内的所有控件了，其内的所有控件与IWRegion控件的相对位置不变。

7、ServerController的 OnCreate事件代码如下（指定程序运行时的 cache目录）： procedure TIWServerController.IWServerControllerBaseCreate( Sender: TObject); begin self.CacheDir := self.GetAppPath + 'cache';//指定 IntraWeb的缓存目录

//GetAppPath得到网站根目录，这样有好处 end; 8、请在每一个窗口单元的 implementation 后面加上以下语句：uses ServerController,

UserSessionUnit;目的是确保可以方便的引用这两个单元的变量和函数。调用他们的格式如下：IWServerController.AppPath和 UserSession.ADOQuerytemp等，这只是举的两个例子。这两个单元请不要改名字，保存也请用默认名称，这有利于程序的移植。在 UserSessionUnit 单元里请在implementation后面加上以下语句：uses IWInit, ServerController;

9、在所有窗口的单元文件的最后一个 end前最好注册一下该类，否则显示窗口时会显示找不到某某类。代码类似如下。函数中的参数是窗口名前加个 T字符。切记一定要手动加入，不会自动生成的。如果窗口名为 IWForm2，则其代码如下：

initialization RegisterClass(TIWForm2);

10、如果有数据连接控件，如 TADOConnection等，请一定要放在 UserSession窗口里，否则用IIS形式发布时会有问题（例如放在 IWServerController窗口中，在 EXE形式发布时没有问题，但在IIS形式发布时会有问题）

http://127.0.0.1

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．1 用虚拟键盘输入密码作者：高勇


第 32页/共 301页

第三章 Intraweb编程专题讲座

3．1 用虚拟键盘输入密码当网页有密码要输入时，如果直接用键盘输入，有可能会被黑客程序截取密码并发送出去。但如

果能够在用户单击密码输入框后弹出一个虚拟键盘，再用鼠标点击虚拟键盘输入密码就会安全得多。

本节就是要实现这样的一个功能。而且是用 Intraweb来实现，不用写什么代码，速度很快，不信请跟我来。

1、打开 Delphi 7，点击 file->new->other，在弹出对话框中选择 Intraweb选项卡，选择 Intraweb Application Wizard，点击 Ok。


2、在弹出对话框中点击 Ok。 3、点击 file->save，将文件分别保存为 Umain.pas，UserSessionUnit.pas，ServerController.pas，

Project_mykeyboard.dpr。注意，请保存同一目录下，并在该目录下新建一个文件夹 files，这是 Intraweb程序要使用的一个很特别的文件夹，是 Intraweb 默认的资源(各种文件，图片等)存放地。将文件mykeyboard.js拷贝到 files目录下。(文件目录：3.1\files\mykeyboard.js)

4、在 IWForm1上放上一个 IWEdit1控件和 IWButton1控件，他们在 IW Standard选项卡上。IWEdit1 控件是一个文体输入控件，我们用来输入密码。修改他的如下属性：ReadOnly 为 True；PasswordPrompt 为 True；双击 ScriptEvents 右边的…号按钮，在弹出的对话框中选择左边的onChange，在右边请写入“Calc.password.value=this.value;”(双引号内的所有符号，全部是在英语输入状态输入，且大小写要一样)，再选择左边的 onClick，在右边请写入“

password1=null; initCalc(); password1=this; showkeyboard(); this.readOnly=1; Calc.password.value=this.value;”

第 33页/共 301页

图 3-2 OnChange事件代码

图 3-3 onClick事件代码

5、在 IWForm1窗口的空处点击一下，修改 IWForm1的属性如下：ExtraHeade中点击右边的…号按钮，在对话框中输入“<SCRIPT language=JavaScript src="files/mykeyboard.js"></SCRIPT>”，此句的目的是将 files目录下的mykeyboard.js文件加入到网页的头部。不明白没有关系，照着做就行了。

图 3-4 在 ExtraHeade中加入 JS文件

6、将 IWButton1的 Capton属性改为“查看密码”，在 IWForm1窗口中双击 IWButton1按钮，为其单击事件写入如下代码：“self.WebApplication.ShowMessage('您输入的密码是：'+IWEdit1.Text);”，此处的目的是网页打开后，单击“查看密码”按钮，将会弹出一个信息框，告诉你密码框中的实际输入密码是什么，以此检验我们的虚拟键盘输入是否正确。

7、转到 IWSeverController 窗口，修改如下属性： SessionTrackmethd 改为 tmHidden 或tmCookie；(如果是 tmURL，程序运行会出错，在编写其它 Intraweb应用程序时也最好不要用 tmURL参数。)



第 34页/共 301页

图 3-5 修改 SessionTrackmethd属性

8、保存。点击菜单 run->run(或 F9)，编译完后有一个窗口出现，按 F9 或点击最左边的按钮即可运行我们的程序。单击输入框会有一个虚拟键盘弹出来，按 Cancel 可以进入用键盘输入状态。点击查看密码可以看到你输入的密码。程序运行界面如下。 (编译完后在程序保存的目录下有Project_mykeyboard.exe文件，直接运行就可以了)

图 3-6 程序运行界面 1

图 3-7程序运行界面 2

9、要实现这种功能，不用改写代码，只要在程序中修改密码输入框和他的窗口这两个控件的相应属性即可。别忘了在 files目录中拷入mykeyboard.js文件。很简单吧^_^，我可是经过了 N次的调试才搞定呀，很累，不过很有成就感。望高手不要见笑。程序发布时只要把 files 文件夹和Project_mykeyboard.exe文件同时拷贝走就可以了(放在同一个文件夹中)。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．2 IntraWeb数据库报表解决方案之一作者：高勇


第 35页/共 301页

3．2 IntraWeb数据库报表解决方案之一

———用 FastReport直接实现服务器端报表

IntraWeb数据库报表一直困绕着我。在潜意识中我一直在苦苦的思索着。如何在客户端不安装任何的控件而实现网络报表呢？用 PDF格式显示？这是一个好主义，因为 PDF软件安装是很普遍的，但找遍所有资料得到的结论是：在所有的将报表转换到 PDF格式的控件中，对中文的支持实在是太差了，一有中文就是乱码！Delphi自带的 Rave控件也有很多的毛病：数据库字段名不支持中文，转换成 PDF和 RTF等格式时有乱码等等。网上的有一个报表控件号称可以解决此问题，但没有试用期，感觉当他网络发布时可能有问题，

而且收费很高，售后服务可能没有，作者联系电话都不公布，很是郁闷。还是自己想想办法吧。有一个很好用的报表控件：FastReport v3.20 for D7.rar，相信大家都听说过，搞到他的安装版本

应该是不难的。下面我结合这个控件来谈谈我的报表解决方案。先说说我的思路： 1、利用 FastReport报表控件制作报表模板文件，将报表模板文件存放在程序根目录下的 files目

录中。 2、利用 FastReport 的相关组件将我们的数据在服务器上报表成一个临时文件，将这所有的临时

文件存放在 files目录中的一个唯一的文件夹中（每一个用户 UserSession一开始使用时就生成一个绝对不会与别人相同的文件夹，UserSession结束时就删除这个刚刚建立的文件夹），这样就保证了不同用户调用报表时只能自己调用自己生成的数据报表。

3、为将在服务器上生成的临时文件报表发送到客户端，我们将为这个临时文件给定一个 URL 地址，这样就实现了在客户端查看，打印报表的功能。

4、可以传送的报表格式可以为 PDF，RTF（WORD格式），HTML（网页），XLS（EXCEL文件）等。经检测，FastReport可以很好的完成后三种格式的生成，PDF不支持中文（个人认为，也许是我不会用，见谅）。下面我们就动手试一下。像 2．1所介绍的那样，新建一个 IntraWeb工程 RaveDemo.dpr。请安装好 FastReport控件后打

开源代码自己看。(在文件夹 3.2中) FastReport的使用方法与 Delphi中的普通应用时的是一样的。这里就不作过多讲述。图 3-8是所有的控件布局情况。相信大家一看源代码就清楚了。我对关键代码作一下说明。

图 3-8控件布局

各控件的属性请注意查看，如图 3-9。记住，Showdialog和 ShowProgress一定要是 false。



第 36页/共 301页

frxHTMLExport1： frxXMLExport1: frxRTFExport1：

图 3-9控件的属性

图 3-10为主程序运行界面：

图 3-10主程序运行界面

请看 Unit1单元： 1、窗口生成时连接数据库，并打开数据集数据库为 files目录下的 data.mdb文件。WebApplication.ApplicationPath用来得到主程序的根目

录。 procedure TIWForm1.IWAppFormCreate(Sender: TObject); begin RepQuery.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +



第 37页/共 301页

WebApplication.ApplicationPath + 'files\data.mdb;Persist Security Info=False'; RepQuery.Open; end;

2、print-htm按钮的实现代码。 procedure TIWForm1.IWButton1Click(Sender: TObject); //生成 HTML报表 var LFile: string; LOptions: string; LWindowName: string; LURL: string; begin //导入报表模板文件 3.fr3 frxReport1.LoadFromFile(WebApplication.ApplicationPath + 'files\3.fr3'); //定义临时保存在服务器上的报表文件名 LFile := 'temp.htm'; //WebApplication.AppID 是服务器为每一个用户生成的唯一的一个字符串，这样就保证了用户只能调用自己生成的报表 frxHTMLExport1.FileName := WebApplication.ApplicationPath + 'files\' + WebApplication.AppID + '\' + LFile; //生成 files目录下的唯一文件夹 ForceDirectories(ExtractFileDir(frxHTMLExport1.FileName)); //准备报表数据 frxReport1.PrepareReport; //将报表数据以 HTML格式导出到文件 frxHTMLExport1.FileName中 frxReport1.Export(frxHTMLExport1); //以下为将报表发送到客户端 //窗口名称 LWindowName := 'HTML报表示例'; //是否有滚动条，IE窗口的长和宽 ,可以为空字符串，如果为空则窗口这完整的 IE窗口。 LOptions := 'scrollbars=yes,width=800,height=600'; //给出在服务器上生成的报表的 URL地址 LURL := WebApplication.AppURLBase + '/FilesNC/' + WebApplication.AppID + '/' + LFile; //打开一个新 IE窗口，将报表展现出来 AddToInitProc('NewWindow("' + LURL + '", "' + LWindowName + '","' + LOptions + '");'); end; 图 3-11为按下 print-htm按钮报表结果：

第 38页/共 301页

图 3-11按下 print-htm按钮报表结果

3、print-xls按钮的实现代码

procedure TIWForm1.IWButton2Click(Sender: TObject);//生成 xls报表 var LFile: string; LURL: string; begin //导入报表模板文件 3.fr3 frxReport1.LoadFromFile(WebApplication.ApplicationPath + 'files\3.fr3'); //定义临时保存在服务器上的报表文件名 LFile := 'temp.xls'; //WebApplication.AppID 是服务器为每一个用户生成的唯一的一个字符串，这样就保证了用户只能调用自己生成的报表 frxXMLExport1.FileName := WebApplication.ApplicationPath + 'files\' + WebApplication.AppID + '\' + LFile; //生成 files目录下的唯一文件夹 ForceDirectories(ExtractFileDir(frxXMLExport1.FileName)); //准备报表数据 frxReport1.PrepareReport; //将报表数据以 HTML格式导出到文件 frxXMLExport1.FileName中 frxReport1.Export(frxXMLExport1);

//以下为将报表发送到客户端 //给出在服务器上生成的报表的 URL地址 LURL := WebApplication.AppURLBase + '/FilesNC/' + WebApplication.AppID + '/' + LFile; //在网页上显示一个在新窗口中打开报表的链接 IWRectangle1.Text:='<a href="'+LURL+'" target="_blank">打开 xls报表 </a>';



第 39页/共 301页

end; 图 3-12为按下 print-xls按钮，点击“打开 xls报表”链接后的报表结果：

图 3-12按下 print-xls按钮报表结果

说明：本想按下 print-xls 按钮直接在新窗口中打开报表，但没有合适的代码实现，如是分成了两

步：先产生适时报表，再通过自动生成的链接打开报表。这样也有好处：当不小心关闭报表窗口后，

要再查看不必重新再生成报表，只需点击链接即可。产生链接的控件是 IWRectangle1，请注意这里的使用方法。

4、print-rtf按钮的实现代码 procedure TIWForm1.IWButton3Click(Sender: TObject);//生成 rtf报表 var LFile: string; LURL: string; begin //导入报表模板文件 3.fr3 frxReport1.LoadFromFile(WebApplication.ApplicationPath + 'files/3.fr3'); //定义临时保存在服务器上的报表文件名 LFile := 'temp.rtf'; //WebApplication.AppID 是服务器为每一个用户生成的唯一的一个字符串，这样就保证了用户只能调用自己生成的报表 frxRTFExport1.FileName := WebApplication.ApplicationPath + 'files\' + WebApplication.AppID + '\' + LFile; //生成 files目录下的唯一文件夹 ForceDirectories(ExtractFileDir(frxRTFExport1.FileName)); //准备报表数据 frxReport1.PrepareReport;

第 40页/共 301页

//将报表数据以 rtf格式导出到文件 frxRTFExport1.FileName中 frxReport1.Export(frxRTFExport1); //给出在服务器上生成的报表的 URL地址 LURL := WebApplication.AppURLBase + '/FilesNC/' + WebApplication.AppID + '/' + LFile; //在网页上显示一个在新窗口中打开报表的链接 IWRectangle1.Text:='<a href="'+LURL+'" target="_blank">打开 rtf报表 </a>'; end; 图 3-13为按下 print-rtf按钮，点击“打开 rtf报表”链接后的报表结果：

图 3-13按下 print-rtf按钮报表结果

说明：本想按下 print-rtf按钮直接在新窗口中打开报表，但没有合适的代码实现，如是分成了两步：

先产生适时报表，再通过自动生成的链接打开报表。这样也有好处：当不小心关闭报表窗口后，要再

查看不必重新再生成报表，只需点击链接即可。产生链接的控件是 IWRectangle1，请注意这里的使用方法。请看 ServerController单元： 1、动态自己绑定本机 IP。以下是取得本机的 IP地址。

function LocalIP: string; //取得本机的 IP,需要 uses中添加Winsock单元，此函数 LocalIP要放在调用它的函数的前面 type TaPInAddr = array[0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe: PHostEnt; pptr: PaPInAddr; Buffer: array[0..63] of char; I: Integer; GInitData: TWSADATA;

第 41页/共 301页

begin WSAStartup($101, GInitData); Result := ''; GetHostName(Buffer, SizeOf(Buffer)); phe := GetHostByName(Buffer); if phe = nil then Exit; pptr := PaPInAddr(phe^.h_addr_list); I := 0; while pptr^[I] <> nil do begin Result := StrPas(inet_ntoa(pptr^[I]^)); Inc(I); end; WSACleanup; end; 以下为 IWServerController生成时为自己的一些属性赋值（其详细属性设置上一章已有介绍）：

procedure TIWServerController.IWServerControllerBaseCreate( Sender: TObject); begin //给 IWServerController 的一些属性赋值 self.CacheDir := self.GetAppPath + 'files\cache';//如不这样，它会在系统盘上生成 self.BoundIP:=LocalIP; //这样可以保证自动绑定本机 IP，如果没有网络，则为 127.0.0.1 self.Port:=8888;//数字基本上是任意的，只要没有被其它的程序占用的端口都可以用 end;

2、当 Session结束时执行如下代码，目的是删除在报表时生成的用 Session的 ID作为名称的文件夹，因报表需要而生成的临时文件被全部删除。 procedure TIWServerController.IWServerControllerBaseCloseSession( ASession: TIWApplication); var LFilesDir: string; sr: TSearchRec; begin LFilesDir := GServerController.FilesDir + ASession.AppID;//找到我们要删除的目录 if FindFirst(LFilesDir + PATHDELIM + '*.*', faAnyFile, sr) = 0 then//删除目录中的文件 begin repeat DeleteFile(LFilesDir + PATHDELIM + sr.Name); until FindNext(sr) <> 0; FindClose(sr); end; RemoveDir(LFilesDir);//删除文件夹，这样就保证 files文件下的垃圾文件得到及时的清除 end; 补充说明：RaveDemoDLL.dpr 为生成 dll 版本的工程文件。要用 IIS发布生才能查看。所有代码



第 42页/共 301页

在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15+ FastReport v3.20下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

附录：FastReport 3 组件使用简介

组件介绍： 1、TfrxReport 这是 FastReport 3最核心的报表组件，一个 TfrxReport 组件组成一份报表。在设计时期，双击此

组件可打开报表设计器(Report Designer)，此组件的属性及方法很重要。 TfrxReport 提供的方法： procedure Clear;//清除上一次产生的报表内容 function LoadFromFile(const FileName: String; ExceptionIfNotFound:Boolean = False): Boolean; ;//从

FileName文件载入报表模板。假如第二个参数等于 “True”且文件不存在，将产生异常，假如文件载入成功，返回值为”True ” 。

procedure LoadFromStream(Stream: TStream); //从数据流(stream)载入报表模板。 procedure SaveToFile(const FileName: String); //保存报表模板至指定的文件。 procedure SaveToStream(Stream: TStream); //保存报表模板至数据流(stream)。 procedure DesignReport; //进入报表模板设计环境。报表模板设计环境将嵌入在你的工程文件(要执

行此功能，只要在 uses 子句加入 frxDesign 单元或在工程文件中加入“TfrxDesigner” 组件)。 procedure ShowReport(ClearLastReport: Boolean = True); //开始按模板生成报表并将输出结果显示

在预览窗口中。例如“ClearLastReport” 参数等于“False”，报表内容将会加入至前一个报表内容的后面，否则前一个建立的报表内容会被清除。

function PrepareReport(ClearLastReport: Boolean = True): Boolean; //开按模板生成报表，但不显示预览窗口。参数指定方式与“ShowReport” 方法(method)相同。假如报表创建成功，此函数返回“True” 。

procedure ShowPreparedReport; //显示先前使用“PrepareReport” 所建立的报表内容。 procedure Print; //打印报表。 procedure Export(Filter: TfrxCustomExportFilter); //使用指定的导出过滤器(export filter)导出报表內

容。因为下列的方法只提供一种服务，在大部分的情況之下，你并不须要使用它们。在增強 FastReport 的报表功能方面，他们可能是很有用的。例如，当撰写自定义的报表组件时。

TfrxReport 组件拥有下列属性： property EngineOptions: TfrxEngineOptions; //与 FastReport 引擎相关的属性集合。 property IniFile: String; //储存 fastReport 环境变量设定的文档或注册码的名称。 property Preview: TfrxCustomPreview; //连接到“TfrxPreview” 组件，完成的报表将显示在此组件上。

假如此属性空白，报表将显示在标准的预览窗口中。 property PreviewOptions: TfrxPreviewOptions; //与报表预览相关的属性。 property PrintOptions: TfrxPrintOptions; //与报表打印相关的属性。 property ReportOptions: TfrxReportOptions; //定义报表相关的属性。 property ScriptText: TStrings; //脚本语言的内容。 property AllObjects: TList readonly; //报表内所有的组件列表（包括页定义组件）。 property DataSets: TfrxReportDataSets readonly; //报表可用的数据集列表。 property Engine: TfrxCustomEngine readonly; //连结报表引擎。对于要使用程序码处理报表是非常有

用的，它可以自定义报表处理引擎。 property Errors: TStrings readonly; //错误清单，发生在一个或其它的进程中。



第 43页/共 301页

property FileName: String; //定义报表的文件名称；文件名会显示在设计环境的窗口标题中。 property PreviewPages: TfrxCustomPreviewPages readonly; //定义一个连结到已完成的报表页面。它

可被使用在所有地方，例如打印、存盘及导出等。 property Pages[Index: Integer]: TfrxPage readonly; //报表页面列表，其中对话框类型也包括在列表

中。 property PagesCount: Integer readonly; //报表的页数。 property Script: TfsScript readonly; //连结报表的“TfsScript” 组件，经由该连接，你可以为你的报表

脚本语言加入变量、类型、函数以供以后调用。 property Variables: TfrxVariables readonly; //报表变量列表。 FastReport 引擎的相关属性集合： property ConvertNulls: Boolean default True; //转换数据库字段的“Null” 值至“0”, “False” 或空字串

(依字段型态而定)。 property DoublePass: Boolean default False; //使报表进行二次处理，第一次进行资料搜集(例如报表

总页数)，第二次才实际进行报表处理。 property MaxMemSize: Integer default 10; //配置报表页面缓存的最大内存使用量 ( M)，当

“UseFileCashe” 属性等于“True” 时特别有用。假如在建立期间耗用太多内存，已建立的报表缓存页面将会被写入缓存文件，此属性并不非常的精确，它只大約的決定内存的限制。

property PrintIfEmpty: Boolean default True; //定义是否要打印空白报表（空报表）。 property TempDir: String; //指定保存临时文件的目录。 property UseFileCache: Boolean default False; //定义产生的预览报表是否缓存到文件。 (见

“MaxMemSize” 属性) 报表预览的相关属性集合： property AllowEdit: Boolean default True; //是否允许编辑预览窗口中的报表。 property Buttons: TfrxPreviewButtons; //预览窗口中的可用按钮集合： TfrxPreviewButtons = set of TfrxPreviewButton; TfrxPreviewButton= (pbPrint, pbLoad, pbSave,

pbExport, pbZoom, pbFind, pbOutline,pbPageSetup, pbTools, pbEdit, pbNavigator); 此属性可用的值如下：pbPrint 为打印，pbLoad 为载入文件，pbSave 为存报表到文件，pbExport

为导出，pbZoom为显示比例，pbFind为搜寻，pbOutline为选定报表边框，pbPageSetup为页面设定，pbTools为工具，pbEdit为编辑，pbNavigator为导航，上面的值你可以混合使用。

property DoubleBuffered: Boolean default True; //预览窗口采用双缓存区模式。假如启用(默认值)，画面输出时屏幕不会有闪烁的情形，但处理速度会稍微下降。

property Maximized: Boolean default True; //定义预览窗口是否最大化。 property MDIChild: Boolean default False; //定义预览窗口是否为MDIChild (给MDI 介面使用)。 property Modal: Boolean default True; //定义预览窗口是否为Modal 模示。 property OutlineVisible: Boolean default False; //定义是否显示报表的大纲。 property OutlineWidth: Integer default 120; //定义报表大纲显示的宽度。 property ShowCaptions: Boolean default False; //定义是否显示按钮的标题。当启动该属性时，你应

该限制 Buttons 属性所显示按钮的个数，因为所有的按钮无法显示于同一画面。 property Zoom: Extended; //默认的显示百分比率。 property ZoomMode: TfrxZoomMode default zmDefault; //默认显示模式。可用的值如下： zmDefault为显示百分比率视“Zoom” 属性而定 zmWholePage为整页模示 zmPageWidth页宽 zmManyPages为两页



第 44页/共 301页

报表打印相关属性的集合： property Copies: Integer default 1; //默认的打印份数。 property Collate: Boolean default True; //不管校对份数。 property PageNumbers: String; //打印的页码。例如，“1,3,5-12,17-”（以“，”为分割）。 property Printer: String; //打印机名称。 property PrintPages: TfrxPrintPages default ppAll; //定义要打印的方式。可用的值如下： ppAll为全部 ppOdd为奇数页 ppEven为偶数页 property ShowDialog: Boolean default True; //是否显示打印窗口。报表相关属性的集合： TfrxReportOptions = class(TPersistent) //published property Author: String; //报表作者。 property CreateDate: TDateTime; //报表建立日期。 property Description: TStrings; //报表描述。 property Name: String; //报表名称。 property LastChange: TDateTime; //报表最后修改日期。 property Password: String; //报表密码。假如该属性不为空白，当打开报表定义档时需要输入密码。 property Picture: TPicture; //报表图片。 property SilentMode: Boolean default False; //无声 (Silent)方式。所有的错误信息将被保存在

“TfrxReport.Errors” 属性，而不会在屏幕上显示任何信息。 property VersionBuild: String; property VersionMajor: String; property VersionMinor: String; property VersionRelease: String; //以上 4个属性决定报表版本的属性。 TfrxReport 组件事件 property OnAfterPrint: TfrxAfterPrintEvent; //发生在处理完每个报表组件之后（打印后）。 property OnBeforePrint: TfrxBeforePrintEvent; //发生在处理完每个报表组件之前（打印前）。 property OnClickObject: TfrxClickObjectEvent; //当预览一份报表时，选取报表内的组件时触发该事

件。 property OnGetValue: TfrxGetValueEvent; //当启动一份报表，发现未定义的变量时，该事件必须返

回变量的值。 property OnManualBuild: TfrxManualBuildEvent; //当开始打印报表，假如此事件被启动，然后

FastReport 的引擎将被阻断(不处理)，报表处理方法将交由程序员所写的程序处理。 property OnMouseOverObject: TfrxMouseOverObjectEvent; //当报表处于浏览窗口，且鼠标指针移到

该组件上时触发此事件。 property OnUserFunction: TfrxUserFunctionEvent; //当执行报表的过程中，当调用的函数不存在，请

使用“AddFunction” 方法提供自定义函数。 2、TfrxDesigner TfrxDesigner 组件是报表设计器，当使用此组件，你的工程文件就可以使用报表设计器，此组件

它只包含一些报表设计器的设定，当加入”frxDesign” 单元到 uses 清单中，就表明与报表设计器连接上了。此组件包含下列的属性：

property CloseQuery: Boolean default True; //定义结束设计报表是否询问储存报表。



第 45页/共 301页

property OpenDir: String; //打开报表的默认数据目录。 property SaveDir: String; //储存报表的默认数据目录。 property Restrictions: TfrxDesignerRestrictions; //报表设计环境下，限制不同的报表操作标识，此标

识包含单一或混合数据值： drDontInsertObject为禁止插入组件 drDontDeletePage为禁止刪除页面 drDontCreatePage为禁止建立新的页面 drDontChangePageOptions为禁止修改页面属性 drDontCreateReport为禁止建立新报表 drDontLoadReport为禁止载入报表 drDontSaveReport为禁止储存报表 drDontPreviewReport为禁止预览报表 drDontEditVariables为禁止编辑变量 drDontChangeReportOptions为禁止修改报表属性 property OnLoadReport: TfrxLoadReportEvent; TfrxLoadReportEvent = function(Report: TfrxReport): Boolean of object; //此事件发生在载入报表之

时。利用此事件，你可以从数据库载入报表。 property OnSaveReport: TfrxSaveReportEvent;TfrxSaveReportEvent = function(Report:

TfrxReport;SaveAs:Boolean): Boolean of object; //此事件发生在储存报表之时。利用此事件，你可以将报表储存于数据库中。

property OnShow: TNotifyEvent; //此事件发生在启动报表设计环境时。 3、TfrxPreview 此组件专供建立自定义报表合预览窗口使用。 procedure AddPage; //加入空白页面到报表末端。 procedure DeletePage; //删除当前页。 procedure Print; //打印报表。 procedure LoadFromFile; //显示文件载入窗口。 procedure LoadFromFile(FileName: String); //载入指定的文件。 procedure SaveToFile; //显示文件储存窗口。 procedure SaveToFile(FileName: String); //储存文件到指定的文件名称。 procedure Edit; //载入当前页至设计模式供编辑使用。 procedure Export(Filter: TfrxCustomExportFilter); //使用指定的导出过滤器导出报表。 procedure First; //第一页。 procedure Next; //下一页。 procedure Prior; //上一页。 procedure Last; //最后一页。 procedure PageSetupDlg; //显示页面设定窗口。 procedure Find; //显示文字搜寻窗口。 procedure FindNext; //继续找下一个。 procedure Cancel; //取消创建报表。 procedure Clear; //清除报表。属性如下： property PageCount: Integer readonly; //报表页数。 property PageNo: Integer; //目前报表页码(起始值为 1)。要移至其它页面，指定此属性的值即可。



第 46页/共 301页

property Tool: TfrxPreviewTool; //选取工具。 property Zoom: Extended; //显示比例，“1” 代表 100% 。 property ZoomMode: TfrxZoomMode; //显示模式，可以的显示模式如下： zmDefault为默认值，显示比例根据“Zoom” 属性而定 zmWholePage为整页模式 zmPageWidth为与页面宽度相同 zmManyPages为一屏显示多页 property OutlineVisible: Boolean; //是否显示报表大纲(树状结构)。 property OnPageChanged: TfrxPageChangedEvent; //目前页面要改变时，此事件将被触发。 4、TfrxBarcodeObject 5、TfrxOLEObject 6、TfrxChartObject 7、TfrxRichObject 8、TfrxCrossObject 9、TfrxCheckBoxObject 10、TfrxGradientObject 4到 10组件说明：可在报表内部使用的组件，这些组件自己没做任何事情，它们会自动将组件的

单元加入 uses 清单，加入你打算打开一份报表，此功能会自动被加入报表，未包括此组件至工程文件的话，打开报表时将会发生错误。

11、TfrxDialogContols 附加项(add-in) 组件的集合，可用于报表内的对话窗口，它包含下列组件：button,edit box, list box

等。此组件自己不会执行任何事，加入此组件“frxDCtrl”将会自动加入“Uses”清单。 12、TfrxBDEComponents BDE 数据库组件，数据库界面采用 BDE(Borland Database Engine)时，工程文件必须加入此组件。 13、TfrxADOComponents ADO 数据库组件，数据库连接采用 ADO(Advance Data Object)时，工程文件必须加入此组件。 14、TfrxIBXComponents Interbase 数据库组件，数据库采用 IBX 连接 Interbase 后台数据库时，工程文件必须加入此组件。上述数据库组件，可被使用在报表的对话窗口上，它包括下列的组件： “Database”,“Table” 及

“Query” 。这些组件本身并不做任何事；它们只会将组件隶属的单元自动加入 uses 清单中。简单范例 1、存取报表报表定义表格与工程文件的表格储存在同一个文件(.DFM)，在大部分的情況下，并不需要额外的

操作步骤，因此载入报表便相当简单。假如你要将报表储存在文件或数据库的 BLOB 字段，你必须使用“TfrxReport”提供的方法来载入及储存报表。

function LoadFromFile(const FileName: String;ExceptionIfNotFound: Boolean = False): Boolean; 载入指定的报表，假如第二个参数的值等于”True ” 且指定的文件不存在，然后它会产生一个例外。

假如文件载入成功，它返回“True”。 procedure LoadFromStream(Stream: TStream); //从数据流(stream)载入报表。 procedure SaveToFile(const FileName: String); //储存报表至指定的文件名。 procedure SaveToStream(Stream: TStream); //储存报表至数据流(stream) 。报表默认的后缀名称为“fr3”。范例： frxReport1.LoadFromFile('d:\temp.fr3');



第 47页/共 301页

frxReport1.SaveToFile('d:\end.fr3'); Designing a report 设计报表通过“TfrxReport.DesignReport”方法调用报表设计器(reportdesigner)，要具有设计报表的功能，你必

须在工程文件中加入 “TfrxDesigner” 组件，或在 uses 加入 “frxDesgn” 单元。范例：frxReport1.DesignReport;

2、执行报表应用下列两个“TfrxReport”组件的方法启动报表： procedure ShowReport(ClearLastReport: Boolean = True); 启动报表并显示结果在浏览窗口。假如“ClearLastReport”参数等于“False”，然后报表将会清前一份

报表的末端，否则前一份报表的内容将会被清除。 function PrepareReport(ClearLastReport: Boolean = True):Boolean; 启动报表，但不开启预览窗口，参数用法同“ShowReport”方法，假如报表建立成功，它返回“True”。在大部分的情況下，采用第一种方法比较方便，当报表建立的过程中，它会立刻显示预览窗口。

当我们要把报表加入上一份报表的后面时，“ClearLastReport”参数是非常方便的技巧在批次报表打印时特别有效)。范例：

frxReport1.ShowReport; 3、预览报表在报表预览窗口显示报表有两种方式：不管是调用“TfrxReport.ShowReport”方法(前面已提及)或使

用“TfrxReport.ShowPreparedReport”方法。在第二种状况，报表创建的过程不会执行，但是报表的结果会显示于屏幕。这个意思是说，你应该使用“PrepareReport”方法创建报表或载入先前已经建立的报表。范例：

if frxReport1.PrepareReport then frxReport1.ShowPreparedReport; 在这个案例中，报表创建完成在先，然后显示报表于浏览窗口。创建大型的报表可能耗费许多时

间，那也是为什么使用“ShowReport”方法会比“PrepareReport/ShowPreparedReport” 来的好的原因，我们指定“TfrxReport.PreviewOptions” 属性，指定预览的参数。

4、打印报表在大部份的情況，你会从预览窗口打印报表。要手动打印报表，你应该使用“TfrxReport.Print”方法，

例如： frxReport1.Print; 在此同时，你可以设定打印对话窗口的参数。你可以从“TfrxReport.PrintOptions”属性指定打印的默

认值及取消显示打印窗口。 5、存取已完成的报表它可以从预览窗口执行，这也可以手动的用“TfrxReport.PreviewPages”方法执行： function LoadFromFile(const FileName: String; ExceptionIfNotFound: Boolean = False): Boolean; procedure SaveToFile(const FileName: String); procedure LoadFromStream(Stream: TStream); procedure SaveToStream(Stream: TStream); 指定参数与 TfrxReport 对应的方法类似，报表文件后缀名必须是”fp3” 。例如： frxReport1.PreviewPages.LoadFromFile('c:\1.fp3'); frxReport1.ShowPreparedReport; 注：当已完成报表载入后，预览报表必须通过 “ShowPreparedReport”方法来执行。 6、导出报表



第 48页/共 301页

它可从预览窗口执行，此项功能也可以用“TfrxReport.Export”方法来执行，在此方法的参数中，你必须指定要使用的导出过滤组件：例如：

frxReport1.Export(frxHTMLExport1); //导出过滤组件必须是可用的（你必须将它放入工程文件的表单上）且设定正确。

7、建立自定义预览窗口 FastReport 显示报表于标准的预览窗口。假如为了某种理由它无法满足你，你可以使用自定义的

预览窗口。为此，FastReport 的“TfrxPreview” 组件于是诞生了，要显示报表，这个组件必须连接到“TfrxReport.Preview”属性。

8、建立复合，报表批量打印在某些情况下，我们必须一次打印数份报表，或封装及实现多份报表于同一个预览窗口。要执行

这项工作，在 FastReport 中有多个工具，允许建立一份新的报表，置于另一份已存在的报表末端，TfrxReport.PrepareReport方法有此 ClearLastReport是否为 True，此参数定义是否清除前一份已建立的报表。下列的程序码示范如何从两个报表定义文件，批次建立一份报表：

frxReport1.LoadFromFile('1.fr3');//载入模板文件 1.fr3 frxReport1.PrepareReport;//清除现有报表内容，生成 1.fr3报表数据但不显示 frxReport1.LoadFromFile('2.fr3'); //载入模板文件 2.fr3 frxReport1.PrepareReport(False);//生成 2.fr3报表数据但不清除上一次生成的 1.fr3报表内容 frxReport1.ShowPreparedReport;//显示生成的报表（第二份报表会接在第一份报表后面）我们载入第一个报表并在后台处理报表(不显示)，然后我们载入第二份报表到同一 TfrxReport 组

件，并置参数 ClearLastReport 的值为 False建立报表。此功能允许第二份报表的结果接在第一份报表的后面。最后，我们将两份报表显示在同一个预览窗口中。

9、复合报表中的页数你可以使用 Page, Page#, TotalPages 及 TotalPages# 系统变量显示页码或总页数。在复合式报表，

这些变量代表的意义如下： Page -目前报表的页码 Page# -批次报表的页码 TotalPages -目前报表的总页数(报表必须设定为 two-pass) TotalPages# -批次报表的总页数 Combination of pages in a composite report 复合报表的合并页如上所述，当打印时，报表设计的属性 PrintOnPreviousPage可以利用前一页的可用空间打印下一

页的内容。在复合报表中，它允许你在前一份报表最后一页的可用空间上建立一份新的报表，要执行

此功能，必须在每一份连续报表的第一个设计页面启动属性 PrintOnPreviousPage。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．3 IntraWeb数据库报表解决方案之二作者：高勇


第 49页/共 301页

3．3 IntraWeb数据库报表解决方案之二 ———用 FastReport + ActiveX控件实现服务器端报表

经过很长的思考，终于想试一下用 ActiveX 控件来实现我们的网络报表，只是这种控件很多用户

都不喜欢，但如果不介意的话，这是一种很好的报表解决方案。先说一下应用环境：所有代码在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15+ FastReport v3.20下调

试通过。我的思路是这样的：（所有源代码在文件夹 3. 3中） 1、利用 FastReport报表控件制作报表模板文件，将报表模板文件存放在程序根目录下的 files目

录中，此处将报表模板文件为 report1.fr3。 2、利用 FastReport的相关组件将我们的数据在服务器上报表成一个临时文件 temp.fp3，将这所

有的临时文件存放在 files目录中的一个唯一的文件夹中（每一个用户 UserSession一开始使用时就生成一个绝对不会与别人相同的文件夹，UserSession结束时就删除这个刚刚建立的文件夹），这样就保证了不同用户调用报表时只能自己调用自己生成的数据报表。

3、将此文件 temp.fp3加密编码为字符串，再加入必要的代码生成一个网页文件 temp.htm，这个文件中我们保存了 temp.fp3的加密编码，并加入了 ActiveX控件代码。生成 temp.htm文件后我们让程序马上删除 temp.fp3文件。

4、为将在服务器上生成的临时文件 temp.htm 报表发送到客户端，我们将为这个临时文件给定一个 URL地址在新窗口中打开，这样就实现了在客户端查看，打印报表的功能。

5、通过这个 ActiveX 控件报表格式可以被转换成 PDF，RTF（WORD 格式），HTML（网页），XLS（EXCEL文件），bmp,jpg,tif 等。经检测，用 FastReport3制作报表模板时，有中文的字段请将字体改为中文字体，字符集请选择 CHINESE_GB2312，否则格式转换时，RTF和 PDF会出现乱码。

Files目录下的 Fr3ocx.ocx是我们要使用的 ActiveX控件，report1.fr3为利用 FastReport报表控件制作报表模板文件，data.mdb 为本程序所使用的数据库。应用这种解决方案时，记得一定要将Fr3ocx.ocx放在 Files目录下。下面我们就动手试一下。像 2．1所介绍的那样，新建一个 IntraWeb工程 RaveDemo.dpr。请安装好 FastReport3.09控件

后打开源代码自己看。(在文件夹 3.3中) 图 3-14是所有的控件布局情况。相信大家一看源代码就清楚了。我对关键代码作一下说明。

图 3-14 程序控件布局



第 50页/共 301页

1、unit ServerController的代码和 3.2的完全一样，大家请参考 3.2的相关说明。 2、以下为 Unit1的完整代码：

unit Unit1; interface uses//记得要在这里加入 Zlib ，EncdDecd SysUtils,IWAppForm,IWApplication,IWBaseHTMLControl, frxClass, frxDBSet, ADODB, IWHTMLControls,Zlib,EncdDecd,DB, IWDBStdCtrls, IWCompButton, IWGrids, IWDBGrids, Classes, Controls,IWVCLBaseControl, IWBaseControl, IWControl; type TIWForm1 = class(TIWAppForm) IWButton1: TIWButton; IWDBGrid1: TIWDBGrid; IWDBNavigator1: TIWDBNavigator; RepQuerySource: TDataSource; RepQuery: TADOQuery; frxDBDataset1: TfrxDBDataset; frxReport1: TfrxReport; procedure IWButton1Click(Sender: TObject); procedure IWAppFormCreate(Sender: TObject); public end; implementation {$R *.dfm} uses ServerController, IWGlobal; // CompressAndEncode为编码函数，对字串压缩并加密，以下两个函数请放在最前面，回为后面要调用它 function CompressAndEncode(const input: string): string; var fCompressedStream: TMemoryStream; fStreamCompressor: TCompressionStream; fStringStream: TStringStream; begin fCompressedStream := TMemoryStream.Create; try fStreamCompressor := TCompressionStream.Create(clDefault, fCompressedStream); try fStreamCompressor.Write(input[1], length(input)); finally FreeAndNil(fStreamCompressor); end;

第 51页/共 301页

fStringStream := TStringStream.Create(''); try fCompressedStream.Position := 0; EncodeStream(fCompressedStream, fStringStream); Result := fStringStream.datastring; finally FreeAndNil(fStringStream); end; finally FreeAndNil(fCompressedStream); end; end; // BianMa为读取一个文件并进行编码的函数，目的是将我们的已经准备好的报表文件 temp.fp3变成字符串，这样好“组装”到我们要生成的网页文件 temp.htm中 function BianMa(nfilename: string): string; var MyFileStream: TFileStream; Buffer: string; begin try MyFileStream := TFileStream.Create(nfilename, fmOpenRead); SetLength(Buffer, MyFileStream.Size); MyFileStream.Read(Buffer[1], MyFileStream.Size); Buffer := CompressAndEncode(Buffer); //得到编码后的字符串 finally MyFileStream.Free; //eventually end; if Buffer <> '' then Result := Buffer else Result := 'No Data'; end; //以下为按下“报表”按钮后的运行代码 procedure TIWForm1.IWButton1Click(Sender: TObject); var LFile, ss, tt, sfile: string; LOptions: string; LWindowName: string; LURL: string; Temp: TStringList; begin LFile := 'temp.htm';//我们要生成的报表网页文件 sfile := WebApplication.ApplicationPath + 'files\' + WebApplication.AppID + '\temp.fp3';//在服务器

第 52页/共 301页

上生成的含数据的报表所保存的文件 ForceDirectories(sysutils.ExtractFilePath(sfile));//强制生成临时的唯一目录 //----------- ss := ''; frxReport1.Clear;//清除 frxReport1前一次报表内容 frxReport1.LoadFromFile(WebApplication.ApplicationPath + 'files\report1.fr3');// frxReport1导入报表模板文件 report1.fr3 frxReport1.ShowProgress := false;// frxReport1不要显示报表进程条 frxReport1.PrepareReport;// frxReport1准备报表的数据 frxReport1.PreviewPages.SaveToFile(sfile);// frxReport1将报表保存成文件 temp.fp3 if fileexists(sfile) then//如果 temp.fp3文件存在 begin ss := BianMa(sfile);// 将准备好的数据报表文件 temp.fp3进行编码为 ss字符串 deletefile(sfile);//删除文件 temp.fp3 end else ss := 'No Data'; //----------- //以下我们将“组装”一个网页文件 temp.htm，直接在 IE中浏览此文件客户端就可以看到报表 tt := '<html><head> <title>报表预览</title>' + '<META NAME="Author" CONTENT=""> ' + '<META NAME="Keywords" CONTENT=""> ' + '<META NAME="Description" CONTENT=""> ' + '<style type="TEXT/CSS">body { font-family: 宋体, Arial; font-size: 10.2pt; background-color: #FFFFFF;' + ' margin-left: 0; margin-top: 0 }</style></head>' + '<body style="margin:0 "><textarea id=''RMVIEWER_DATA'' style=''display:none''>'; tt := tt + ss;//将我们准备好的 ss字符串加入其中 tt := tt + '</textarea><table border="0" width="100%" height="100%"><tr><td width="100%">' + '<OBJECT' + ' id=ufo name=ufo' + ' classid=''clsid:AE0C8E65-C847-11D6-BE31-00E04CEF42D5''' + ' codebase=''../Fr3ocx.ocx#version=1,0,0,0''' + ' width=100%' + ' height=100%>' + ' </OBJECT>' + ' <SCRIPT language=VBScript>' + ' document.all("ufo").pone=document.all("RMVIEWER_DATA").value</Script>' + ' </td> </tr></table></body></html>'; //以上其余的 HTML元素请不要更改，Fr3ocx.ocx为我们要用的 ActiveX控件，名称请不要更改 temp:=TStringList.Create;



第 53页/共 301页

temp.Clear; temp.Add(tt); temp.SaveToFile(WebApplication.ApplicationPath + 'files\' + WebApplication.AppID +'\' + LFile); temp.Free; //以上代码为将我们“组装”的字符串保存成一个网页文件 temp.htm //以下为将报表发送到客户端 //窗口名称 LWindowName := '报表预览'; //是否有滚动条，IE窗口的长和宽 ,可以为空字符串，如果为空则窗口这完整的 IE窗口。 //LOptions := 'scrollbars=yes,width=800,height=600'; LOptions :=''; //给出在服务器上生成的报表的 URL地址 LURL := WebApplication.AppURLBase + '/FilesNC/' + WebApplication.AppID + '/' + LFile; //打开一个新 IE窗口，将报表展现出来 AddToInitProc('NewWindow("' + LURL + '", "' + LWindowName + '","' + LOptions + '");'); end; end; procedure TIWForm1.IWAppFormCreate(Sender: TObject);//动态连接数据库，并打开 RepQuery查询 begin RepQuery.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + WebApplication.ApplicationPath + 'files\data.mdb;Persist Security Info=False'; RepQuery.Open; end; initialization TIWForm1.SetAsMainForm;//将此窗口设为主页面 end. 因为在 IE中浏览文件 temp.htm时，其中含有 ActiveX控件，所以 IE的相关设置要更改一下，让

IE 允许下载未签名的 ActiveX 控件，安装好我们的“Fr3ocx.ocx”ActiveX 控件后再改回来。如图 3-15所示：



第 54页/共 301页

图 3-15 更改 IE相关安全设置

图 3-16 为在 IE中浏览 temp.htm时的报表打开界面：

图 3-16 报表打开界面补充说明：RaveDemoDLL.dpr 为生成 dll 版本的工程文件。要用 IIS发布生才能查看。所有代码

在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15+ FastReport v3.20下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．4 在 IntraWeb中轻松实现通用的 HTML文本编辑器作者：高勇


第 55页/共 301页

3．4 在 IntraWeb中轻松实现通用的 HTML文本编辑器看到网上论坛中的 HTML文本编辑器，很是喜欢，可我用的是 IntraWeb，它自己又没有带这样的

控件，在好奇心的驱动下，我决定自己亲手试一下。经过不懈的努力，已基本实现当初的梦想，现与

朋友们共享。想法和资料有一些是来自网上，找不到作者，在此默默谢过。所有源代码在文件夹 3.4中，其中，3.4\files文件夹中的 images文件夹是我们要使用的基本素材，

我们就靠它来实现我们的 HTML文本编辑器，如果愿意的话，就把它当成一个控件吧。看一下运行效果先：(图 3-17)

图 3-17运行效果下面请看我们的实现过程：像以前一样新建一个 IntraWeb工程，命名为 Project1.dpr。请打开源代码自己对照来看。以下是关键步骤： 1、将我们的“控件”放到 files文件夹中（将 images文件夹拷贝到 files文件夹下），不要改变其中任

何内容，这是必要条件。请看 Unit1单元： 2、将一 TIWMemo 控件放在该页面上，并命名为 IWMemo110（切记一定要是这个名字），将其

拉伸到最小，放到其它可视控件的后面，这里是放在 IWRectangle1控件的后面，移动 IWRectangle1控件即可看到。切记一定要放在可视控件的后面，这样做是为了在程序运行时不被用户看到。如果它

在其它可视控件的前面，请在 IWMemo110上点击右键，选择 Control下的 Send to Back即可。 3、将一 IWRectangle控件放在页面上，这里面将放置我们的 HTML多功能编辑器，它的宽度为程



第 56页/共 301页

序运行时的实际宽度 4、编写如下函数：（导入 HTML多功能编辑器的代码）当页面生成时运行时下代码：

procedure TIWForm1.IWAppFormCreate(Sender: TObject); var AText:TStringList; AFile:String; Begin //找到“控件”中的 edithtml.htm文件。WebApplication.ApplicationPath为主程序所在根目录 AFile:=WebApplication.ApplicationPath+'files/images/post/edithtml.htm'; //如果文件存在，则将其内容导入到 AText，再将 AText.Text的值赋予 IWRectangle1.Text，这样，程序运行时就会在 IWRectangle1中显示我们的 HTML文本编辑器 if FileExists(AFile) then begin AText:=TStringList.Create; AText.LoadFromFile(AFile); IWRectangle1.Text:=AText.Text; AText.Free;//释放临时创建的 AText变量 end; end; 提交按钮的实现代码： 5、在窗口中放置一个提交用的按钮 IWButton1，其 TIWScriptEvents中的属性 onMouseDown中

加入如下代码：(图 3-18) Dvbbs_CopyData('Body'); return Checkpostdata();

图 3-18 onMouseDown中加入代码

6、程序中对 IWMemo110.text的操作就是对 HTML多功能编辑器中的内容的 HTML代码的操作，将 IWMemo110.text内容保存在数据库中，也就是 HTML多功能编辑器中所显示的内容的 HTML代码



第 57页/共 301页

被保存在数据库中了。以下是点击提交按钮后的对 IWMemo110.tex的示例操作： procedure TIWForm1.IWButton1Click(Sender: TObject); begin //显示多功能编辑器中的内容的 HTML代码，这只是为了验证我们的程序

webapplication.ShowMessage(IWMemo110.Text); //将 IWMemo110.Text中的内容用 IWRectangle2控件输出，程序运行时就会看到 HTML多功能编

辑器中所显示的内容 IWRectangle2.Text:=IWMemo110.Text; end; 由于 images文件夹中的内容基本不用修改，其中的内容就不作过多讲述，有兴趣的请自行审查，

谢谢。这个例子没有自动绑定本机 IP，大家可以采用 3.2 中的方法，在 ServerController 单元中加入

LocalIP 函数，并进行相应的赋值操作。这样如果本机有网络的话，其地址就可以被其它机器访问，大家可以在其它机器中看到运行效果，应该是和本机一样的。补充说明： 1、如果一定要改变 IWMemo控件的名字，不想用 IWMemo110这个名字，例如改为 IWMemook,

就要麻烦你在 images 文件夹中找到 edithtml.htm 和 DhtmlEdit1.js，将其中的 IWMEMO110 替换成IWMEMOOK(一定要全部大写)。再次调试程序时请在 IE 的 internet 选项中删除 internet 临时文件。否则调试会出错。

2、如果要限制输入文字的多少，请在 images文件夹中找到 edithtml.htm修改第 4句： MaxConlength=1624000000;数字即为文字的数量，当然，不是很精确，只是个大概。这里默认数

字很大，目的是不限制字数。 3、同样，Project_dll.dpr 为生成 dll 版本的工程文件。要用 IIS 发布生才能查看。所有代码在

WinXPSP2+Dlphi7.0 +IntraWeb9.0.15下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．5 让超级链接变成可向服务器传递参数的按钮作者：高勇


第 58页/共 301页

3．5 让超级链接变成可向服务器传递参数的按钮一般超级链接都是用来打开一个新的页面。超级链接可以表示为图片或文字，比一般的按钮漂亮。

所以，如果可以利用超级链接来做按钮应该很实用。这一节我们来讨论一下怎样让超级链接变成可传

递参数的按钮？所有源代码在文件夹 3.5中，其中，3.5\templates文件夹中的 IWForm1.html是我们主页面的模板。

看一下运行效果先：(图 3-19)

图 3-19 超级链接向服务器提交的数据

我先解释一下原理：分三步完成这个任务： 1、产生超级链接。让超级链接指向空链接，再给它加入一个事件。代码类似如下：<a href="#none"

onclick="return SubmitClickConfirm('@a','@b_@c', true, '@d');">@e</a>，其中，参数@a为窗口中的 TIWDBGrid控件的控件名，我们这里为 ComGrid；@b为一个整数，是 TIWDBGrid控件的行号；参数@c 为向服务器提交的数据，为一个字符串；参数@d 可以为空，如果不为空，则点击链接时会出现一个警告对话框，提示内容为字符串@d；参数@e为显示在页面上的超级链接内容。例如 1：<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_喜剧片', true, '');">喜

剧片</a> ，这表明这个链接是 ComGrid的索引号为 1(即第二行)的行的 onclick事件来响应，传递的参数为“喜剧片”三个字，没有警告提示。例如 2：<a href="#none" onclick="return SubmitClickConfirm('ComGrid','0_提交的数据 0', true, '

确认提交吗？');">超级链接 0</a>，这表明这个链接是ComGrid的索引号为 0(即第一行)的行的 onclick事件来响应，传递的参数为“提交的数据 0”，有警告提示：确认提交吗？当点击“确定”时继续执行，点击”取消”时退出执行。

2、在窗口中放入一个 TIWDBGrid控件，并新建与参数@b相对应的行。 3、为该行编写其 onclick事件代码，它将响应参数@b为此行的索引的超级链接，AValue的值即

为参数@c的值。这样，客户端就将数据传递到了服务器中。请看具体实现过程：模板内容如图 3-20所示：

第 59页/共 301页

图 3-20 模板设计时界面

模板上蓝色的部分是一些超级链接，其相应的源代码如下： <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_喜剧片', true, '');">喜剧片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_恐怖片', true, '');">恐怖片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_动作片', true, '');">动作片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_科幻片', true, '');">科幻片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_惊险片', true, '');">惊险片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_伦理片', true, '');">伦理片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_故事片', true, '');">故事片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_成人片', true, '');">成人片</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_电视剧', true, '');">电视剧</a> <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_其它', true, '');">其它片</a> 程序设计时主界面如图 3-21所示：

图 3-21 程序设计时主界面

在窗口中放入了 4个 TIWRectangle控件，目的是为了输出 4个超级链接，相应代码台下： procedure TIWForm1.IWAppFormCreate(Sender: TObject); begin IWRectangle1.Text:='<a href="#none" onclick="return SubmitClickConfirm(''ComGrid'',''0_提

交的数据 0'', true, ''确认提交吗？'');">超级链接 0</a>'; IWRectangle2.Text:='<a href="#none" onclick="return SubmitClickConfirm(''ComGrid'',''1_提

交的数据 A1'', true, ''一定要提交吗？'');">超级链接 10</a>'; IWRectangle3.Text:='<a href="#none" onclick="return SubmitClickConfirm(''ComGrid'',''1_提

交的数据 A2'', true, ''可以提交了吗？'');">超级链接 11</a>';

第 60页/共 301页

IWRectangle4.Text:='<a href="#none" onclick="return SubmitClickConfirm(''ComGrid'',''2_提交的数据 1'', true, ''提交吗？提交后不能修改!'');">超级链接 1</a>';

end; 在窗口中加入了一个 TIWDBGrid控件，我们将它改名为 ComGrid，visible属性改为 false。点击

Columns属性右边的按钮，如图 3-22所示：

图 3-22 程序设计时主界面

新建三个行 (TIWDBGridColumn)，分别为 ComGridColumns [0]，ComGridColumns [1]，ComGridColumns [2]。他们的 OnClick函数分别如下：(AValue中保存着超级链接传递来的数据)

procedure TIWForm1.IWDBGrid1Columns0Click(ASender: TObject;const AValue: String); begin // 响应超级链接 0的点击，因为该行的索引为 0 self.WebApplication.ShowMessage('超级链接 0向服务器提交的数据为:'+AValue); self.WebApplication.ShowMessage('超级链接源代码为:'+IWRectangle1.Text); end; procedure TIWForm1.ComGridColumns1Click(ASender: TObject;const AValue: String); begin // 响应超级链接 10和超级链接 11的点击，因为该行的索引为 1 if AValue='提交的数据 A1' then begin self.WebApplication.ShowMessage('超级链接 10向服务器提交的数据为:'+AValue); self.WebApplication.ShowMessage('超级链接源代码为:'+IWRectangle2.Text); exit; end; if AValue='提交的数据 A2' then begin self.WebApplication.ShowMessage('超级链接 11向服务器提交的数据为:'+AValue); self.WebApplication.ShowMessage('超级链接源代码为:'+IWRectangle3.Text);



第 61页/共 301页

exit; end; // 响应模板内的超级链接的点击 (各种影片的链接)，因为该行的索引为 1 self.WebApplication.ShowMessage('您提交的数据为:'+AValue); end; procedure TIWForm1.ComGridColumns2Click(ASender: TObject;const AValue: String); begin // 响应超级链接 1的点击，因为该行的索引为 2 if AValue='提交的数据 1' then begin self.WebApplication.ShowMessage('超级链接 1向服务器提交的数据为:'+AValue); self.WebApplication.ShowMessage('超级链接源代码为:'+IWRectangle4.Text); end; end; 补充说明：

1、TIWDBGrid控件的控件名，我们这里为 ComGrid，也可以是别的任何名字，不过相应的超级链接中的名字也要改。

2、这种方式很实用，你可以组装自己需要的超级链接，通过改变传递的参数，可以实现不同的功能。

3、同样，Project_dll.dpr 为生成 dll 版本的工程文件。要用 IIS 发布生才能查看。所有代码在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．6 实现网页复杂提示信息框作者：高勇


第 62页/共 301页

3．6 实现网页复杂提示信息框当鼠标移动到网页上的按钮或链接时，能否出现一个复杂的提示信息框？为什么说是复杂呢？我

说的这种提示信息框可以包含网页的任何元素，即可以是一个完整的网页。当鼠标移动到它上面时它

会保持住，当离开时会自动消失。经过多次的试验，现在终于可以实现了。注：加粗字体请仔细查看。所有源代码在文件夹 3.6中，其中，3.6\templates文件夹中的 IWForm1.html是我们主页面的模板。

先看一下运行效果(当鼠标移动到按钮上时)：

图 3-23 程序运行界面

1、打开 Delphi 7，点击 file->new->other，在弹出对话框中选择 Intraweb选项卡，选择 Intraweb



2、在弹出对话框中点击 Ok。 3、点击 file->save，将文件分别保存为 Umain.pas，UserSessionUnit.pas，ServerController.pas，

Project1.dpr。注意，请保存同一目录下，并在该目录下新建一个文件夹 files，这是 Intraweb 程序要使用的一个很特别的文件夹，是 Intraweb 默认的资源(各种文件，图片等)存放地。将文件 tip.js 拷贝到 files目录下。(文件目录：3.6\files\tip.js)

4、在 IWForm1上放上一个 IWRectangle1控件和 IWButton1控件，他们在 IW Standard选项

第 63页/共 301页

卡上。IWButton1 控件是一个按钮控件。当鼠标移动到它上面时会显示一个信息提示框。我们借助IWRectangle1输出一些自定义的 html代码。

图 3-25 编程时主窗口

5、在 IWForm1窗口的空处点击一下，修改 IWForm1的属性如下：ExtraHeade中点击右边的…

号按钮，在对话框中输入<SCRIPT language=JavaScript src="files/tip.js"></SCRIPT>，此句的目的是将 files目录下的 tip.js文件加入到网页的头部。

图 3-26 在 ExtraHeade中加入 tip.js文件

6、在 IWForm1窗口的空处点击一下，双击 OnCreate右边的空白处，加入如下函数：

图 3-27加入 onFormCreate事件

procedure TIWForm1.IWAppFormCreate(Sender: TObject);

第 64页/共 301页

var str: string; //str为我们要显示的字符串，可以是 html代码，如果 html代码中有'，请将其替换成\'' begin str := '<table cellPadding=0 cellSpacing=0 border=0 width=600 style=\''table-layout: fixed\'' align=center><tr><td style=\''word-wrap: break-word\''>最牛的优化大师(注册版本)：' + ' <table cellSpacing=0 width=100% bgColor=#cccccc align=center><tr><td height=1></td></tr></table> <a href="files/ss.bmp" target=_blank title="点击开新窗口查看图片"><img src="files/ss.bmp" border=0 ' + ' onLoad=\''javascript:if(580<this.width)this.width=580\''></a> ' + ' ============================================== ...</td></tr></table>'; //第一种应用方式： // 函数 showTip(str,x) :期中 str前后要有单引号，x为显示框出现时的 x坐标位置，如果为-1则自动取鼠标的当前 x坐标值，x为数字 //函数 hideTip()：可以直接调用，用来隐藏显示框的 IWLink2chazaojieguo.ScriptEvents.Clear; //为 IWButton1增加一个 Script事件 onMouseMove，当鼠标经过时，执行'showTip('''+str+''',-1)' ，显示显示框 IWButton1.ScriptEvents.Add('onMouseMove').EventCode.Text := 'showTip(''' + str + ''',-1)'; //为 IWButton1增加一个 Script事件 onMouseout，当鼠标移走时，执行'hideTip()'，隐藏显示框 IWButton1.ScriptEvents.Add('onMouseout').EventCode.Text := 'hideTip()'; //第二种应用方式： //************************************************************* 直接输出 html代码如下实现 IWRectangle1.Text := ' <table width="100%" border="1">' + '<tr>' + '<td width="20%">序号：</td> ' + '<td width="80%">内容： </td> ' + '</tr> ' + '<tr> ' + '<td>1</td> ' + '<SCRIPT language=JavaScript> var temp1 ='''+str+''' </SCRIPT>' + //先要定义变量 temp1,注意每个变量名要不一样。不能直接将 str放在函数中 '<td><a onMouseMove=showTip(temp1,100); onMouseOut=hideTip(); href="files/ss.bmp" target=_blank title="">最好的优化大师(注册版本)</a> ' + '</td> ' + '</tr> ' + '</table>'; //********************************************************** end;

7、要实现这种功能，只要在相应的控件中加入两个 Script事件即可，字符串为信息提示框的 html源代码，可以用 dreamweaver 协助设计。切记如果代码中有’，请用\’’替换。别忘了在 files 目录中拷入 tip.js文件。很简单吧^_^，我可是经过了 N次的调试才搞定呀，很累，不过很有成就感。望高手不要见笑。程序发布时只要把 files、templates文件夹和 Project1.exe文件同时拷贝走就可以了(放在同一个文件夹中)。



第 65页/共 301页

8、同样，Project_dll.dpr 为生成 dll 版本的工程文件。要用 IIS 发布生才能查看。所有代码在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。以下为用 IIS发布时的运行界面。S为网站虚拟目录。

图 3-28用 IIS发布时的程序运行界面

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．7 实现网页中的目录树作者：高勇


第 66页/共 301页

3．7 实现网页中的目录树在 intraweb 实现目录树总是有点不太让人满意，远没有下图好看。经过多次的试验，现在终于

可以实现了。可以把它当作一个控件使用，files文件夹下的 dtree文件夹即是我们的“控件”。使用时请将该控件拷贝到 files目录下即可。所有源代码在文件夹 3.7中，其中，3.7\templates文件夹中的 IWForm1.html是我们主页面的模板。

先看一下运行效果：


1、打开 Delphi 7，点击 file->new->other，在弹出对话框中选择 Intraweb选项卡，选择 Intraweb


第 67页/共 301页

图 3-30 IntraWeb选项卡 2、在弹出对话框中点击 Ok。 3、点击 file->save，将文件分别保存为 Umain.pas，UserSessionUnit.pas，ServerController.pas，

Project1.dpr。注意，请保存同一目录下，并在该目录下新建一个文件夹 files，这是 Intraweb 程序要使用的一个很特别的文件夹，是 Intraweb 默认的资源(各种文件，图片等)存放地。将文件夹 dtree 拷贝到 files目录下。(文件目录：3.7\files\dtree)

4、在 IWForm1 上放上一个 dtree 控件(dtree: TIWRectangle)和 ComGrid 控件(ComGrid: TIWDBGrid;)。我们借助 dtree输出自定义的目录树的 html代码。

图 3-31 编程时主窗口

5、在 IWForm1窗口的空处点击一下，修改 IWForm1的属性如下：ExtraHeade中点击右边的…号按钮，在对话框中输入<LINK href="files\dtree\dtree.css" type=text/css rel=stylesheet>和<script type="text/javascript" src="files\dtree\dtree.js"></script>，此句的目的是将 dtree 目录下的 dtree.css和 dtree.js文件加入到网页的头部。

图 3-32 在 ExtraHeade中加入 dtree.css和 dtree.js文件

6、在 IWForm1窗口的空处点击一下，双击 OnCreate右边的空白处，加入如下函数：

图 3-33加入 onFormCreate事件

procedure TIWForm1.IWAppFormCreate(Sender: TObject); var i, j, k, m: Integer; str1, str2, str: string;

第 68页/共 301页

begin//以下 4个为算法实现的辅助变量 str1 := ''; str2 := ''; j := 0; m := 0; UserSession.Querytemp.Close; //填充目录树：数据库中的 typeid1为上一级，typeid2为下一级 UserSession.Querytemp.SQL.Clear;//以下将目录树的内容一次性选择出来并排好序 UserSession.Querytemp.SQL.Add('select * from basetype order by typeid1,typeid'); UserSession.Querytemp.Open; UserSession.Querytemp.First; dtree.Text := '';// 清空 dtree.Text是的 html代码 dtree.Text := dtree.Text + '<script type="text/javascript"><!--' +#13+ ' d = new dTree(''d'');' +

//' d.config.useIcons = false;' +//如果去掉这一名的注释，则目录树不会有文件夹图标显示 //以下为加入目录的一个节点的函数 d 是我们新建立的目录树对象，add 是加入节点的方法。

Add(id, pid, name, url)，各参数意义如下(前 3个是必需的。)

id Number 唯一标识目录树节点的一个数字。

pid Number 该节点的父节点的 id。如果为-1则为根目录

name String 该节点在网页上显示的文字。

url String 点击该节点所对应的超级链接。

title String 鼠标移动到该节点时的提示信息。

//以下一句加入根节点，显示文字为“所有内容”，超级链接为空，但点击时调用一个 javascript代码，目的是调用该网页所对应窗口的 ComGrid控件的第一行的 ComGridColumns0Click(ASender: TObject;const AValue: String)事件，且会将 All字符串传递给 Avalue参数。这在《怎样让超级链接变成可传递参数的按钮》已经有所讲解，这里不再详述。注：在 javascript代码中，\’才表示会输出一个单引号’，所以下面有很多地方有\。 ' d.add(''' + '0' + ''',''' + '-1' + ''',''' + '所有内容' + ''',''"#none" onclick = "javascript: return SubmitClickConfirm(\''ComGrid\'', \''0_'+'All'+'\'', true, \''\''); " ''); '; for i := 1 to UserSession.Querytemp.RecordCount do//从第一条记录开始，逐条对比。 begin j := j + 1;//j为 id号，从 1开始编号(0已经被根节点用了) str2 := UserSession.Querytemp.FieldByname('typeid1').AsString; if str1 <> str2 then//如果不等，这说明是一个新的父节点 begin str := str2;//str为节点在网页上显示的文字，即 name参数的内容 m := j;//将当前节点的 id保存在m中，如果这个节点有子节点，那么子节点的父节点 id就是m k := 0;//k为该节点的父节点 id，我们这里只有两级，所以所有父节点的父节点 id都是 0 end else//如果该节点是子节点 begin str := UserSession.Querytemp.FieldByname('typeid2').AsString;//该节点显示子节点的内容 k := m;//该子节点的父节点 id为m end;

第 69页/共 301页

//以下为加入父节点或子节点。显示文字为 str变量内容，超级链接为空，但点击时调用一个 javascript代码，目的是调用该网页所对应窗口的 ComGrid控件的第一行的 ComGridColumns0Click(ASender: TObject;const AValue: String)事件，且会将 str变量内容传递给 Avalue参数。 dtree.Text := dtree.Text + ' d.add(''' + inttostr(j) + ''',''' + inttostr(k) + ''',''' + str + ''',''"#none" onclick = "javascript: return SubmitClickConfirm(\''ComGrid\'', \''0_'+str+'\'', true, \''\''); " ''); '; UserSession.Querytemp.Next;//移动到下一条记录 str1:=str2;//更新 str1的内容 end; dtree.Text := dtree.Text + ' document.write(d);d.openTo(2,false); //--> </script></td>'; UserSession.Querytemp.Close;

7、加入 ComGrid控件的第一行的 ComGridColumns0Click事件：

图 3-34加入 ComGridColumns0Click事件

//每一链接都会调用该函数： procedure TIWForm1.ComGridColumns0Click(ASender: TObject; const AValue: String); begin WebApplication.ShowMessage('您刚才点击的是：'+AValue);//在这里可以写入任何复杂的代

码以实现你所有想实现的功能。 end; 运行效果如图：

图 3-35点击链接后调用 ComGridColumns0Click事件的结果

8、同样，Project_dll.dpr为生成 dll版本的工程文件。要用 IIS发布生才能查看。所有代码在WinXPSP2+Dlphi7.0 +IntraWeb9.0.15下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．8 用窗口继承的方法实现网页中的导航条(即每页都有的信息) 作者：高勇


第 70页/共 301页

3．8 用窗口继承的方法实现网页中的导航条(即每页都有的信息) 在 intraweb 实现导航条，我们有一种简便的方法，那就是通过窗口的继承。可以设置一个窗口

UformBase，在其中可以定义一些每页都可能用到的元素，其它的窗口从它继承即可。所有源代码在文件夹 3.8中，其中，3.8\templates\1文件夹中的 IWFormmain.html是我们主页面

IWFormmain的模板。先看一下运行效果：


图 3-37为与运行界面对应的 html模板图。在图中共有 6个 intraweb控件标记：{%DengLu%}，{%IWRegionchazhao%} ， {%messagebox1%} ， {%messagebox%} ， {%messagebox2%} ，{%messagebox5%}。

(1) {%DengLu%}是一个 TIWRegion 控件，它是一个容器，包含在里面的所有的控件可以一起被引用。在网页上指定{%DengLu%}，即可把 DengLu内的所有控件都显示在网页中。这里面可以输入用户名和密码，登录，注册，搜索和退出程序 4个按钮，一个搜索内容输入框，有三个链接，分别是打开学习资源主页，打开 BBS主页和返回首页。他们都可以传递参数的超级链接，这在前面已经详细介绍过了。正确登录后，相应的登录和注册控件的 visible属性将改为 false，这样他们就不可见了。

(2) {%IWRegionchazhao%}也是一个 TIWRegion控件。这里面有一个要查找的单词的输入框，一个查找的链接，还有查找结果，我的收藏夹和修改注册信息 3个隐藏链接，当点击查找链接找到相应的词后查找结果链接变得可见，后 2个链接正确登录后将会可见，同样他们也是可以传递参数的超级链接。

(3) {%messagebox1%}是一个 TIWRectangle控件，表现就是一个方框。往它的 text属性填写html 代码，可以在网页中显示正确的内容。我们可以利用它组装我们的 html 代码，让他在模板的相应位置显示出来。这里将从数据库中任意读取一条英语名句显示出来。{%messagebox2%}也是一样的，只是它显示的是从数据库中随机读取的一个单词。

(4) {%messagebox%}也是一个 TIWRectangle控件。他主要显示一些提示信息和相应的权限控制链接。登录后会有欢迎信息和相应的权限控制链接显示。



第 71页/共 301页

(5) {%messagebox5%}也是一个 TIWRectangle 控件。主要用来显示从数据库中读取到的版权信息。

图 3-37 与运行界面对应的 html模板图

请打开 3.8中的 exe.dpr工程文件。再打开我们的导航窗口 UFormBase.pas。所有控件如图 3-38

所示。

图 3-38 编程时导航窗口(用来被继承的窗口) 如图 3-40，通过继承 IWFormBase窗口生成主页窗口 IWFormmain。生成后保存为 Umain.pas，

窗口名称为 IWFormmain。

图 3-40 通过继承 IWFormBase窗口生成主页窗口 IWFormmain

第 72页/共 301页

在主页窗口中我们定义搜索按钮的事件代码如下： procedure TIWFormmain.SearchClick(Sender: TObject); begin inherited; UserSession.BasetableSearch := Searchedit.Text; if (WebApplication.FindComponent('IWFormbasetable') as TIWContainer) = nil then //TIWFormbasetable.Create(WebApplication).Show;//工程文件中还没有完成。 end; 记得在最后一个 end 前加上如下代码将这个窗口设定为主页面(同时去掉被继承的窗口以下代

码)： initialization TIWFormmain.SetAsMainForm; 通过这种方法实现的导航条，相当灵活实用。只需继承这个窗口，不用写一句多余的代码。代码导读 1、以下我说一下编程思路：这个继承它的窗口每次在 IE中显示时都要做如下事情：是否登录，如果没有登录，则显示登录

输入框和注册按钮，如果已经登录则根据用户的权限来显示公告信息框的欢迎信息和相应的权限控制

链接，查找登录都的收藏夹信息，如果有则显示我的收藏夹链接，并将所有收藏夹的内容用一个复杂

的网页提示框显示(前面有一节实现网页复杂提示信息框对此进行了专门讲解)，显示修改注册信息链接。再给每日一句和每日一词和版权信息三个控件的 text赋值。 procedure TIWFormBase.IWAppFormRender(Sender: TObject); procedure changeface;//判断已登录者的权限来改变相应控件的 visible属性，这该事件内部的一个过程。 begin Login.Visible := False; Reg.Visible := False; UserID.Visible := False; PASS.Visible := False; Label1.Visible := False; Label2.Visible := False; messagebox.Text := GetSpace(3) + GetHourStr + '好 ,' + UserSession.nicheng + '(' + UserSession.UserLoginName + ')';// GetSpace(3)是 ServerController内的一个公用函数，用来组装 html 代码中的空格个数，这里显示 3 个空格。GetHourStr 函数得到一天的时间段称呼。UserSession.nicheng为在 UserSession中定义的全局变量(以后所有的窗口都可以直接调用它，是一种网页之间传递参数的好方法)，在点击登录按钮时会给它赋值。UserSession.UserLoginName与前类似，记录用户名。 if UserSession.Userrole = 'admin' then//如果用户角色是管理员 begin messagebox.Text := messagebox.Text + GetLinkString('1', '管理资源目录分类', '【管理资源目录分类】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '管理 BBS分类', '【管理 BBS分类】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '系统综合设置', '【系统综合设置】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '管理用户', '【管理用户】', '', '', 'ComGrid0'); end;

第 73页/共 301页

IWLink7xiugaizhuce.Visible := True; //显示修改注册信息链接 IWLink7shucangjia.Visible := True;//显示收藏夹链接 messagebox.Text := messagebox.Text + ',如果要关闭浏览器，请先点击页面右上角的［退出程序］按钮。<hr>' + GetSpace(3) + message0; ShowShouCangJia; //显示收藏夹内容，请查看其相应的过程 end;//子过程结束 var//正式开始 IWAppFormRender事件 VLIst: TStringList; closestr: string; begin closestr := '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''');window.alert(''欢迎下次再来！'');}</script>';//此句很重要。它将每页中加入这些代码，作用是当你直接关闭 IE时会调用一个函数来主动结束该用户的 Session，从而主动释放了服务器的内存。它调用的是 ComGrid0控件的每一行的 onclick事件。 Label1.Text := '用户：'; //----------------------------------------- UserSession.Querytemp.close; //插入公告信息 UserSession.Querytemp.SQL.Clear; UserSession.Querytemp.SQL.Add('select * from settables where setid=:setid'); UserSession.Querytemp.Parameters.ParamByName('setid').Value := GY.Encrypt_text(' 公告信息 ', UserSession.mm);// GY.Encrypt_text是一个给字符加密的函数 UserSession.Querytemp.Open; if UserSession.Querytemp.RecordCount > 0 then begin message0 := GY.DeEncrypt_text(UserSession.Querytemp.FieldByname('content').Value, UserSession.mm); // GY.DeEncrypt_text是一个给字符解密的函数 end else message0 := '暂无公告。'; UserSession.Querytemp.close; //----------------------------------------- ……类似代码略 //----------------------------------------- VLIst := TStringList.Create; VLIst.LoadFromFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini'); // FilmSystem.ini文件保存了系统的相关信息 IWTemplateProcessorHTML1.Templates.Default := UserSession.Skin + '\' + WebApplication.ActiveForm.Name + '.Html'; //IWTemplateProcessorHTML1是 html模板控件，这一句是保证继承它的窗口会调用相应的模板文件。模板文件的命名规则是对应窗口的 name加.html。 if StrToBoolDef(VLIst.ValueFromIndex[1], False) then //如果支持页面特效 ExtraHeader.Text := ' <meta HTTP-EQUIV="Page-Enter" CONTENT="revealtrans(duration=0.5,

第 74页/共 301页

transition=23)"> ' + ExtraHeader.Text;//加号前是支持页面特效的代码，加号后是说我的ExtraHeader.Text本来就有的值不能丢。 VLIst.Free; //如果不是注册会员 messagebox.Text := GetSpace(3) + GetHourStr + '好,' + '请您先登录。登录后如果要关闭浏览器，请先点击页面右上角的［退出程序］按钮。<hr>' + GetSpace(3) + message0; //如果是注册会员，则改变相应控件的 visible属性。 if UserSession.IsRegUser then changeface; end;

2、登录按钮主要完成对用户的判断：是否要审核(网站新注册的可能要管理员审核)，如果要审核则不能让你登录；根据数据库的记录

判断登录者的可登录时间是否已经用完或者已经过期，不符合条件则不能登录；判断权限，根据不同

的权限给 UserSession 中的相应变量赋值。 UserSession.IsRegUser( 是否已注册 ) ，UserSession.UserLoginName(登录名称)，UserSession.nicheng(昵称)，UserSession.Userrole(角色即权限)，这样其它的函数就可以使用这些变量。如前面介绍的 IWAppFormRender事件。

这里的每个链接都是可以向服务器传递参数的，此种方法在前面一节已经有详细介绍。图 3-41 为登录后的窗口。公告信息(其内容生成代码

if UserSession.Userrole = 'admin' then begin messagebox.Text := messagebox.Text + GetLinkString('1', '管理资源目录分类', '【管理资源目

录分类】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '管理 BBS分类', '【管理 BBS分类】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '系统综合设置', '【系统综合设置】', '', '', 'ComGrid0') + '|' + GetLinkString('1', '管理用户', '【管理用户】', '', '', 'ComGrid0'); end;)内的管理权限链接都会调用 ComGrid0Columns1Click事件：

图 3-41 登录后的窗口

链接传递的参数由 Avalue接收。根据不同的参数调用不同的窗口。 procedure TIWFormBase.ComGrid0Columns1Click(ASender: TObject; const AValue: string); begin if AValue = '管理资源目录分类' then begin UserSession.basetypeType1 := 'All'; UserSession.basetypeSearch := ''; if Self.WebApplication.ActiveForm.Name <> 'IWFormmain' then Free;

第 75页/共 301页

//TIWFormbasetype.Create(WebApplication).Show;//由于此窗口在工程中没有，所有注释了 end; if AValue = '管理 BBS分类' then begin UserSession.bbstypeType1 := 'All'; if Self.WebApplication.ActiveForm.Name <> 'IWFormmain' then Free; //TIWFormbbstype.Create(WebApplication).Show; //由于此窗口在工程中没有，所有注释了 end; if AValue = '管理用户' then begin UserSession.usertablesReg := 0; //表示不是注册 UserSession.usertablesmody := 0; if Self.WebApplication.ActiveForm.Name <> 'IWFormmain' then Free; //TIWFormusertables.Create(WebApplication).Show; //由于此窗口在工程中没有，所有注释了 end; if AValue = '系统综合设置' then begin //TIWFormsettablespost.Create(WebApplication).Show; //由于此窗口在工程中没有，所有注释

了 end; end; 3、查找链接中的实现代码请参考实现网页复杂提示信息框这一节的内容。 4、退出程序按钮的代码实现： procedure TIWFormBase.IWButton1Click(Sender: TObject); begin UserSession.loginout; //处理退出，将该用户标记为退出并记录上网剩余时间 WebApplication.TerminateAndRedirect('files/exit.htm');//结束该 Session并转向退出页面。 end; 5、当直接关闭 IE时会调用一个函数来主动结束该 Session。原因是 closestr := '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''');window.alert('' 欢迎下次再来！

'');}</script>'; messagebox1.Text := closestr + …… 这样，在所有继承了该窗口的网页内都有这一段代码，它会调用以下事件： procedure TIWFormBase.ComGrid0Columns0Click(ASender: TObject; const AValue: string); begin UserSession.closesessoion;//这个函数可以主动结束该 Session以释放服务器资源。 end; procedure TIWUserSession.closesessoion;//方法是关闭所有的已生成窗口，有几个就要关几个，这

第 76页/共 301页

里只有一个主界面WFormmain begin loginout;//处理退出 try if (WebApplication.FindComponent('IWFormmain') as TIWContainer) <> nil then (WebApplication.FindComponent('IWFormmain') as TIWContainer).free; except Exit; end; end; 6、IWFormBase窗口的 javascript属性如下(这样可以保证继承它的每个窗口都有)： var rate = 30; var obj; var act = 0; var elmH = 0; var elmS = 128; var elmV = 255; var clrOrg; var TimerID; if (navigator.appName.indexOf("Microsoft",0) != -1 && parseInt(navigator.appVersion) >= 4) { Browser = true; } else { Browser = false; } if (Browser) { document.onmouseover = doRainbowAnchor; document.onmouseout = stopRainbowAnchor; } function doRainbow() { if (Browser && act != 1) { act = 1; obj = event.srcElement; clrOrg = obj.style.color; TimerID = setInterval("ChangeColor()",100); } } function stopRainbow() { if (Browser && act != 0) { obj.style.color = clrOrg; clearInterval(TimerID); act = 0;



第 77页/共 301页

} } function doRainbowAnchor() { if (Browser && act != 1) { obj = event.srcElement; while (obj.tagName != 'A' && obj.tagName != 'BODY') { obj = obj.parentElement; if (obj.tagName == 'A' || obj.tagName == 'BODY') break; } if (obj.tagName == 'A' && obj.href != '') { act = 1; clrOrg = obj.style.color; TimerID = setInterval("ChangeColor()",100); } } } function stopRainbowAnchor() { if (Browser && act != 0) { if (obj.tagName == 'A') { obj.style.color = clrOrg; clearInterval(TimerID); act = 0; } } } function ChangeColor() { obj.style.color = makeColor(); } function makeColor() { if (elmS == 0) { elmR = elmV; elmG = elmV; elmB = elmV; } else { t1 = elmV; t2 = (255 - elmS) * elmV / 255; t3 = elmH % 60; t3 = (t1 - t2) * t3 / 60;

第 78页/共 301页

if (elmH < 60) { elmR = t1; elmB = t2; elmG = t2 + t3; } else if (elmH < 120) { elmG = t1; elmB = t2; elmR = t1 - t3; } else if (elmH < 180) { elmG = t1; elmR = t2; elmB = t2 + t3; } else if (elmH < 240) { elmB = t1; elmR = t2; elmG = t1 - t3; } else if (elmH < 300) { elmB = t1; elmG = t2; elmR = t2 + t3; } else if (elmH < 360) { elmR = t1; elmG = t2; elmB = t1 - t3; } else { elmR = 0; elmG = 0; elmB = 0; } } elmR = Math.floor(elmR); elmG = Math.floor(elmG); elmB = Math.floor(elmB); clrRGB = '#' + elmR.toString(16) + elmG.toString(16) + elmB.toString(16); elmH = elmH + rate; if (elmH >= 360) elmH = 0; return clrRGB; } //以上代码是实现链接当鼠标上去时的七彩闪烁效果 // Check_Search是搜索按钮的 javascript事件调用的代码，注意：控件名称要大写且在其后面要

加上 IWCL，这样才能在 javascript中调用它。 function Check_Search() { if (SEARCHEDITIWCL.value=="") { alert("请输入查询条件!"); SEARCHEDITIWCL.focus(); return false; } SubmitClickConfirm('SEARCH','', true, '');



第 79页/共 301页

} // Check_Search是登录按钮的 javascript事件调用的代码 function Check_Users() { var obj = USERIDIWCL; if (obj.value== "") { alert("用户名不能空!"); obj.focus(); return false; } var obj = PASSIWCL; if (obj.value== "") { alert("密码不能空!"); obj.focus(); return false; } SubmitClickConfirm('LOGIN','', true, ''); }

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．9 用 html模板格式化输出数据库中的数据作者：高勇


第 80页/共 301页

3．9 用 html模板格式化输出数据库中的数据在 intraweb中实现如图 3-42样式的表格，好像用控件直接实现是有一定困难的。所有源代码在文件夹 3.9中，其中，3.9\templates\1文件夹中的 IWFormmain.html是我们主页

面 IWFormmain的模板。先看一下运行效果：


图 3-43为程序的主窗口的控件布局，用两个 IWRectangle控件在页面上输出我们用程序组装出来的 html代码。newbasetable1中显示最新的几条英语文摘信息，newbasetable2中显示最新的几条教案课件信息，newbasetable1和 newbasetable2都是 TIWRectangle控件。ComGrid表格控件用来编写链接的服务器端响应事件(这种应用方式已经在让超级链接变成可向服务器传递参数的按钮这一节中讲解过了)。

图 3-43 程序的主窗口的控件布局



第 81页/共 301页

图 3-44为程序的主窗口对应的 html模板，{%newbasetable1%} 和{%newbasetable2%}分别代

表最新的几条英语文摘信息和最新的几条教案课件信息。

图 3-44 程序的主窗口对应的 html模板

我们实现的思路是这样的： TIWRectangle控件的 text属性可以接收 html代码，我们可以先建立一个 html文件，这可以用

可视开发工具实现，我们可以把它叫做皮肤文件。本例的皮肤文件放在 3.9\files\Skin\1文件夹下，文件名为 newbasetable.Html。图 3-45 即为此皮肤模板。我们可以先载入该文件的 html 代码，再用相应的数据替换皮肤中的唯一的特定标记，这样就就可实现复杂格式的页面表格显示。

图 3-45 皮肤模板

1、请修改 IWServerController内 TemplateDir属性为“templates\1\”，因为程序模板文件不在默认目录下，所以要指定。

2、自己建立了一个函数 topnew(IWRectangle,typeid1)，IWRectangle 为输出 html 代码的TIWRectangle控件名，typeid1为数据分类，这里只有“新闻”和“教案课件”两类。 procedure TIWFormmain.topnew(IWRectangle: TIWRectangle; typeid1:string); var Temp: TStringList;//用来导入皮肤的 html代码 Memo,atitle: string;//用来记录简介和标题 i,j: Integer; begin IWRectangle.Text := '';//先清空 html代码 Temp := TStringList.Create; with UserSession.Querytemp do begin Close; SQL.Clear; SQL.Add('select top 10 * from basetable where typeid1='''+typeid1+''' order by dateandtime desc'); Open; if UserSession.Querytemp.RecordCount>10 then j:=10 else j:=UserSession.Querytemp.RecordCount;//最多输出 10条记录 try for I := 1 to j do begin//循环开始



第 82页/共 301页

if Length(FieldByname('jianjie').AsString) >= 100 then//如果简介字段大于 100个字符，则显示标题加回车加简介加这 100个字符。 Memo := FieldByname('title').AsString+':'+#13+'简介：'+Copy(FieldByname('jianjie').AsString, 0, 100) + '....' else if Length(FieldByname('jianjie').AsString) > 0 then//如果没有超过 100但大于 0 Memo := FieldByname('title').AsString+':'+#13+'简介：'+FieldByname('jianjie').AsString Else//如果没有简介 Memo := FieldByname('title').AsString; if Length(FieldByname('title').AsString) >= 22 then//如果标题大于 22个，标题最多显示 22个，和了就截掉 atitle := Copy(FieldByname('title').AsString, 0, 22) + '....' else atitle := FieldByname('title').AsString; //以上是取出数据库的大字段数据进行截断处理，以下每一条记录都这样做：载入皮肤再用相应的数据替换皮肤中的特定标记 Temp.Clear;//清空上一条记录的影响 Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\newbasetable.Html');//载入皮肤的 html代码 Temp.Text := StringReplace(Temp.Text, '[typeid2]', GetLinkString('1', FieldByname('typeid2').AsString, FieldByname('typeid2').AsString, '查找该分类'), [rfReplaceAll]); // StringReplace函数在 sysutils中，大家应该都会用，在第一个参数中查找到第二个参数后用第三个参数替换掉。GetLinkString(Row, ID: string; Link: string; title: string = ''; Cof: string = ''; GridName: string = 'ComGrid'): string; 也是我们编写的一个函数，生成一个超级链接，它给服务器传递的参是 ID，在网页上显示的链接文字是 Link，当鼠标移动到链接上显示的提示信息为 title，默认为空，即没有提示信息，点击后弹出确认对话框的内容为 Cof，默认为空，即没有确认对话框，服务器上响应该链接的控件为GridName，默认为 ComGrid，本例中就有一个 ComGrid 控件，Row 即指 GridName 的第几行，从 0开始，依次对应 GridName的第 1、2、3、…的 onclick事件，该事件的 avalue参数将接收该链接所提交的 ID 值。此处替换类别，对应 ComGrid 的第二行的 onclick 事件，传递的参数是FieldByname('typeid2').AsString Temp.Text := StringReplace(Temp.Text, '[title]', GetLinkString('2', FieldByname('recordid').AsString,atitle,Memo), [rfReplaceAll]);//此处替换标题，对应 ComGrid的第 3行的 onclick事件，传递的参数是 FieldByname(' recordid ').AsString Temp.Text := StringReplace(Temp.Text, '[updatename]', GetLinkString('4', FieldByname('updatename').AsString,GY.DeEncrypt_text(FieldByname('updatename').AsString,UserSession.mm), '查看上传者详细信息'), [rfReplaceAll]);//此处替换上传者，对应 ComGrid的第 3行的 onclick事件，传递的参数是 FieldByname(' updatename ').AsString Temp.Text := StringReplace(Temp.Text, '[dateandtime]', FieldByname('dateandtime').AsString, [rfReplaceAll]); //此处替换时间 Temp.Text := StringReplace(Temp.Text, '[downloadhits]', FieldByname('downloadhits').AsString, [rfReplaceAll]); //此处替换下载次数 Temp.Text := StringReplace(Temp.Text, '[lookhits]', FieldByname('lookhits').AsString, [rfReplaceAll]); //此处替换点击次数 Temp.Text := StringReplace(Temp.Text, '[评论]', '评论+' + FieldByname('lookafters').AsString,



第 83页/共 301页

[rfReplaceAll]); //此处替换评论 Next;//转到下一条记录 IWRectangle.Text := IWRectangle.Text + Temp.Text;//累加我们组装出来的代码 end; except IWRectangle.Text := Temp.Text; end; end; Temp.Free; end;

3、在窗口的 onFormRender事件中填写如下代码： procedure TIWFormmain.IWAppFormRender(Sender: TObject);//每次显示页面时都会执行 begin topnew(newbasetable1, '新闻'); //给 newbasetable1的 text属性赋值，用 typeid1为新闻的数据显

示 topnew(newbasetable2, '教案课件'); //给 newbasetable1的 text属性赋值，用 typeid1为教案课件

的数据显示 end; 通过这种方法，任何复杂的页面形式都可以实现。用 intraweb 进行 html 代码组装和 javascript

代码组装是我们应该掌握的基本技巧，这是用最少的控件实现最为灵活的应用的必由之路。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．10 用自己的代码实现表格翻页控件作者：高勇


第 84页/共 301页

3．10 用自己的代码实现表格翻页控件如图 3-46样式的表格，我们在用 html模板格式化输出数据库中的数据这一节中讲解过了，但数

据库中有很多条记录，必然要实现翻页，下面我们就讨论一下翻页的实现。所有源代码在文件夹 3.10中，其中，3.10\templates\1文件夹中的 IWFormbasetable.html是我

们主页面 IWFormbasetable的模板，3.10\files\Skin\1\ Listbasetable.HTMl是表格的皮肤模板。先看一下运行效果：


图 3-47 为程序的主窗口的控件布局，用一个 TIWDBGrid 控件 ListGrid 在页面上输出表格中的数据内容。用一个 TIWRectangle控件 Page显示翻页链接。ComGrid表格控件用来编写链接的服务器端响应事件(这种应用方式已经在让超级链接变成可向服务器传递参数的按钮这一节中讲解过了)。

图 3-47 程序的主窗口的控件布局



第 85页/共 301页

图 3-48 为程序的主窗口对应的 html 模板，{%ListGrid%} 和{%Page%}分别显示表格中的数据

和翻页链接。

图 3-48 程序的主窗口对应的 html模板

我们实现的思路是这样的： TIWDBGrid控件 ListGrid是一个表格控件，我们定义它的列为 1(双击 columus属性，在出现的

对话框中新建一个列)，行为 5(rowlimit 属性设定为 5，这也就定义了每页的记录数为 5，当然也可以改为别的大于 0的整数)，我们将采用皮肤技术，在每一个表格的 sell(格子)中导入图 3-49中皮肤模板的 html代码，并用数据库中的数据替换其中的特定标记(这里每个都用了一对中括号)，这样可以保证表格的每一个 cell中可以显示任意复杂的子表格。

图 3-49 皮肤模板

1、请修改 IWServerController内 TemplateDir属性为“templates\1\”，因为程序模板文件不在默认目录下，所以要指定。

2、表格的数据我们在 ListGrid的 onRenderCell事件中完成(表格控件填写每一个格子时执行该事件)，完整代码如下： procedure TIWFormbasetable.ListGridRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); var Temp: TStringList;//用来导入皮肤模板 html的工具 Memo, strtemp: string; i: Integer; begin Temp := TStringList.Create;//初始化，记得用完要释放 strtemp := ''; try if ListGrid.DataSource.DataSet.IsEmpty then//如果表格控件数据源中的数据集为空则退出 exit; if (AColumn = 0) and (ARow > 0) then//如果当前格子是第一列，且表格的行数大于 0 begin with ListGrid.DataSource.DataSet do begin//开始操作表格控件数据源中的数据集 Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin +



第 86页/共 301页

'\Listbasetable.Html');//导入皮肤模板的 html代码 if Length(FieldByname('jianjie').AsString) >= 250 then//将长的简介字段截断到 250个字符并将其保存在Memo变量中 Memo := Copy(FieldByname('jianjie').AsString, 0, 250) + '....' else Memo := FieldByname('jianjie').AsString; if Memo = '' then Memo := '没有简介，请点击标题查看详细内容。'; Temp.Text := StringReplace(Temp.Text, '[typeid2]', GetLinkString('1', FieldByname('typeid2').AsString, FieldByname('typeid2').AsString, '查找该分类 '), [rfReplaceAll]); // StringReplace函数在 sysutils中，大家应该都会用，在第一个参数中查找到第二个参数后用第三个参数替换掉。GetLinkString(Row, ID: string; Link: string; title: string = ''; Cof: string = ''; GridName: string = 'ComGrid'): string; 也是我们编写的一个函数，生成一个超级链接，它给服务器传递的参是 ID，在网页上显示的链接文字是 Link，当鼠标移动到链接上显示的提示信息为 title，默认为空，即没有提示信息，点击后弹出确认对话框的内容为 Cof，默认为空，即没有确认对话框，服务器上响应该链接的控件为GridName，默认为 ComGrid，本例中就有一个 ComGrid 控件，Row 即指 GridName 的第几行，从 0开始，依次对应 GridName的第 1、2、3、…的 onclick事件，该事件的 avalue参数将接收该链接所提交的 ID 值。此处替换类别[typeid2]，对应 ComGrid 的第 2 行的 onclick 事件，传递的参数是FieldByname('typeid2').AsString，显示的链接字符为 FieldByname('typeid2').AsString，当鼠标移动到链接上显示的提示信息为“查找该分类” Temp.Text := StringReplace(Temp.Text, '[title]', GetLinkString('2', FieldByname('recordid').AsString, FieldByname('title').AsString, '查看详细内容'), [rfReplaceAll]); 此处替换标题[title]，对应 ComGrid的第 3行的 onclick事件，传递的参数是 FieldByname('recordid').AsString，显示的链接字符为 FieldByname('title').AsString，当鼠标移动到链接上显示的提示信息为“查看详细内容” if (GY.DeEncrypt_text(FieldByname('updatename').AsString, UserSession.mm) = UserSession.UserLoginName) or (UserSession.Userrole = 'admin') or (UserSession.Userrole = 'power_user') then//如果上传者是当前的登录者 UserLoginName 或者是管理员 admin或者是权力用户 power_user 才执行如下操作，以确定是否显示删除，修改和增加按钮 begin Temp.Text := StringReplace(Temp.Text, '[ 删除 ]', GetLinkString('3', FieldByname('recordid').AsString, '删除', '删除该条信息', '确认要删除吗？'), [rfReplaceAll]); 此处替换[删除]，对应 ComGrid的第 4行的 onclick事件，传递的参数是 FieldByname('recordid').AsString，显示的链接字符为“删除”，当鼠标移动到链接上显示的提示信息为“删除该条信息”，点击时有确认对话

框，显示内容是“确认要删除吗？”。以下两句类似。 Temp.Text := StringReplace(Temp.Text, '[ 修改 ]', GetLinkString('4', FieldByname('recordid').AsString, '修改', '修改该条信息', '确认要修改吗？'), [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, '[ 增加 ]', GetLinkString('6', FieldByname('recordid').AsString, '增加', '增加一条信息', '确认要增加吗？'), [rfReplaceAll]); end else//不显示权限链接 begin Temp.Text := StringReplace(Temp.Text, '[删除]', '', [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, '[修改]', '', [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, '[增加]', '', [rfReplaceAll]);



第 87页/共 301页

end; Temp.Text := StringReplace(Temp.Text, '[updatename]', GetLinkString('5', FieldByname('updatename').AsString, GY.DeEncrypt_text(FieldByname('updatename').AsString, UserSession.mm), '查看上传者详细信息'), [rfReplaceAll]); 此处替换上传者[updatename]，对应 ComGrid的第 6 行的 onclick 事件，传递的参数是 FieldByname('updatename').AsString，显示的链接字符为GY.DeEncrypt_text(FieldByname('updatename').AsString, UserSession.mm)，当鼠标移动到链接上显示的提示信息为“查看上传者详细信息” Temp.Text := StringReplace(Temp.Text, '[dateandtime]', FieldByname('dateandtime').AsString, [rfReplaceAll]); for i := 1 to FieldByname('levels').Value do//显示 levels个星星 begin strtemp := strtemp + '★'; end; Temp.Text := StringReplace(Temp.Text, '[levels]', strtemp, [rfReplaceAll]); strtemp := ''; Temp.Text := StringReplace(Temp.Text, '[downloadhits]', FieldByname('downloadhits').AsString, [rfReplaceAll]); //显示下载数 Temp.Text := StringReplace(Temp.Text, '[lookhits]', FieldByname('lookhits').AsString, [rfReplaceAll]); //显示点击数 Temp.Text := StringReplace(Temp.Text, '[评论]', '评论+' + FieldByname('lookafters').AsString, [rfReplaceAll]); //显示评论 Temp.Text := StringReplace(Temp.Text, '[jianjie]', Memo, [rfReplaceAll]); //显示相关简介 ACell.Text := Temp.Text;//将组装完毕的代码赋给表格的格子 ACell.Text end; end; except ACell.Text := Temp.Text; end; Temp.Free; end;

3、翻页控件的 html 代码我们放在 Page.Text 中。在每一次显示页面时就执行 onFormRender事件(这里要注意，我们每一次显示完页面后就关闭了数据集控件 List，所以每一次显示页面时都要再重新打开数据集)： procedure TIWFormbasetable.IWAppFormRender(Sender: TObject); begin if Pos('basetable', UserSession.List.SQL.Text) = 0 then// List是一个数据集控件，我们显示的就是它里面的数据。这里判断其 SQL 代码中是否有 basetable 字符，如果有则直接打开就行，如果没有，则执行以下代码(查询 basetable中的所有数据)： UserSession.List.SQL.Text := 'select * from basetable order by dateandtime DESC'; UserSession.List.Open;//打开数据集 UserSession.List.First; UserSession.List.MoveBy(UserSession.RecNumble);//跳到指定的记录

第 88页/共 301页

ListGrid.DataSource := UserSession.ListSource;//用代码指定表格控件 ListGrid的数据源，其使用的数据集为 List Page.Text := GetToolStr(ListGrid.DataSource.DataSet.RecNo, ListGrid.DataSource.DataSet.RecordCount, ListGrid.RowLimit, 0, 6, '条记录');//显示翻页控件，此函数后面有详细介绍。图 3-50为翻页控件效果图

图 3-50 翻页控件效果图 end;

4、翻页控件的 html代码实现函数 function GetToolStr(RecNo, RecordCount, RowLimit: Integer; GridID: Integer; Nums: Integer = 10; Captions: string = '条记录'; Grid: string = 'ComGrid'): string;各个参数的意义如下：RecNo为当前数据集的当前记录数， RecordCount为当前数据集的记录总数，RowLimit 为每页显示的记录数，GridID 为翻页控件的链接对应的服务器端响应 ComGrid 对应的行数，Nums每页显示多少页面数字，最好为偶数，默认为 10个数字， Captions为统计时的字符提示例如：共 144条记录每页 4条记录共 36页，默认为条记录，Grid为翻页控件的链接对应的服务器端响应控件名，默认为 ComGrid。 function GetToolStr(RecNo, RecordCount, RowLimit: Integer; GridID: Integer; Nums: Integer = 10; Captions: string = '条记录'; Grid: string = 'ComGrid'): string; var P: real; n, n1, n2, P1, P2: Integer; S: string; begin P := RecNo / RowLimit; P1 := Trunc(P); if Frac(P) > 0 then Inc(P1); P := RecordCount / RowLimit; P2 := Trunc(P); if Frac(P) > 0 then Inc(P2); Result := ' '; if P1 > 1 then//当前页数大于 1的话，则显示首页和上一页的链接 begin Result := Result + GetLinkStringEx(GridID, '0_1', '9', '', Grid) + GetLinkStringEx(GridID, '0_2', '7', '', Grid) + '%S'; end else//当前页数=1的话，则不显示首页和上一页的链接 begin Result := Result + '9' + '7%S'; end; if P1 <> P2 then//如果当前页数不等于总页数，是显示尾页和下一页的链接 begin Result := Result + GetLinkStringEx(GridID, '0_3', '8', '', Grid) + GetLinkStringEx(GridID, '0_4', ':', '', Grid); end else//如果当前页数等于总页数，是不显示尾页和下一页的链接

第 89页/共 301页

begin Result := Result + '8' + ':'; end;//以下显示中间的数字链接 Nums := Trunc(Nums / 2); n1 := P1 - Nums; if n1 < 1 then n1 := 1; n2 := P1 + Nums + ABS(P1 - Nums - n1) - 1; if n2 > P2 then n2 := P2; S := ' '; for n := n1 to n2 do begin if n = P1 then S := S + Format('%D ', [n]) else S := S + GetLinkStringEx(GridID, '1_' + inttostr(n), inttostr(n), '', Grid) + ' '; end; Result := Format(Result, [S]); Result := Result + '去<input id=page name="textfield" type="text" size="3">页' + '<a href="#none" onclick="ss=''0_1_''+page.value;return SubmitClickConfirm(''ComGrid'',ss, true, '''');"> Go</a>' + Format(' 共%D' + Captions + ' 每页%D' + Captions + ' 共%D页 ', [RecordCount, RowLimit, P2]); end; 以上代码调用了如下函数： function GetLinkStringEx(Row: Integer; ID, Link: string; Cof: string = ''; GridName: string = 'ComGrid'): string; begin Result := Format('<a href="#none" onclick="return SubmitClickConfirm(''%S'',''%D_%S'', true, ''%S'');">%S</a>', [GridName, Row, ID, Cof, Link]); end; //GetLinkString('0',t,temp,cof,ComGrid) 0 是对应的 ComGrid 的 0 行的 ComGridColumns0Click 命令， temp超级连接的内容，t为向服务器传递的数据，cof为确认对话框内容，ComGrid为窗口内的 ComGrid控件名

5、当点击翻页控件的链接后会执行如下代码： procedure TIWFormbasetable.ComGridColumns0Click(ASender: TObject; const AValue: string); //页面导航条的链接 begin SetPage(ListGrid, AValue, UserSession.RecNumble);//主要用来修改 UserSession.RecNumble的值，以确定要显示的当前记录。 ListGrid 为表格控件， Avalue 翻页控件的链接向服务器传递的数据，UserSession.RecNumble指明数据集当前记录为第几条记录，在每次页面显示完后会被记录，在如下事件中完成。 procedure TIWFormbasetable.IWAppFormAfterRender(Sender: TObject); //页面输出完毕后关闭数据集 begin UserSession.RecNumble := UserSession.List.RecNo; //记录当前记录号，当页面只刷新时可以保持不变

第 90页/共 301页

UserSession.List.close;//关闭表格控件所使用的数据集，节约服务器系统资源 end; end; 以下函数的作用是：根据当前记录号 RecNumble和翻页控件传递的页数数据计算应该跳转到指定的页的当前记录数，并把此值赋给 UserSession.RecNumble。 procedure SetPage(Grid: TIWDBGrid; AValue: string; RecNumble: Integer); var n1, n2: Integer; begin try n1 := Strtoint(Copy(AValue, 1, 1)); if Copy(AValue, 3, 20) = '' then begin n2 := 1; WebApplication.ShowMessage('填写正确的页码！'); end else n2 := Strtoint(Copy(AValue, 3, 20)); except Exit; end; case n1 of 0: begin case n2 of 1: begin UserSession.RecNumble:=0;end; 2: begin UserSession.RecNumble:=RecNumble-Grid.RowLimit;end; 3: begin UserSession.RecNumble:=RecNumble+Grid.RowLimit;end; 4: begin UserSession.RecNumble:=999999999; end; end; end; 1: begin if n2 < 1 then n2 := 1; //if Grid.DataSource.DataSet.RecordCount = 0 then Exit; G := inttostr((n2 - 1) * Grid.RowLimit + 1); //Grid.DataSource.DataSet.RecNo := (n2 - 1) * Grid.RowLimit + 1; UserSession.RecNumble:=(n2 - 1) * Grid.RowLimit + 1; end; end; end;

总结：程序执行过程是这样的： (1)每次页面显示时，先执行 TIWFormbasetable.IWAppFormRender(Sender: TObject)事件，打开数

据集，并根据 UserSession.RecNumble(改变此值就会改变页数)这个当前记录号定位页数并调用以下函数显示翻页控件 Page.Text := GetToolStr(ListGrid.DataSource.DataSet.RecNo, ListGrid.DataSource.DataSet.RecordCount, ListGrid.RowLimit, 0, 6, ' 条记录 ') ，再执行



第 91页/共 301页

TIWFormbasetable.IWAppFormAfterRender(Sender: TObject)事件，记录当前记录号并关闭数据集。 (2)当点击翻页控件的链接后会执行 TIWFormbasetable.ComGridColumns0Click(ASender: TObject;

const AValue: string)事件来调用 SetPage(Grid: TIWDBGrid; AValue: string; RecNumble: Integer)函数，以改变 UserSession.RecNumble值，再执行(1)中的过程就实现了翻页。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．11 窗口切换详解作者：高勇


第 92页/共 301页

3．11 窗口切换详解 Intraweb 的窗口管理基本上可以这样理解。生成窗口时会执行 onCreate 事件，这和 windows

下的编程是一样的。每次显示该窗口时会先后执行 onRender和 onAfterRender事件（窗口的几个事件是这样的：首先执行 onCreate事件，如果窗口不 release或者 free，此事件不会再执行，然后执行onRender事件，在窗口每次显示前执行，执行结果可以立即显示到页面上，最后执行 onAfterRender事件，担它的执行结果不能在本次页面上体现出来。onDestroy事件是当窗口执行 release时引发的，相当于以前的 onclose 事件，但在执行 free 时，不会引发该事件）。生成的所有窗口可以理解成为一叠纸张，IE 每次只能显示最上面的那张纸。怎么样才能让一个窗口跑到最上面呢(即把已经存在的一张纸抽出来放在最上面)？有下面 3种方法：1、窗口生成之后直接调用其 show过程，2、将窗口设置成为程序的 ActiveForm，3、如果要显示的窗口在从上到下的第二的位置，可以调用最上面窗口的 hide过程(相当于抽走这张纸)，这样位于第二的窗口将自然出现。采用以上方法，窗口上的所有被用户更改的状态在该窗口下次显示时还保持不变(除非在 onRende事件中更改了)。

所有源代码在文件夹 3.11中。先看一下运行效果：





第 93页/共 301页


在图 3-51中，当窗口生成时执行了如下事件： procedure TIWForm1.IWAppFormCreate(Sender: TObject); begin IWEdit1.Text:='我已经执行了 TIWForm1.IWAppFormCreate(Sender: TObject);'; end;

由于窗口生成后始终存在，所以不会执行第二次，当你更改了 IWEdit1 中的值后当从别的页面再次显示本页面时，IWEdit1中的值会是我们刚刚输入的值。 procedure TIWForm1.IWAppFormRender(Sender: TObject); begin IWEdit2.Text:='我已经执行了 TIWForm1.IWAppFormRender(Sender: TObject);'; end;

以上事件相当于 windows下的编程的 onshow 事件，每次页面显示时都会执行的。所以我们在IWEdit2中输入的值当从别的页面再次显示本页面时不保持不了的。始终是程序给它赋值。

第一种直接的方法：打开页面的代码如下：

procedure TIWForm1.IWButton1Click(Sender: TObject);//这是显示窗口 2：IWForm2 begin //切换窗口的方法一：看看是否已经生成了该窗口，没有则生成并显示，有则直接显示 if (WebApplication.FindComponent('IWForm2') as TIWContainer)=nil then TIWForm2.Create(WebApplication).Show//1、窗口生成之后调用其 show过程直接显示 else WebApplication.SetActiveForm(WebApplication.FindComponent('IWForm2') as TIWContainer);// 2、将窗口设置成为程序的 ActiveForm end;

隐藏当前窗口的代码如下： procedure TIWForm1.IWButton4Click(Sender: TObject); begin//3、如果要显示的窗口在从上到下的第二的位置，可以调用最上面窗口的 hide过程(相当于抽走这张纸)，这样位于第二的窗口将自然出现



第 94页/共 301页

self.Hide;//隐藏当前窗口，前一个窗口自然出现(只要前一个窗口没有 free掉)，但当这是最后一个被隐藏的窗口时，程序将会结束。 end;

使用第一种方法的注意事项：在当前窗口中一定要引用将要显示的窗口的单元。第二种通用的方法：请看文件夹 3.11\使用通用函数显示窗口中的源代码。

我们在 UserSessionUnit中定义了两个函数： procedure TIWUserSession.FreeShowForm(AFormName: string); type TIWFormClass = class of TIWForm; //记得要在 uses中加入 IWForm，否则会提示 TIWForm没有定义 begin TIWAppForm(WebApplication.ActiveForm).Free;//free当前窗口 TIWFormClass(FindClass('T' + AFormName)).Create(WebApplication).show;//生成并显示目标窗口 end; procedure TIWUserSession.ShowForm(AFormName: string); type TIWFormClass = class of TIWForm; begin if (WebApplication.FindComponent(AFormName) as TIWContainer)=nil then //没有生成过目标窗口发，记得要在 uses中加入 IWContainer，否则会提示 TIWContainer没有定义 TIWFormClass(FindClass('T' + AFormName)).Create(WebApplication).show//生成并显示目标窗口 else//生成过目标窗口 WebApplication.SetActiveForm(WebApplication.FindComponent(AFormName) as TIWContainer);//将目标窗口设定为当前窗口 end;

打开页面的代码如下： procedure TIWForm1.IWButton2Click(Sender: TObject); begin

UserSession.ShowForm('IWForm3');//显示窗口 3，且不用引用窗口 3 的单元。这样就变得相当简洁了。

//UserSession. FreeShowForm('IWForm3');// free当前窗口，再显示窗口 3 end;

使用第二种方法的注意事项：在所有窗口的单元文件的最后一个 end 前一定要注册该类，否则显示窗口时会显示找不到某某

类。代码类似如下。函数中的参数是窗口名前加个 T字符。切记一定要手动加入，不会自动生成的。 initialization RegisterClass(TIWForm2);

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．12 窗口之间数据参数传递详解作者：高勇


第 95页/共 301页

3．12 窗口之间数据参数传递详解 Intraweb的窗口之间的数据参数的传递有以下两种简便的方法。 1、在 UserSession中定义公共变量，所有窗口都可以调用和修改 UserSession的变量。这样，

窗口 1要传递一个参数给窗口 2，它可以修改该参数，窗口 2可以直接调用已经修改好的参数，如果该参数的值只使用一次，窗口 2使用完成后便可对该参数再次赋值。只要记住 UserSession中的变量是所有窗口共用的就行了。

2、可以设定 WebApplication.RunParams，同样，所有窗口也可调用和修改 RunParams 中的值。

我们提供的例子是这样的：我们可以直接在 IE中输入 http://127.0.0.1:866/查看首页。这时首页中的输入框是空白的。我们输入姓名刘文昌和职业特警(如 3-53所示)后点击提交按钮，输入的值被传递到 UserSession中的 xingming和 zhiwu变量。在窗口 2显示时将其值显示到了我的简历框里，如图 3-54所示。



在点击打开页面 3时，我们更改了 RunParams中的值(canshu1=胡英&canshu2=老师)，在窗口3中将显示我们出参数 1和参数 2的值，如图 3-55所示。

http://127.0.0.1:866/



第 96页/共 301页


RunParams中的值是全局的，我们再点击打开页面 1按钮时，首页也会显示这两个参数的值，

如图 3-56所示。


如果在 IE直接输入以下地址：“http://127.0.0.1:866/?canshu1=高勇&canshu2=工程师”(格式为

问号加参数名加等号加参数值，如果有多个参数，中间用英文&连接)，首页将会采集这两个参数的值并显示出来，如图 3-57所示。这种应用方式的好处是可以根据不同的参数显示不同的页面内容。


所有源代码在文件夹 3.12中。

http://127.0.0.1:866/

第 97页/共 301页

关键代码讲解：点击提交按钮后执行如下代码：

procedure TIWForm1.IWButton1Click(Sender: TObject); begin //以下判断输入不要为空，如果为空则给出相应的提示信息 if IWEdit1.Text='' then begin self.WebApplication.ShowMessage('请填写姓名!'); exit; end; if IWEdit2.Text='' then begin self.WebApplication.ShowMessage('请填写职务!'); exit; end; //给在 UserSession中定义的两个参数赋值，一个是姓名，一个是职务 UserSession.xingming:=IWEdit1.Text; UserSession.zhiwu:=IWEdit2.Text; UserSession.ShowForm('IWForm2');//打开页面 2(这种方法已经在窗口切换详解这一节中讲解过了) end;

在首页显示时提取 RunParams的参数值如图 3-56所示： procedure TIWForm1.IWAppFormRender(Sender: TObject); begin IWEdit1.Text:=WebApplication.RunParams.Values['canshu1'];//提取名为 canshu1变量的值 IWEdit2.Text:=WebApplication.RunParams.Values['canshu2'];//提取名为 canshu2变量的值 end;

页面 2显示由窗口 1传递的参数如图 3-54所示： procedure TIWForm2.IWAppFormRender(Sender: TObject); begin if (UserSession.xingming<>'') and (UserSession.zhiwu<>'') then IWMemo1.Text:='姓名：'+UserSession.xingming+#13+'职务：'+UserSession.zhiwu; end;

点击打开页面 3的按钮将会在更新 RunParams的值后打开页面 3，页面 3将会在显示时提取RunParams参数值并显示出来，如图 3-55所示： procedure TIWForm2.IWButton2Click(Sender: TObject); begin self.WebApplication.RunParams.Clear;//先清空所有变量 self.WebApplication.RunParams.Add('canshu1=胡英'); //增加一个参数，名称为 canshu1，值为胡英 self.WebApplication.RunParams.Add('canshu2=老师'); //增加一个参数，名称为 canshu2，值为老师 self.WebApplication.RunParams.BeginUpdate; ;//将更改第生效 UserSession.ShowForm('IWForm3');//显示页面 3



第 98页/共 301页

end; 在页面 3显示时提取 RunParams的参数值的代码：

procedure TIWForm3.IWAppFormRender(Sender: TObject); begin IWEdit1.Text:=WebApplication.RunParams.Values['canshu1'];//提取名为 canshu1变量的值 IWEdit2.Text:=WebApplication.RunParams.Values['canshu2'];//提取名为 canshu2变量的值 end;

当然传递参数的方法还不止这两种，但这两种是最简单且最安全的方法。页面显示完成后在网

页中点击查看源代码是看不到这些参数值的，其中 RunParams的参数也不在地址栏中显示。ASP和PHP那可是都要在地址栏中显示哟，这样就会有不安全的因素。

总的来说，这两种方法建立的变量都是全局变量，各个页面都可以调用或修改它们，这确实是

很灵活的。每个 Session建立的这些变量都独立的，大可放心使用，不要担心你我他在不同的机器上访问同一程序时各自的变量会打架。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．13 使用 Cookies在客户端保存数据作者：高勇


第 99页/共 301页

3．13 使用 Cookies在客户端保存数据某些常用的输入，让 IE自己记住这也许是一件好事。例如，要输入的用户名，已登录状态等等。

用 Intraweb操作 Cookies（可以简单的认为是一种保存在客户端的临时数据）便可轻松实现。所有源代码在文件夹 3.13中。如图 3-57所示为程序运行界面。


当输入姓名和职务后，如果选择了让 IE记住输入信息并填写有效期后，点击提交将会在客户端

创建一个 Cookies并将数据保存在其中，下次再次打开相同的页面时，上次输入的姓名和职务将会自动出现在输入框中。

创建 Cookie的代码如下： procedure TIWForm1.IWButton1Click(Sender: TObject); var Cookies1: TstringList; youxiaoqi: integer; //定义一个 Cookies和一个表示有效期的变量 begin if IWEdit1.Text = '' then //判断姓名和职务是否为空 begin self.WebApplication.ShowMessage('请填写姓名!'); exit; end; if IWEdit2.Text = '' then begin self.WebApplication.ShowMessage('请填写职务!'); exit; end; if IWCheckBox1.Checked then //保存输入信息 begin try //判断有效期的合法性 youxiaoqi := strtoint(IWEdit3.Text); except self.WebApplication.ShowMessage('请填写有效期，它是一个自然数!'); exit;

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．13 使用 Cookies在客户端保存数据作者：高勇


第 100页/共 301页

end; try Cookies1 := TstringList.create;//创建自己 Cookies1.Add('CookieName1=' + IWEdit1.Text);//增加一行，格式为参数名加等号加参数值 Cookies1.Add('CookieName2=' + IWEdit2.Text);//再增加一个参数，保存职务 WebApplication.Response.SetCookieField( Cookies1, // 要设置的 Cookies '', //发送到 Cookies的域名，如果为空的话，则使用当前的 '', //发送到 Cookies的路径，如果为空的话，则使用任意路径 Now + youxiaoqi,//Cookies的有效期 False//是否使用加密的连接 ); self.WebApplication.ShowMessage('如果 IE允许使用 Cookies，则 IE记住姓名成功，下次打开该网页时上次输入的姓名将会自动出现。'); finally Cookies1.free;//自己创建的对象自己记得要释放 end; end; self.WebApplication.ShowMessage('你输入的信息为姓名：'+IWEdit1.Text+'职务：'+IWEdit2.Text); end;

再次打开页面时，如图 3-58 所示：


读取 Cookies的代码如下： procedure TIWForm1.IWAppFormCreate(Sender: TObject);//当窗口生成时执行 begin if WebApplication.request.cookieFields.values['CookieName1'] <> '' then// CookieName1 为Cookie中的一个参数名称，如果该参数的值不为空，我们将其取出赋给 IWEdit1.Text IWEdit1.Text := WebApplication.request.cookieFields.values['CookieName1']; if WebApplication.request.cookieFields.values['CookieName2'] <> '' then IWEdit2.Text := WebApplication.request.cookieFields.values['CookieName2']; end; 注意：Cookie所保存的数据好像不支持中文，大家可以试试。英语和数字是没有问题的。有一种变通的方法，那就是将要保存的数据加密为英文字串，读取时解密就行了。这样保存在客户端的数据还比

较安全。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．14 让 IE的后退按钮重新发挥作用作者：高勇


第 101页/共 301页

3．14 让 IE的后退按钮重新发挥作用用 Intraweb编写的程序在默认情况下，IE的后退按钮是没有作用的。这个目的也很明确，如果

我们在窗口的生成和显示事件中写了一些只要执行一次的代码，如果允许后退的话将会给程序的逻辑

造成混乱，但有时，我们也需要让 IE的后退按钮重新发挥作用，使用户的使用习惯符合惯例，这就要求我们编程时要注意避免逻辑上的混乱。总的来说，用 Intraweb可以禁用后退按钮，这样方便于我们编写WEB应用程序(就像在单机上运行的 windows程序一样)，只是不用发布客户端，客户端就是 IE，所以这是 ntrweb的一大优点，同时也可以让 IE的后退按钮重新发挥作用，下面我们用一个例子来进行讲解。

所有源代码在文件夹 3.14中。如图 3-58所示为程序运行界面。

图 3-59 运行界面

本例中网页中的按钮响应代码已经在窗口切换详解中讲解过了。这里关键只讲后退按钮的实现。上图中，大家可看到，后退按钮的下拉列表，点击任意项即可后退到相应页面。实现方法其实

很简单，大家注意以下两点就行了： 1、在所有窗口的单元文件的最后一个 end前一定要注册该类，否则显示窗口时会显示找不到某

某类。代码类似如下。函数中的参数是窗口名前加个 T字符。切记一定要手动加入，不会自动生成的。 initialization RegisterClass(TIWForm2); 2、在 ServerController的 onBackButton事件中加入以下代码：

procedure TIWServerController.IWServerControllerBaseBackButton( ASubmittedSequence, ACurrentSequence: Integer; AFormName: string; var VHandled, VExecute: Boolean); const DefaultFormName = 'IWForm1';//定义首页窗口的 name，此处首页窗口名为 IWForm1，这是我们针对具体的项目要修改的地方，以下代码通用。 type

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．14 让 IE的后退按钮重新发挥作用作者：高勇


第 102页/共 301页

TIWFormClass = class of TIWForm;//记得要在 uses中加入 IWForm，否则会提示 TIWForm没有定义 begin VHandled := True; VExecute := True; if AFormName = '' then// AformName是后退按钮保存的访问过的页面窗口名称 AFormName := DefaultFormName; if WebApplication.FindComponent(AFormName) <> nil then//如果找到该窗口则直接显示该窗口 begin WebApplication.SetActiveForm(WebApplication.FindComponent(AFormName) as TIWContainer); //记得要在 uses中加入 IWContainer，否则会提示 TIWContainer没有定义 end else//如果没有找到该窗则生成并显示出来 begin try WebApplication.SetActiveForm(TIWFormClass(FindClass('T'+ AFormName) ).Create(WebApplication)); //如果没有找到该窗则生成并显示出来 except VHandled := False; end; end; end;

以上方法是不是很简单呢，多说无意，就此打住。当然还有一种更简单的方法，不得不说一下，

那就是如果你的 intraweb版本的ServerController单元窗口属性中有HistoryEnabled的话，设置成 true就行了。不必用本节前面所讲述的方法，是不是更简单呢？但仔细对比一下，还是有点差别的。不说

了。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．15 用 Frame来实现各页面的公共菜单作者：高勇


第 103页/共 301页

3．15 用 Frame来实现各页面的公共菜单用 Intraweb编写程序时，怎样实现一个漂亮的菜单条，而且不用在每个窗口都写相同的代码，

如图 3-60所示那样。前面有一节说过用继承的方法来实现，但这一节我们用 Frame来实现。所有源代码在文件夹 3.15中。

图 3-60 漂亮的菜单条

大家打开程序源代码可以看到，窗口 1和窗口 2很普通，窗口 1是建立 intraweb程序就会自动生成，窗口 2是在 new items对话框中的 intraweb选项卡中选择 new form后生成的。有点特殊的是IWFrame3，它是 intraweb选项卡中选择 new frame后生成的（记住只能这样生成，只要是 intraweb的窗口都要从这里开始）。如图 3-61所示。点击 ok后出现的对话框选择默认即可。

图 3-61 新建一个 frame

图 3-62是新建成的 IWFrame3，当然此名称可以在 name属性任意一更改，但请一次性改好，当它注册到面板被引用后再改就麻烦了。下图显示出了其中的控件。一个菜单 IWMenu1，两个超级链接 IWLink1和 IWLink2。还有一点要记住，IWFrameRegion.ClipRegion的属性一定要设定这 false，这样，菜单下拉时就不会在其内部展开。大家不明白的话可以改变这个属性试试运行效果便知道了。

图 3-62 frame中控件

在此窗口中，请在 implementation后加入：“uses IWInit, ServerController,UserSessionUnit;”，切记。打开页面的链接的方法已经在窗口的切换详解这一节讲过了。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．15 用 Frame来实现各页面的公共菜单作者：高勇


第 104页/共 301页

在上图中点击右键，点击 add to pallete，出现图 3-63。点击 OK即可。

图 3-63 注册 frame对话框

接下来请在 Templates组件面板中找到我们刚刚注册的控件，直接拖入窗口 1和窗口 2中。这样这两个窗口都有菜单条了，如图 3-64所示。

图 3-64 窗口 1中加入菜单条

在所有窗口的单元文件的最后一个 end 前一定要注册该类，否则显示窗口时会显示找不到某某

类。代码类似如下。函数中的参数是窗口名前加个 T字符。切记一定要手动加入，不会自动生成的。 initialization RegisterClass(TIWForm2); 程序运行时如图 3-65所示。没有采用模板，所有不是很漂亮。但还有一个更重要的原因，那就

是 Intraweb自带的菜单控件确实不怎么漂亮，远不如 TMS组件的。如果你安装的 TMS，请在文件夹

3.15\TMS版本中查看其源代码，主要看看 MainMenu1.pas就行了，其它的不用详究。它采用模板后运行的效果如图 3-60所示。

图 3-65 程序运行时的界面

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．16 用 realone插件来播放声音（视频）作者：高勇


第 105页/共 301页

3．16 用 realone插件来播放声音（视频）曾用 Intraweb 编写过一个英语听力学习站点，这其中要求能够在网页中播放 rm 格式的声音文

件，而 Intraweb中又没有能够调用它的控件，最后只好采用模板来实现了，大家只要按照我讲的步骤保证很简单。

所有源代码在文件夹 3.16 中。图 3-66 为程序运行界面，点击小喇叭后会出现一个播放器的工具条，同时播放声音。双击可以隐藏，并且可被鼠标拖动并定位。


1、我们的宝贝是制作好模板：3.16\Templates\ IWindex.html。你可以给文件改名以适应不同的窗口，也可以修改网页模板的任何可视化元素，如表格，图片等，但请不要直接修改其源代码，特别

是其关于播放器的 javascript代码，否则有可能不能正常调用播放器播放声音。图 3-67为 IWindex.html的模板界面，我们在其中只放了一个 intraweb控件：IWRegionA。

图 3-67 IWindex.html模板界面

2、生成调用播放器播放声音的代码。我们借用 IWRectangle1控件输入 html代码。

procedure TIWindex.IWAppFormCreate(Sender: TObject); var luyinfile:string; begin UserSession.ADOQuerytemp.Close;//以下从数据库中取出文件名 UserSession.ADOQuerytemp.SQL.Clear;

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 3．16 用 realone插件来播放声音（视频）作者：高勇


第 106页/共 301页

UserSession.ADOQuerytemp.SQL.Add('select * from Bsd where unit =''' + '116' + '''');//查询第一册 16单元的题目 UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount > 0 then//如果查询到记录 begin luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('luyin1').AsString);//取得要播放的录音文件名 if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then//如果文件存在 IWRectangle1.Text := IWRectangle1.Text +' 第一题： <a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>';//输出第一题的调用播放器的 html代码。录音文件存放在 files/luyin/目录下。点击小喇叭后会将播放器的工具条显示出来并播放声音。 luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('luyin2').AsString); //取得要播放的录音文件名 if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then//如果文件存在 IWRectangle1.Text := IWRectangle1.Text +' 第二题： <a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>'; //输出第二题的调用播放器的 html代码。 ……//第 3，4，5题目很类似

end; UserSession.ADOQuerytemp.Close; end;

就这么简单，运行即可。但值得注意的是：切记我们所用的模板文件不可乱改动，那可是经过

我的 N多次修改才搞定的。使用起来简单的，当初做起来肯定是很复杂的（这叫越简单的越复杂）。对了，我们的标题中不是还提到了一个视频吗？不要急，只要你上面的搞懂了，下面的播放视

频就很简单了。将 3.16\Templates\播放音视频文件的模板.html文件名更改为 IWindex.html即可，即让程序应用播放音视频文件的模板.html这个模板。图 3-68为应用视频模板后程序运行界面，如果播放的 rm文件是视频，则会有图像，如果没有，则只有声音。

图 3-68 应用视频模板后程序运行界面

这两个模板文件可是私人珍藏，以前在 ASP下用过，播放界面都是可以拖动，定位和隐藏的，没想到 intraweb下也用得这么好，功夫真是没有白费呀。就拿出来共享吧。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 4．1 一个电影网站的出生之旅作者：高勇


第 107页/共 301页

第四章完整应用实例讲解

4．1 一个电影网站的出生之旅 4.1.1 网站模板与运行界面在第一章时，我们提到过一个电影网站。这里，我们对它进行完整讲解。这个程序第一次看也许觉得很复杂，但只要明白了其中的原理，其实是很简单的。此程序中直接

应用 IntraWeb 控件倒不是很多，看懂此程序应该具备一定的网页编程经验，说白了，也就是要懂得HTML网页中的代码的意思，会基本的网页设计。（源代码在文件夹 4.1中）闲话少述，先说一下整个程序的总体思路： 1、网站一般都有一个每页都有的导航条之类的东西，就是每页都出现的一些公共界面，我们在

BaseForm窗口中实现，其它页面要拥有这些公共界面，我们就从这个窗口继承。 2、所有窗口要调用的共用函数我们都写在 IWServerController 窗口中，其它窗口只要 uses

ServerController单元，就可以直接调用这些函数。 3、各单元之间要传递的参数我们都事先在 IWUserSession 窗口中定义，传递时先给相应的参数

赋值，接收时从这个参数取值。这样就可以实现各网页之间的参数传递。 4、界面布局我们依然采用模板的方法，用 HTML文件作为模板，相应的窗口调用相应的模板将我

们的 IntraWeb控件自动嵌入到相应的位置中。不同的模板可以实现不同的网页风格。 5、每个 IntraWeb 中用到的表格控件我们都采用皮肤（skin）技术，也就是一个小的模板，用来

美化我们的表格。而且更改外部皮肤就可以更改我们的表格风格。我们的模板放在\templates\1 目录下，这表示是第一套模板。但模板在设计时，还是请直接放在

templates目录下，完全确立可以了再放在文件 1目录下。原因是文件中的图片路径在 templates目录下是可以显示的，在 1目录下就不能正常显示了。这里共有 8个页面，它们的文件名中小数点前的部分都和相应的窗口名称是一样的。下面我解释一下各个页面的作用：

1）MainForm.html，图 4-1-1是这个模板文件的视图：

图 4-1-1 MainForm.html在 IE中的视图



第 108页/共 301页

这个模板对应我们程序中的窗口 MainForm，从窗口 Baseform 继承，是网站的首页。主要用来显示登录输入框、显示最新电影列表和点播排行榜列表。“{%NewFilm%}”（双引号之间的部份）这种格式是模板网页中的一个标记，IntraWeb 程序在运行时会查找这种标记“{% %}”，将两个%号之间的字符取出来当作本模板对应窗口内的一个 IntraWeb 控件名，如果窗口内有以此为名的控件，程序就将此控件生成的相应HTML代码输出，替换模板文件中的这个标记“{%NewFilm%}”。这里“{%NewFilm%}”和“{%HotFilm%}”是两个表格控件，输出时会生成两个表格。运行时如图 4-1-2生成最新电影列表和点播排行榜列表。

图 4-1-2 MainForm运行时的界面这样程序的界面设计就与编程可以分开了，设计好网页，将我们的相应标记放进去就行了。下面我着重讲一下图 4-1-3中的标记：

图 4-1-3 Baseform窗口上的控件

这就是我说的每个页面都有的公共界面，我们有一个窗口 Baseform，就有以上标记的所有控件。



第 109页/共 301页

其它页面窗口都是从它继承的，所以其它页面窗口也都有这些控件。但运行时并不是每个页面都显示

这些控件内容，当控件的 visible属性为 false时就不会显示。运行时可能是如图 4-1-4界面：

图 4-1-4 Baseform窗口被继承后的运行界面

“｛%Label1%｝”输出一个字符串，这里是“用户”，“｛%UserID%｝” 输出为一个输入框，用来输

入用户名，“｛%Label2%｝”输出一个字符串，这里是“密码”，“｛%PASS%｝” 输出为一个输入框，用来输入密码。“｛%Login%｝”和“｛%Reg%｝”是两个按钮，前者为登录，后者为注册。“｛%Search%｝”也是一个按钮，为搜索，“｛%Searchedit%｝”是一个输入框，用来输入要搜索电影的关键词。如果有的看不见是因为控件的 visible属性为 false。

2）RegForm.html图 4-1-5是这个模板文件的视图：

图 4-1-5 RegForm.html在 IE中的视图

这个模板对应我们的窗口 RegForm，从窗口 Baseform 继承，是用户的注册页，用来填写注册信

息的。运行时其对应显示的控件如图 4-1-6（运行时点击注册按钮就会出现以下页面）：

图 4-1-6 窗口 RegForm的运行界面



第 110页/共 301页

“｛%UserName%｝”输出一个输入框，用来输入会员名，此会员名即是登录时的用户名，

“｛%PassWord%｝” 输出为一个输入框，用来输入密码，“｛%CheckPass%｝” 输出为一个输入框，用来输入第二遍密码。“｛%Boy%｝”和“｛%Girl%｝”是两个单选框，前者为男，后者为女。“｛%RegBtn%｝”是一个按钮，为添加，按下此按钮即提交注册信息到数据库，“｛%ResetBtn%｝” 也是一个按钮，为返回，按下将返回到首页。

3）ListForm.html图 4-1-7是这个模板文件的视图：

图 4-1-7 ListForm.html在 IE中的视图

这个模板对应我们的窗口 ListForm，从窗口 Baseform 继承，是电影列表显示页面，点击列表中

的相应链接就可以播放电影。运行时其对应显示的控件如图 4-1-8（点击搜索按钮或影片分类文字链接就会出现以下页面）：

图 4-1-8 窗口 ListForm的运行界面



第 111页/共 301页

“｛%ListGrid%｝”输出电影列表，如上图所示 4部电影，“｛%Page%｝” 输出为上图最下面的页

面导航条，用来快速到达所需页面。 4）PlayForm.html图 4-1-9是这个模板文件的视图：

图 4-1-9 PlayForm.html在 IE中的视图

这个模板对应我们的窗口 PlayForm，从窗口 Baseform 继承，是电影播放显示页面。运行时其对应显示的控件如图 4-1-10（点击列表中的相应链接就会出现以下页面）：

图 4-1-10 窗口 PlayForm在运行时的界面

“｛%PlayFilm %｝”输出一个组装的 HTML代码，显示效果如上图。有电影播放界面，也有相关的

此处为电影内容



第 112页/共 301页

电影信息。所有元素是以表格的形式来定位的。全部通过 HTML代码来实现。 5）SystemForm.html图 4-1-11是这个模板文件的视图：

图 4-1-11 SystemForm.html在 IE中的视图这个模板对应我们的窗口 SystemForm，从窗口 Baseform 继承，是管理员登录后的显示页面。

运行时其对应显示的控件如图 4-1-12（填入管理员用户名和密码后点击登录按钮后就会出现以下页面）：

图 4-1-12 窗口 SystemForm运行时的界面

“｛%EdtPort%｝”输出一个输入框，用来输入服务器所绑定的端口号，“｛%EdtNewFilm%｝” 输出为一个输入框，用来输入主页面显示的最新数目电影,默认为 6，“｛%EdtHotFilm%｝” 输出为一个输入框，用来输入主页面显示的热门数目电影,默认为 14。“｛%UserControl%｝”和“｛%FilmControl%｝”是两个 HTML 代码输出控件，分别显示添加,修改,删除用户链接和添加,修改,删除电影链接。“｛%IWCheckBox1%｝”是一个复选框，其作用为是否支持换页面特效， “｛%AffirmBtn%｝” 是一个按钮，为保存所修改的信息，“｛%ReturnBtn%｝” 也是一个按钮，为返回，按下将返回到首页。

6）UserForm.html图 4-1-13是这个模板文件的视图：



第 113页/共 301页

图 4-1-13 UserForm.html在 IE中的视图这个模板对应我们的窗口 UserForm，从窗口 Baseform 继承，是管理员登录后的用户管理页面。

运行时其对应显示的控件如图 4-1-14（点击用户管理中的【修改,删除】后就会出现以下页面）：

图 4-1-14 窗口 UserForm运行时的界面

“｛%ListUser%｝”输出用户列表，如上图所示，“｛%Page%｝” 输出为上图最下面的页面导航条，用来快速到达所需页面。

7）adminForm.html图 4-1-15是这个模板文件的视图：

图 4-1-15 adminForm.html在 IE中的视图这个模板对应我们的窗口 adminForm，从窗口 Baseform 继承，是管理员登录后的用户管理页面。

运行时其对应显示的控件如图 4-1-16（点击电影管理中的【修改,删除】后就会出现以下页面）：



第 114页/共 301页

图 4-1-16 窗口 adminForm运行时的界面

“｛%ListFilm%｝”输出电影列表，如上图所示，“｛%Page%｝” 输出为上图最下面的页面导航条，

用来快速到达所需页面。点击修改将进入修改页面，点击删除将会删除该部电影。 7）ModiforAddForm.html图 4-1-17是这个模板文件的视图：

图 4-1-17 ModiforAddForm.html在 IE中的视图



第 115页/共 301页

这个模板对应我们的窗口 ModiforAddForm，从窗口 Baseform 继承，是管理员登录后的修改、添

加电影的页面。运行时其对应显示的控件如图 4-1-18（点击电影管理中的【添加】后就会出现以下页面）：

图 4-1-18 窗口 ModiforAddForm运行时的界面相应标记和输出控件可以对比以上两图，这里不再详述。补充说明：标记中间的字符串是窗口中的控件的 name,从标记中一般看不出是什么控件，要知道

标记的是什么控件，可以打开源代码的相应窗口自己对照来看。因为数据库的功能设计不是我们的主要目的，我们在这里主要关注有关 intraweb的编程方法，所

以数据库的设计我就不讲了，很简单，大家打开 database\ imovie.mdb自己查看就清楚了，我们要将大多数精力放在研究程序代码上。



第 116页/共 301页

4.1.2 程序代码全面解析 4.1.2.1 ServerController单元这是一个很重要的单元，因为很多公用函数在这个单元里实现。下面我会详细讲解每一个函数，

如果没有详细的说明，那这个函数你可以不用明白它是怎么实现的，只要知道结果是什么，怎么使用

它就行了。在自己的程序中，你可以把这整个函数抄过去而不用更改任何参数，把该函数引用到的相

应单元 uses进去即可。以下有很多可以收藏的函数。 unit ServerController; interface uses SysUtils, Classes, IWServerControllerBase, IWBaseForm, HTTPApp,WinSock, // For OnNewSession Event UserSessionUnit, IWApplication, IWAppForm, ADODB, DB, IWDBGrids, ShellAPI, Variants,StrUtils; type TIWServerController = class(TIWServerControllerBase) procedure IWServerControllerBaseNewSession(ASession: TIWApplication; var VMainForm: TIWBaseForm); procedure IWServerControllerBaseBackButton(ASubmittedSequence, ACurrentSequence: Integer; AFormName: string; var VHandled, VExecute: Boolean); procedure IWServerControllerBaseCreate(Sender: TObject); procedure IWServerControllerBaseCloseSession(ASession: TIWApplication); private public end; var GSkin, G: string; function GetLocalIP: string; //得到本机 IP地址） function PlayFilms(IQuery: Tadoquery; Search: string; PlayFilmNum: Integer = 0): string; function GetLinkStringEx(Row: Integer; ID, Link: string; Cof: string = ''; GridName: string = 'ComGrid'): string; function GetToolStr(RecNo, RecordCount, RowLimit: Integer; GridID: Integer; Nums: Integer = 10; Captions: string = '条记录'; Grid: string = 'ComGrid'): string; function ShowForm(AFormName: string): Boolean; function GetSpace(Count: Integer): string; function HotFilms(IQuery: Tadoquery; ICount: Integer = 14): string; function NewFilms(IQuery: Tadoquery; ICount: Integer = 6): string; function pictureString(IPath, ISize: string): string; function GetLinkString(Row, ID: string; Link: string; Cof: string = ''; GridName: string = 'ComGrid'): string; //给服务器 iwdbgrid第几行处理，给服务器 iwdbgrid处理的数据，在 IE显示超连接 function UserSession: TIWUserSession; function IWServerController: TIWServerController; procedure SetPage(Grid: TIWDBGrid; AValue: string); function PlayRM(Iflie: string): string; function PlayAvi(Iflie: string): string;

第 117页/共 301页

function CopyDirectory(const Source, Dest: string): Boolean; function DelDirectory(const Source: string): Boolean; function RenDirectory(const OldName, NewName: string): Boolean; function gethzPy(const AHzStr: string): string; //得到汉字首字母 function RenString(Istring: string): string; function IIF(str, num: string): string; function GetHourStr: string; implementation {$R *.dfm} uses IWInit, IWGlobal, IWForm, IWContainer; //得到本机 IP地址，会用就行，记得要 uses WinSock单元 function GetLocalIP: string; type TaPInAddr = array [0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe : PHostEnt; pptr : PaPInAddr; Buffer : array [0..63] of char; I : Integer; GInitData : TWSADATA; begin WSAStartup($101, GInitData); Result := ''; GetHostName(Buffer, SizeOf(Buffer)); phe :=GetHostByName(buffer); if phe = nil then Exit; pptr := PaPInAddr(Phe^.h_addr_list); I := 0; while pptr^[I] <> nil do begin result:=StrPas(inet_ntoa(pptr^[I]^)); Inc(I); end; WSACleanup; end; //得到一天的时间段称呼，用来向登录用户问好 function GetHourStr: string; var Hour, Min, Sec, MSec: word; begin DecodeTime(Now, Hour, Min, Sec, MSec); case Hour of



第 118页/共 301页

0, 1, 2, 3, 4: result := '午夜'; 5, 6, 7: result := '早上'; 8, 9, 10: result := '上午'; 11, 12, 13: result := '中午'; 14, 15, 16, 17, 18: result := '下午'; 19, 20, 21, 22, 23: result := '晚上'; end; end; //如果 str 为空，则函数值为 num，如果不为空，则函数值为 str，函数功能可以总结为：给空字符串str赋值为 num，不空就保持不变 function IIF(str, num: string): string; begin begin if Trim(str) = '' then result := num else result := str; end end; //将字符串 Istring中的/替换成\，目的是将 URL地址转换成文件路径 function RenString(Istring: string): string; function ReplaceText(const S, ReplacePiece, ReplaceWith: string): string; var Position: Integer; TempStr: string; begin Position := Pos(ReplacePiece, S); if Position > 0 then begin TempStr := S; Delete(TempStr, 1, Position - 1 + Length(ReplacePiece)); result := Copy(S, 1, Position - 1) + ReplaceWith + ReplaceText(TempStr, ReplacePiece, ReplaceWith) end else result := S; end; begin result := ReplaceText(Istring, '/', '\') end; //得到汉字首字母 function gethzPy(const AHzStr: string): string; const ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077), (2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),

第 119页/共 301页

(2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729), (3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000), (9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589)); var i, j, HzOrd: Integer; begin i := 1; while i <= Length(AHzStr) do begin if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then begin HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160; for j := 0 to 25 do begin if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then begin result := result + char(byte('A') + j); break; end; end; Inc(i); end else result := result + AHzStr[i]; Inc(i); end; end; // 更改文件夹名，将 OldName用 NewName代替，更改成功函数返回 true function RenDirectory(const OldName, NewName: string): Boolean; var fo: TSHFILEOPSTRUCT; begin FillChar(fo, SizeOf(fo), 0); with fo do begin Wnd := 0; wFunc := FO_RENAME; pFrom := PChar(OldName + #0); pTo := PChar(NewName + #0); fFlags := FOF_NOCONFIRMATION + FOF_SILENT; end; result := (SHFileOperation(fo) = 0); end; //删除文件夹 Source

第 120页/共 301页

function DelDirectory(const Source: string): Boolean; var fo: TSHFILEOPSTRUCT; begin FillChar(fo, SizeOf(fo), 0); with fo do begin Wnd := 0; wFunc := FO_DELETE; pFrom := PChar(Source + #0); pTo := #0#0; fFlags := FOF_NOCONFIRMATION + FOF_SILENT; end; result := (SHFileOperation(fo) = 0); end; //复制文件夹(Source为被拷贝的文件夹名，Dest新文件夹名) function CopyDirectory(const Source, Dest: string): Boolean; var fo: TSHFILEOPSTRUCT; begin FillChar(fo, SizeOf(fo), 0); with fo do begin Wnd := 0; wFunc := FO_COPY; pFrom := PChar(Source + #0); pTo := PChar(Dest + #0); fFlags := FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR; end; result := (SHFileOperation(fo) = 0); end; //在网页中生成播放 AVI文件的代码（嵌入 windows的媒体播放器），打开网页即可播放 Iflie所指定的AVI文件。Hint字符串为自己定义的，可以参考修改，但它以下的代码不需要更改。GetSpace(18)为在网页中加入 18 个空格，数字是几就加入几个空格。UserSession.PlayFilmNum 为电影的集数，如果不为 0，则显示电影名 UserSession.Film 和集数 UserSession.PlayFilmNum，否则只显示电影名UserSession.Film。后面的代码是加入电影播放界面，当打开页面时播放 Iflie所指定的 AVI文件。 function PlayAvi(Iflie: string): string; var hint: string; begin if UserSession.PlayFilmNum <> 0 then hint := '' + GetSpace(18) + '当前播放电影片为 【' + UserSession.Film + '】

第 121页/共 301页

 的第' + inttostr(UserSession.PlayFilmNum) + '集' else hint := '' + GetSpace(18) + '当前播放电影片为 【' + UserSession.Film + '】 '; result := hint + '<OBJECT id=MediaPlayer1 height=400 width=450 classid=clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95>' + '<PARAM NAME="AudioStream" VALUE="-1"> ' + '<PARAM NAME="AutoSize" VALUE="0"> ' + '<PARAM NAME="AutoStart" VALUE="-1"> ' + '<PARAM NAME="AnimationAtStart" VALUE="-1">' + '<PARAM NAME="AllowScan" VALUE="-1"> ' + '<PARAM NAME="AllowChangeDisplaySize" VALUE="-1">' + '<PARAM NAME="AutoRewind" VALUE="0"> ' + '<PARAM NAME="Balance" VALUE="0"> ' + '<PARAM NAME="BaseURL" VALUE=""> ' + '<PARAM NAME="BufferingTime" VALUE="5"> ' + '<PARAM NAME="CaptioningID" VALUE=""> ' + '<PARAM NAME="ClickToPlay" VALUE="-1"> ' + '<PARAM NAME="CursorType" VALUE="0"> ' + '<PARAM NAME="CurrentPosition" VALUE="-1"> ' + '<PARAM NAME="CurrentMarker" VALUE="0"> ' + '<PARAM NAME="DefaultFrame" VALUE=""> ' + '<PARAM NAME="DisplayBackColor" VALUE="0"> ' + '<PARAM NAME="DisplayForeColor" VALUE="16777215"> ' + '<PARAM NAME="DisplayMode" VALUE="0"> ' + '<PARAM NAME="DisplaySize" VALUE="2"> ' + '<PARAM NAME="Enabled" VALUE="-1"> ' + '<PARAM NAME="EnableContextMenu" VALUE="-1"> ' + '<PARAM NAME="EnablePositionControls" VALUE="-1"> ' + '<PARAM NAME="EnableFullScreenControls" VALUE="0">' + '<PARAM NAME="EnableTracker" VALUE="-1"> ' + '<PARAM NAME="Filename" VALUE="' + midStr(trim(Iflie),2,Length(trim(Iflie))) + '"> ' + '<PARAM NAME="InvokeURLs" VALUE="-1"><PARAM NAME="Language" VALUE="-1">' + '<PARAM NAME="Mute" VALUE="0"> ' + '<PARAM NAME="PlayCount" VALUE="1"> ' + '<PARAM NAME="PreviewMode" VALUE="0"> ' + '<PARAM NAME="Rate" VALUE="1"> ' + '<PARAM NAME="SAMILang" VALUE=""> ' + '<PARAM NAME="SAMIStyle" VALUE=""> ' + '<PARAM NAME="SAMIFileName" VALUE=""> ' + '<PARAM NAME="SelectionStart" VALUE="-1"> ' + '<PARAM NAME="SelectionEnd" VALUE="-1"> ' + '<PARAM NAME="SendOpenStateChangeEvents" VALUE="-1"> ' + '<PARAM NAME="SendWarningEvents" VALUE="-1"> ' +

第 122页/共 301页

'<PARAM NAME="SendErrorEvents" VALUE="-1"> ' + '<PARAM NAME="SendKeyboardEvents" VALUE="0"> ' + '<PARAM NAME="SendMouseClickEvents" VALUE="0"> ' + '<PARAM NAME="SendMouseMoveEvents" VALUE="0"> ' + '<PARAM NAME="SendPlayStateChangeEvents" VALUE="-1"> ' + '<PARAM NAME="ShowCaptioning" VALUE="0">' + '<PARAM NAME="ShowControls" VALUE="-1"> ' + '<PARAM NAME="ShowAudioControls" VALUE="-1">' + '<PARAM NAME="ShowDisplay" VALUE="0"> ' + '<PARAM NAME="ShowGotoBar" VALUE="0"> ' + '<PARAM NAME="ShowPositionControls" VALUE="-1"> ' + '<PARAM NAME="ShowStatusBar" VALUE="-1">' + '<PARAM NAME="ShowTracker" VALUE="-1">' + '<PARAM NAME="TransparentAtStart" VALUE="0">' + '<PARAM NAME="VideoBorderWidth" VALUE="0">' + '<PARAM NAME="VideoBorderColor" VALUE="0">' + '<PARAM NAME="VideoBorder3D" VALUE="0">' + '<PARAM NAME="Volume" VALUE="-40"> ' + '<PARAM NAME="WindowlessVideo" VALUE="0"></OBJECT>'; end; //在网页中生成播放 rm文件的代码（嵌入 realplayer的播放器），打开网页即可播放 Iflie所指定的 rm文件。Hint字符串为自己定义的，可以参考修改，但它以下的代码不需要更改。GetSpace(18)为在网页中加入 18 个空格，数字是几就加入几个空格。UserSession.PlayFilmNum 为电影的集数，如果不为 0，则显示电影名 UserSession.Film 和集数 UserSession.PlayFilmNum，否则只显示电影名UserSession.Film。后面的代码是加入电影播放界面，当打开页面时播放 Iflie所指定的 rm文件。 function PlayRM(Iflie: string): string; var hint: string; begin if UserSession.PlayFilmNum <> 0 then hint := '' + GetSpace(18) + '当前播放电影片为 【' + UserSession.Film + '】 的第' + inttostr(UserSession.PlayFilmNum) + '集' else hint := '' + GetSpace(18) + '当前播放电影片为 【' + UserSession.Film + '】'; result := hint + '<object ID="video2" CLASSID="clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA" name="playfull" WIDTH="412" HEIGHT="320" >' + '<param name="_ExtentX" value="10901" />' + '<param name="_ExtentY" value="8467" />' + '<param name="AUTOSTART" value="-1" />' + '<param name="SHUFFLE" value="0" />' + '<param name="PREFETCH" value="0" />' + '<param name="NOLABELS" value="0" />' +

第 123页/共 301页

'<param name="SRC" value="' + midStr(trim(Iflie),2,Length(trim(Iflie))) + ' "/>' + '<param name="CONTROLS" value="ImageWindow" />' + '<param name="CONSOLE" value="Clip1" />' + '<param name="LOOP" value="0" /> ' + '<param name="NUMLOOP" value="0" />' + '<param name="CENTER" value="0" /> ' + '<param name="MAINTAINASPECT" value="0" />' + '<param name="BACKGROUNDCOLOR" value="#000000" />' + '<embed SRC="4.rpm" type="audio/x-pn-realaudio-plugin" CONSOLE="Clip1" CONTROLS="ImageWindow" HEIGHT="240" WIDTH="352" AUTOSTART="false" /></object>' + '<object ID="video1" CLASSID="clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA" WIDTH="412" HEIGHT="60" >' + '<param name="_ExtentX" value="10901" />' + '<param name="_ExtentY" value="1588" />' + '<param name="AUTOSTART" value="-1" />' + '<param name="SHUFFLE" value="0" />' + '<param name="PREFETCH" value="0" /> ' + '<param name="NOLABELS" value="0" /> ' + '<param name="CONTROLS" value="ControlPanel,StatusBar" /> ' + '<param name="CONSOLE" value="Clip1" /> ' + '<param name="LOOP" value="0" /> ' + '<param name="NUMLOOP" value="0" /> ' + '<param name="CENTER" value="0" /> ' + '<param name="MAINTAINASPECT" value="0" />' + '<param name="BACKGROUNDCOLOR" value="#000000" /> ' + '<embed type="audio/x-pn-realaudio-plugin" CONSOLE="Clip1" CONTROLS="ControlPanel,StatusBar" HEIGHT="60" WIDTH="275" AUTOSTART="false" /></object>'; end; //此函数的目的是当点击列表页面最下方的分页导航条的第几页或者 Go链接时，跳到相应的页面。总的来说就是实现数据分页。Grid为要分页的 TIWDBGrid表格 name，Avalue为传递的一个参数，这个不用操心，当调用这个函数时自然会有这个值供你使用。在应用这个函数之前，要先调用下一个函

数 GetToolStr来生成导航条。 procedure SetPage(Grid: TIWDBGrid; AValue: string); var n1, n2: Integer; begin try//如果输入的是字母则退出，因为字母不能被转换成数字 n1 := Strtoint(Copy(AValue, 1, 1)); if Copy(AValue, 3, 20) = '' then Exit; n2 := Strtoint(Copy(AValue, 3, 20)); except Exit;

第 124页/共 301页

end; case n1 of 0: begin case n2 of 1: Grid.DataSource.DataSet.First; 2: Grid.DataSource.DataSet.MoveBy(-Grid.RowLimit); 3: Grid.DataSource.DataSet.MoveBy(Grid.RowLimit); 4: Grid.DataSource.DataSet.Last; end; end; 1: begin if n2<1 then n2:=1; if Grid.DataSource.DataSet.RecordCount=0 then exit; G := inttostr((n2 - 1) * Grid.RowLimit + 1); Grid.DataSource.DataSet.RecNo := (n2 - 1) * Grid.RowLimit + 1; end; end; end; //这个函数就是用来生成相应数据表格的分页导航条的，RecNo 为表格所用数据集的当前记录，RecordCount 为表格所用数据集的整个记录个数，RowLimit 为表格显示的每页记录数，GridID 为ComGrid的执行跳页的相应的函数所在的 ComGrid的行号，Captions为统计时的字符提示，Grid为在窗口中响应导航链接的 TIWDBGrid 控件的 name.。给出一个调用它的例子： Page.Text := GetToolStr(ListGrid.DataSource.DataSet.RecNo,ListGrid.DataSource.DataSet.RecordCount, ListGrid.RowLimit, 0, 6, '部电影')，ListGrid 为一个 TIWDBGrid 控件，0 为 ComGrid 第一行的ComGridColumns0Click(ASender: TObject; const AValue: string)来执行导航条的链接。6为导航条显

示 6 个数字，'部电影'为后面的总计提示，如 97 2 3 4 5 6 7 8:去页 Go 共 143 部电影每页 4

部电影共 36页。｛这里有必要说明一下，这是一个很重要的概念：请看以下代码： <a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，在网页上这将显示为爱情片，并有超级链接，当单击爱情片这个链接时会执行

SubmitClickConfirm('ComGrid','1_爱情片', true, '')这个函数。这个函数会调用窗口中的名为第一个参数 ComGrid的 TIWDBGrid控件的 ComGridColumns1Click(ASender: TObject; const AValue: string)函数。SubmitClickConfirm('ComGrid','1_爱情片', true, '')中第二个参数下划线前的 1为 Columns的索引，函数 ComGridColumns1Click(ASender: TObject; const AValue: string)即为 ComGrid表格的第二行的 onclick 事件（第一行的索引为 0）。第二个参数下划线后的爱情片即为从网页传递到窗口ComGridColumns1Click(ASender: TObject; const AValue: string)函数的Avalue的值。即Avalue:=’ 爱情片’;第 4 个参数如果不为空，则会跳出一个对话框，如果选择是则继续执行，否则不执行窗口函数代码。｝ function GetToolStr(RecNo, RecordCount, RowLimit: Integer; GridID: Integer; Nums: Integer = 10; Captions: string = '条记录'; Grid: string = 'ComGrid'): string; var

第 125页/共 301页

P: real; n, n1, n2, P1, P2: Integer; S: string; begin P := RecNo / RowLimit; P1 := Trunc(P); if Frac(P) > 0 then Inc(P1); P := RecordCount / RowLimit; P2 := Trunc(P); if Frac(P) > 0 then Inc(P2); result := ' '; if P1 > 1 then begin result := result + GetLinkStringEx(GridID, '0_1', '9', '', Grid) + GetLinkStringEx(GridID, '0_2', '7', '', Grid) + '%S'; end else begin result := result + '9' + '7%S'; end; if P1 <> P2 then begin result := result + GetLinkStringEx(GridID, '0_3', '8', '', Grid) + GetLinkStringEx(GridID, '0_4', ':', '', Grid); end else begin result := result + '8' + ':'; end; Nums := Trunc(Nums / 2); n1 := P1 - Nums; if n1 < 1 then n1 := 1; n2 := P1 + Nums + ABS(P1 - Nums - n1) - 1; if n2 > P2 then n2 := P2; S := ' '; for n := n1 to n2 do begin if n = P1 then S := S + Format('%D ', [n]) else S := S + GetLinkStringEx(GridID, '1_' + inttostr(n), inttostr(n), '', Grid) + ' '; end;

第 126页/共 301页

result := Format(result, [S]); result := result +'去<input id=page name="textfield" type="text" size="3">页'+ '<a href="#none" onclick="ss=''0_1_''+page.value;return SubmitClickConfirm(''ComGrid'',ss, true, '''');"> Go</a>'+ Format(' 共%D' + Captions + ' 每页%D' + Captions + ' 共%D页 ', [RecordCount, RowLimit, P2]); end; //得到在网页中显示图片的代码 IPath为图片文件例如：/files/temp.jpg ISize为图片的小，中，大选项：small，med，larg。函数目的是为了显示电影图片 function pictureString(IPath, ISize: string): string; begin result := ''; IPath:=midStr(trim(IPath),2,Length(trim(IPath))); if ISize = 'small' then begin result := '<IMG height=85 src="' + IPath + '" width=85 border=0>'; exit; end; if ISize = 'med' then result := '<IMG height=150 src="' + IPath + '" width=110 border=0>' else result := '<IMG height=500 src="' + IPath + '" width=520 border=0>'; end; //显示 AFormName窗口所代表的网页，通用 function ShowForm(AFormName: string): Boolean; type TIWFormClass = class of TIWForm; var LForm: TIWForm; begin result := True; if WebApplication.FindComponent(AFormName) <> nil then begin WebApplication.SetActiveForm(WebApplication.FindComponent(AFormName) as TIWContainer); end else begin try LForm := TIWFormClass(FindClass('T' + AFormName)).Create(WebApplication); WebApplication.SetActiveForm(LForm); except result := False; end;

第 127页/共 301页

end; end; //在网页中生成一个超级链接，该链接可以传递 ID参数到窗口的 GridName的 Row行的 onclick事件的 Avalue中，同时执行该事件 function GetLinkString(Row, ID: string; Link: string; Cof: string = ''; GridName: string = 'ComGrid'): string; begin result := Format('<a href="#none" onclick="return SubmitClickConfirm(''%S'',''%s_%s'', true, ''%S'');">%S</a>', [GridName, Row, ID, Cof, Link ]); //GetLinkString('0',t,temp,cof,ComGrid) 0是对应的 ComGrid的 0行的 ComGridColumns0Click命令， temp超级连接的内容，t,传送到数据表格处理的数据 ,cof为确认对话框的提示内容，ComGrid为窗口内的名为 ComGrid的 TIWDBGrid控件。 end; function GetLinkStringEx(Row: Integer; ID, Link: string; Cof: string = ''; GridName: string = 'ComGrid'): string; begin result := Format('<a href="#none" onclick="return SubmitClickConfirm(''%S'',''%D_%S'', true, ''%S'');">%S</a>', [GridName, Row, ID, Cof, Link]); end; function GetSpace(Count: Integer): string;//在 HTML代码中增加 Count个空格 var n: Integer; begin result := ''; for n := 0 to Count do result := result + ' '; end; //此函数的目的是通过 Iquery查询到点击最多的 Icount部电影，将其显示在首页的点播排行榜的表格内。这里实现的方法是：加入每一部电影时先载入一个事先设计好的网页，即一开始我们提到的这个

表格的皮肤 files\Skin\1\HotFilm.Html，这里 Gskin 为字符 1。皮肤如图 4-1-19:（代码可以打开HotFilm.Html查看）

图 4-1-19 HotFilm.Html在 IE中的视图

再将字符 Film替换成一个超级链接，这个链接就是前面讲过的可以传递参数到窗口并调用窗口中相应函数的那种链接，这里将会调用 ComGridColumns0Click(ASender: TObject;const AValue: string)，传

第 128页/共 301页

递的参数和链接都是电影名称，例如“期待 8”。从程序运行后首页查看源代码知道，实际生成的链接为：<a href="#none" onclick="return SubmitClickConfirm('ComGrid','0_ 期待 8', true, '');"> 期待 8</a></A>。图 4-1-20为运行时的效果。

图 4-1-20 实际输出的效果

请记住，这种方式是这个程序中超级链接有服务器端事件响应的主要实现形式。 function HotFilms(IQuery: Tadoquery; ICount: Integer = 14): string; var Temp: TStringList; i: Integer; begin result := ''; Temp := TStringList.Create; IQuery.Close; IQuery.SQL.Clear; IQuery.SQL.Add('select articleid,title from Movie ORDER BY Movie.hits DESC'); IQuery.Open; if IQuery.RecordCount < ICount then ICount := IQuery.RecordCount; try for i := 1 to ICount do begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\HotFilm.Html'); Temp.Text := StringReplace(Temp.Text, 'Film', GetLinkString('0', IQuery.FieldByname('title').AsString, GetSpace(2) + IQuery.FieldByname('title').AsString), [rfReplaceAll]); IQuery.Next; result := result + Temp.Text; end; except result := Temp.Text; end; Temp.Free; end; //此函数的目的是通过 Iquery查询到时间最新的 Icount部电影，将其显示在首页的最新电影的表格内。这里实现的方法是：加入每一部电影时先载入一个事先设计好的网页，即一开始我们提到的这个表格

的皮肤 files\Skin\1\NewFilm.Html，这里 Gskin 为字符 1。皮肤如下图 4-1-21:（代码可以打开



第 129页/共 301页

NewFilm.Html查看）

图 4-1-21 NewFilm.Html在 IE中的视图

再将字符 Picture ，Film，Author，Type，Search替换成相应内容，有的有链接，有的没有，手法与HotFilms函数类似，这里不再详述。运行界面如图 4-1-22：

图 4-1-22 实际输出的效果

function NewFilms(IQuery: Tadoquery; ICount: Integer = 6): string; var Temp: TStringList; i: Integer; Pic: string; begin result := ''; Temp := TStringList.Create; IQuery.Close; IQuery.SQL.Clear; IQuery.SQL.Add('select * from Movie where IsDate(Movie.dateandtime) ORDER BY

第 130页/共 301页

datevalue(Movie.dateandtime) DESC'); IQuery.Open; try if IQuery.RecordCount < ICount then ICount := IQuery.RecordCount; for i := 1 to ICount do begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\NewFilm.Html'); Pic := pictureString(IQuery.FieldByname('url').AsString, 'small'); Temp.Text := StringReplace(Temp.Text, 'Picture', GetLinkString('0', IQuery.FieldByname('title').AsString, Pic), [rfReplaceAll]);//有超级链接，传递的参数是 title字段内容，网页上显示的是 Pic所表示的图片 Temp.Text := StringReplace(Temp.Text, 'Film', GetLinkString('0', IQuery.FieldByname('title').AsString, IQuery.FieldByname('title').AsString), [rfReplaceAll]); //有超级链接，传递的参数是 title字段内容，网页上显示的也是 title字段内容 Temp.Text := StringReplace(Temp.Text, 'Author', IQuery.FieldByname('name').AsString, [rfReplaceAll]);//没有超级链接，仅仅将 Author替换成 name字段内容 Temp.Text := StringReplace(Temp.Text, 'Type', IQuery.FieldByname('TypeID').AsString, [rfReplaceAll]); //没有超级链接，仅仅将 Type替换成 TypeID字段内容 Temp.Text := StringReplace(Temp.Text, 'Search', GetLinkString('0', IQuery.FieldByname('title').AsString, '查看详情->>'), [rfReplaceAll]); //有超级链接，传递的参数是 title字段内容，网页上显示的是“查看详情->>” IQuery.Next;//下一条记录 result := result + Temp.Text;//代码累加 end; except result := Temp.Text; end; Temp.Free; end; //播放电影 function PlayFilms(IQuery: Tadoquery; Search: string; PlayFilmNum: Integer = 0): string; var Temp: TStringList; i, j: Integer; PlayFilm, Download, FilmNumLink, PlayNumUrl: string; MovieList: Tadoquery; begin result := ''; Temp := TStringList.Create; IQuery.Close; IQuery.SQL.Clear; IQuery.SQL.Add('select * from Movie where title =' + QuotedStr(Search));

第 131页/共 301页

IQuery.Open; IQuery.Edit; //添加单击次数 IQuery.FieldByname('hits').AsInteger := IQuery.FieldByname('hits').AsInteger + 1; IQuery.Post; try begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\PlayFilm.Html'); /////////////////////////////////////////////////////////////////////////////// if IQuery.FieldByname('IsFilmNum').AsBoolean = True then begin //生成播放集数 MovieList := Tadoquery.Create(WebApplication); MovieList.Connection := UserSession.cn; MovieList.SQL.Add('select * from MovieList where title=' + QuotedStr(IQuery.FieldByname('title').AsString) + ' ORDER BY FilmNum'); MovieList.Open; i := -1; j := 2; while not MovieList.Eof do begin Inc(i); if (i = 6) or (i = 12) or (i = 18) or (i = 24) or (i = 30) or (i = 36) or (i = 42) then FilmNumLink := FilmNumLink + '' + GetSpace(2) + GetLinkString('0', MovieList.FieldByname('FilmNum').AsString, '第' + MovieList.FieldByname('FilmNum').AsString + '集') + GetSpace(2) else begin if i = 10 then j := 1; FilmNumLink := FilmNumLink + GetSpace(2) + GetLinkString('0', MovieList.FieldByname('FilmNum').AsString, '第' + MovieList.FieldByname('FilmNum').AsString + '集') + GetSpace(j); end; MovieList.Next; end; FilmNumLink := FilmNumLink + ''; ///////////////////////////////////////////////////////////////////////////////// with MovieList do begin //得到用户传来的播放集数.并获取超连接 Locate('title;FilmNum', VarArrayOf([IQuery.FieldByname('title').AsString, PlayFilmNum]), []); PlayNumUrl := FieldByname('playurl').AsString; //是播放连续剧 end; end; //if if Trim(UpperCase(IQuery.FieldByname('movietype').AsString)) = 'AVI' then begin if PlayNumUrl <> '' then begin PlayFilm := PlayAvi(PlayNumUrl); // 是播放连续剧 //电影类型判断以区分以何种播放

第 132页/共 301页

器播放电影 PlayFilm := PlayFilm + '' + FilmNumLink + ''; end else begin PlayFilm := PlayAvi(IQuery.FieldByname('domurl').AsString); PlayFilm := PlayFilm + '' + FilmNumLink + ''; end; end else begin if PlayNumUrl <> '' then begin //RM PlayFilm := PlayRM(PlayNumUrl); // 是播放连续剧 PlayFilm := PlayFilm + GetSpace(28) + '<a href="javascript:setFull()" >【全屏】</a>'; PlayFilm := PlayFilm + '' + FilmNumLink + ''; end else begin PlayFilm := PlayRM(IQuery.FieldByname('domurl').AsString); PlayFilm := PlayFilm + GetSpace(28) + '<a href="javascript:setFull()" >【全屏】</a>'; PlayFilm := PlayFilm + '' + FilmNumLink + ''; end; end; Temp.Text := StringReplace(Temp.Text, 'PlayFilm', PlayFilm, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'title', IQuery.FieldByname('title').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'author', IQuery.FieldByname('name').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'type', IQuery.FieldByname('TypeId').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'where', IQuery.FieldByname('where').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'howlong', IQuery.FieldByname('howlong').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'hit', IQuery.FieldByname('hits').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'datetime', IQuery.FieldByname('dateandtime').AsString, [rfReplaceAll]); Temp.Text := StringReplace(Temp.Text, 'memo', IQuery.FieldByname('content').AsString, [rfReplaceAll]); Download := '本站暂不提供下载!'; Temp.Text := StringReplace(Temp.Text, 'download', Download, [rfReplaceAll]); result := Temp.Text; end; except result := Temp.Text;

第 133页/共 301页

end; MovieList.Free; Temp.Free; end; function IWServerController: TIWServerController;//系统自动生成 begin result := TIWServerController(GServerController); end; function UserSession: TIWUserSession; //系统自动生成 begin result := TIWUserSession(WebApplication.Data); end; procedure TIWServerController.IWServerControllerBaseNewSession(ASession: TIWApplication; var VMainForm: TIWBaseForm);//当有一个新的 Session生成时执行此函数。 begin ASession.Data := TIWUserSession.Create(nil); with UserSession do begin Skin := ASession.Request.CookieFields.Values['Skin']; //载入旧风格 if (Skin = '') or (not DirectoryExists(ASession.ApplicationPath + 'Files\Skin\' + Skin)) then Skin := '1'; //设置默认风格 GSkin := Skin;//将皮肤文件夹名赋值给全局变量GSkin end; end; procedure TIWServerController.IWServerControllerBaseBackButton( ASubmittedSequence, ACurrentSequence: Integer; AFormName: string; var VHandled, VExecute: Boolean);//使 IE的后退按钮有效，通过代码 const DefaultFormName = 'MainForm'; type TIWFormClass = class of TIWForm; var LForm: TIWForm; begin VHandled := True; VExecute := True; if AFormName = '' then AFormName := DefaultFormName; if WebApplication.FindComponent(AFormName) <> nil then begin WebApplication.SetActiveForm(WebApplication.FindComponent(AFormName) as



第 134页/共 301页

TIWContainer); end else begin try LForm := TIWFormClass(FindClass('T' + AFormName)).Create(WebApplication); WebApplication.SetActiveForm(LForm); except VHandled := False; end; end; end; //当 ServerController生成时执行此函数，这是程序最先运行的函数。 procedure TIWServerController.IWServerControllerBaseCreate(Sender: TObject); var VLIst: TStringList; begin if not FileExists(GServerController.AppPath + 'files\FilmSystem.ini') then//如果FilmSystem.ini文件不存在则创建该文件并向其中写入 4组数据作为系统默认数据 begin VLIst := TStringList.Create; with VLIst do begin Values['Port'] := '8080'; Values['New'] := '4'; Values['Hot'] := '14'; Values['effect'] := 'false'; end; VLIst.SaveToFile(GServerController.AppPath + 'files\FilmSystem.ini'); VLIst.Free; end; VLIst := TStringList.Create; VLIst.LoadFromFile(GServerController.AppPath + 'files\FilmSystem.ini');//读出该文件内容 self.Port := Strtoint(IIF(VLIst.ValueFromIndex[0], '8080'));//给程序绑定的端口赋值，如果VLIst.ValueFromIndex[0]为空，则赋值为 8080 VLIst.Free; self.CacheDir := self.GetAppPath + 'cache';//设定程序的 CacheDir目录 self.BoundIP:=GetLocalIP;//自动绑定本机 IP，GetLocalIP函数将得到本机 IP，如果没有网络环境，IP为 127.0.0.1 end; //当 Session结束时，释放 UserSession.cn，即该 UserSession创建的数据库连接 procedure TIWServerController.IWServerControllerBaseCloseSession( ASession: TIWApplication); begin UserSession.cn.Free;



第 135页/共 301页

end; initialization TIWServerController.SetServerControllerClass; end.

4.1.2.2 UserSessionUnit单元这个单元很特别。每个用户都拥有这样一个独立的单元，保存在其内的数据不会被别的用户浏览。

所以我们把数据组件放在这里，以保证各用户数据的私有性。各页面要传递的参数我们也事先在这里

设定，要传递的窗口给它赋值，接收的窗口从它取值即可。图 4-1-23为编程时的窗口界面。

图 4-1-23 UserSessionUnit单元编程时的窗口界面

unit UserSessionUnit; interface uses IWUserSessionBase, IWApplication, SysUtils, Classes, DB, ADODB, IWContainer; type TIWUserSession = class(TIWUserSessionBase) NewFilm: Tadoquery; HotFilm: Tadoquery; ListFilm: Tadoquery; ListFilmSource: TDataSource; PlayFlim: Tadoquery; qryUserTable: Tadoquery; dsUserTable: TDataSource; procedure IWUserSessionBaseCreate(Sender: TObject); private { Private declarations } public //以下就是用来传递参数的变量，换种说法：也就是这个程序中只对当前拥有该 Session 用户有效的全局变量 Skin, isEditAppendFilm: string; //是否添加电影 Film: string; //电影名 PlayFilmNum: Integer; //电影连续剧的集数，第 PlayFilmNum集 FilmType: string;//电影分类 FilmSearch: string;//电影搜索字串 FromEdt, ToEdt: Integer; UpFilm: string;

第 136页/共 301页

IsFresh: Boolean; isEditAppendUser: string; //是否添加用户 IsRegUser, IsAdmin: Boolean;//是否是注册用户，是否是管理员 UserLoginName: string;//用户登录名 cn: TADOConnection;//共用数据库连接 procedure closesessoion; //响应 IE的关闭事件，关闭所有窗口 { Public declarations} end; implementation uses IWInit,ServerController; {$R *.dfm} //当 Session创建时执行 procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject); var i: Integer; begin //创建全局数据连接，关闭 Session时将释放 cn := TADOConnection.Create(self); cn.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + IWServerController.AppPath + 'database\imovie.mdb;Persist Security Info=False';//连接数据库imovie.mdb的连接字串 cn.Open;//打开连接 for i := 0 to self.ComponentCount - 1 do begin//给这个窗口中的所有 Tadoquery控件指定数据库连接为 cn if (self.Components[i] is Tadoquery) then begin (self.Components[i] as Tadoquery).Connection := cn; end; end; end; //关闭所有的窗口，如果它们被创建了的话 procedure TIWUserSession.closesessoion; begin try//按窗口名查找，如果不为空则关闭它 if (WebApplication.FindComponent('AdminForm') as TIWContainer) <> nil then (WebApplication.FindComponent('AdminForm') as TIWContainer).free; if (WebApplication.FindComponent('ListForm') as TIWContainer) <> nil then (WebApplication.FindComponent('ListForm') as TIWContainer).free; if (WebApplication.FindComponent('ModiforAddForm') as TIWContainer) <> nil then (WebApplication.FindComponent('ModiforAddForm') as TIWContainer).free; if (WebApplication.FindComponent('PlayForm') as TIWContainer) <> nil then

第 137页/共 301页

(WebApplication.FindComponent('PlayForm') as TIWContainer).free; if (WebApplication.FindComponent('RegForm') as TIWContainer) <> nil then (WebApplication.FindComponent('RegForm') as TIWContainer).free; if (WebApplication.FindComponent('SystemForm') as TIWContainer) <> nil then (WebApplication.FindComponent('SystemForm') as TIWContainer).free; if (WebApplication.FindComponent('UserForm') as TIWContainer) <> nil then (WebApplication.FindComponent('UserForm') as TIWContainer).free; if (WebApplication.FindComponent('MainForm') as TIWContainer) <> nil then (WebApplication.FindComponent('MainForm') as TIWContainer).free; except Exit; end; end; end.

4.1.2.3 FBaseform单元这个窗口是用来被继承的。所有继承它的窗口都有这个窗口中的元素。所以运行时每个窗口对应

生成的网页都会有这些元素，如果它们的 visible属性不为 false的话。这个窗口有如下功能： 1、供用户输入用户名和密码后登录，如果是普通用户则正常登录，如果是管理员则登录后显示用

于管理的超级链接。点击该超级链接将调用站内管理按钮的 onclick事件代码。 2、点击注册按钮后进入注册页面。 3、可以输入电影名的关键词，点击搜索按钮来进行搜索。 4、为每一继承它的窗口设定 IWTemplateProcessorHTML1 内的 HTML 模板，图 4-1-24 为

Baseform窗口界面。

图 4-1-24 Baseform窗口界面

在窗口的 javascript属性中加入如下代码：(让超级链接在鼠标放上去时自动改变颜色)

var rate = 30; var obj; var act = 0; var elmH = 0; var elmS = 128; var elmV = 255; var clrOrg;



第 138页/共 301页

var TimerID; if (navigator.appName.indexOf("Microsoft",0) != -1 && parseInt(navigator.appVersion) >= 4) { Browser = true; } else { Browser = false; } if (Browser) { document.onmouseover = doRainbowAnchor; document.onmouseout = stopRainbowAnchor; } function doRainbow() { if (Browser && act != 1) { act = 1; obj = event.srcElement; clrOrg = obj.style.color; TimerID = setInterval("ChangeColor()",100); } } function stopRainbow() { if (Browser && act != 0) { obj.style.color = clrOrg; clearInterval(TimerID); act = 0; } } function doRainbowAnchor() { if (Browser && act != 1) { obj = event.srcElement; while (obj.tagName != 'A' && obj.tagName != 'BODY') { obj = obj.parentElement; if (obj.tagName == 'A' || obj.tagName == 'BODY') break; } if (obj.tagName == 'A' && obj.href != '') { act = 1; clrOrg = obj.style.color; TimerID = setInterval("ChangeColor()",100); }

第 139页/共 301页

} } function stopRainbowAnchor() { if (Browser && act != 0) { if (obj.tagName == 'A') { obj.style.color = clrOrg; clearInterval(TimerID); act = 0; } } } function ChangeColor() { obj.style.color = makeColor(); } function makeColor() { if (elmS == 0) { elmR = elmV; elmG = elmV; elmB = elmV; } else { t1 = elmV; t2 = (255 - elmS) * elmV / 255; t3 = elmH % 60; t3 = (t1 - t2) * t3 / 60; if (elmH < 60) { elmR = t1; elmB = t2; elmG = t2 + t3; } else if (elmH < 120) { elmG = t1; elmB = t2; elmR = t1 - t3; } else if (elmH < 180) { elmG = t1; elmR = t2; elmB = t2 + t3; } else if (elmH < 240) { elmB = t1; elmR = t2; elmG = t1 - t3; } else if (elmH < 300) { elmB = t1; elmG = t2; elmR = t2 + t3; } else if (elmH < 360) { elmR = t1; elmG = t2; elmB = t1 - t3;



第 140页/共 301页

} else { elmR = 0; elmG = 0; elmB = 0; } } elmR = Math.floor(elmR); elmG = Math.floor(elmG); elmB = Math.floor(elmB); clrRGB = '#' + elmR.toString(16) + elmG.toString(16) + elmB.toString(16); elmH = elmH + rate; if (elmH >= 360) elmH = 0; return clrRGB; } function Check_Search() { if (SEARCHEDITIWCL.value=="") { alert("请输入查询条件!"); SEARCHEDITIWCL.focus(); return false; } SubmitClickConfirm('SEARCH','', true, ''); } function Check_Users() { var obj = USERIDIWCL; if (obj.value== "") { alert("用户名不能空!"); obj.focus(); return false; } var obj = PASSIWCL; if (obj.value== "") { alert("密码不能空!"); obj.focus(); return false; } SubmitClickConfirm('LOGIN','', true, ''); }

第 141页/共 301页

在登录按钮中的 scriptevents属性的 onclick事件中加入如下代码：（Check_Users函数在上面的javascript代码中实现）

Check_Users(); 在搜索按钮中的 scriptevents属性的 onclick事件中加入如下代码：（Check_Search函数在上面的

javascript代码中实现） Check_Search();

unit FBaseform; {页面进入和退出的特效进入页面<meta http-equiv="Page-Enter" content="revealTrans(duration=x, transition=y)"> 退出页面<meta http-equiv="Page-Exit" content="revealTrans(duration=x, transition=y)"> 这个是页面被载入和调出时的一些特效。duration表示特效的持续时间，以秒为单位。transition表示使用哪种特效，取值为 1-23: 0 矩形缩小 1 矩形扩大 2 圆形缩小 3 圆形扩大 4 下到上刷新 5 上到下刷新 6 左到右刷新 7 右到左刷新 8 竖百叶窗 9 横百叶窗 10 错位横百叶窗 11 错位竖百叶窗 12 点扩散 13 左右到中间刷新 14 中间到左右刷新 15 中间到上下 16 上下到中间 17 右下到左上 18 右上到左下 19 左上到右下 20 左下到右上 21 横条 22 竖条 23 以上 22种随机选择一种} interface uses Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompLabel, IWCompButton, IWCompRectangle, IWGrids, IWDBGrids, ADODB, DB; type TBaseForm = class(TIWAppForm) UserID: TIWEdit; PASS: TIWEdit; IWTemplateProcessorHTML1: TIWTemplateProcessorHTML; Login: TIWButton; Reg: TIWButton; Label1: TIWRectangle; Label2: TIWRectangle; Search: TIWButton; Searchedit: TIWEdit; Sysbtn: TIWButton; ComGrid0: TIWDBGrid; procedure IWAppFormRender(Sender: TObject); procedure LoginClick(Sender: TObject); procedure RegClick(Sender: TObject);

第 142页/共 301页

procedure SearchClick(Sender: TObject); procedure SysbtnClick(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: string); public end; implementation uses ServerController, Fadminform, FControl, FRegForm, FSystem, FlistForm, UserSessionUnit; {$R *.dfm} //在页面输出前执行。 procedure TBaseForm.IWAppFormRender(Sender: TObject); procedure changeface;//这个函数的子函数，如果登录已成功，则改变一些控件的属性 var closestr: string; begin closestr := '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''');window.alert('' 欢迎下次再来！'');}</script>'; // closestr字符串将会被组装到这个窗口要生成的 HTML文件中，由于是 script代码，所以不可见。目的是捕获 IE的关闭事件，将通过 SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''')函数调用窗口中的 ComGrid0控件的索引为 0行的 onclick事件来执行 UserSession.closesessoion函数，以此关闭所有生成的窗口。 Login.Visible := False; Reg.Visible := False; UserID.Visible := False; PASS.Visible := False; Label2.Visible := False; Label1.Text := '' + GetHourStr + '好,' + UserSession.UserLoginName + '' + closestr;//在此出现问候代码并组装 closestr字符串 if UserSession.IsAdmin then begin//如果是管理员 Label2.Visible := True; Label2.Text := '<a href="#none" onclick="return SubmitClickConfirm(''SYSBTN'','''', true, '''');">【站内管理】</a>';//显示站内管理超级链接，通过 SubmitClickConfirm(''SYSBTN'','''', true, '''')将调用SYSBTN按钮的 onclick事件代码。 end; end; var VLIst: TStringList; closestr: string; begin closestr := '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''');window.alert(''欢迎下次再来！'');}</script>'; Label1.Text := '用户' + closestr; VLIst := TStringList.Create;

第 143页/共 301页

VLIst.LoadFromFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini'); //导入系统的相关信息 StyleSheet.Filename := 'Files\Skin\' + UserSession.Skin + '\style.css'; IWTemplateProcessorHTML1.Templates.Default := UserSession.Skin + '\' + WebApplication.ActiveForm.Name + '.Html';//指定本窗口的HTML模板文件，默认目录已为 templates if StrToBoolDef(VLIst.ValueFromIndex[3], False) then //是否支持页面特效 ExtraHeader.Text := '<meta HTTP-EQUIV="Page-Enter" CONTENT="revealtrans(duration=0.5, transition=23)">';//在网页的 Header中嵌入网页特效代码 VLIst.Free; if UserSession.IsRegUser then changeface; //如果是注册会员的话改变页面 end; //点击登录按钮 procedure TBaseForm.LoginClick(Sender: TObject); begin with UserSession.qryUserTable do begin//调用 UserSession.qryUserTable进行查询处理 Close; SQL.Clear; SQL.Add('select * from usertables where userid=:1 and passwords=:2'); Parameters[0].Value := UserID.Text; Parameters[1].Value := PASS.Text; Open; if not IsEmpty then begin if FieldByname('admin').AsBoolean = True then begin //如果是管理员，给 UserSession中的共用参数赋值 UserSession.IsAdmin := True; UserSession.IsRegUser := True; UserSession.UserLoginName := UserID.Text; if not ShowForm('SystemForm') then TSystemForm.Create(WebApplication).Show;//显示管理界面 end else begin //如果是普通用户，给 UserSession中的共用参数赋值 UserSession.IsRegUser := True; UserSession.UserLoginName := UserID.Text; end; Edit; // 编辑数据库改变登录次数 FieldByname('LoginCount').AsInteger := FieldByname('LoginCount').AsInteger + 1; Post; end else begin//如果数据查询为 0条记录则给出提示信息 WebApplication.ShowMessage('系统无此用户名,请确定用户名,和密码输入是否正确!'); end; end;



第 144页/共 301页

//以下清空三个转入框 UserID.Text := ''; PASS.Text := ''; Searchedit.Text := ''; end; //点击注册按钮后进入注册页面 procedure TBaseForm.RegClick(Sender: TObject); begin if not ShowForm('RegForm') then TRegForm.Create(WebApplication).Show; end; procedure TBaseForm.SearchClick(Sender: TObject);//点击搜索按钮来进行搜索 begin UserSession.FilmSearch := Searchedit.Text;//给 UserSession中的 FilmSearch参数赋值 Searchedit.Text := '';//清空输入 if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show;//显示电影列表页面，这个窗口将自动提取 UserSession.FilmSearch的值进行数据查询后显示结果。 end; //点击站内管理按钮打开管理页面 procedure TBaseForm.SysbtnClick(Sender: TObject); begin if not ShowForm('SystemForm') then TSystemForm.Create(WebApplication).Show; end; //被页面的 SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''')调用 procedure TBaseForm.ComGrid0Columns0Click(ASender: TObject;const AValue: string); begin UserSession.closesessoion;//关闭所有生成的窗口，并结束这个 Session end; end.

4.1.2.4 FMainForm单元这是主页面，程序运行时显示的第一个页面。这是从窗口 BaseForm 继承的。在这个窗口中新加

了三个控件：NewFilm: TIWRectangle， HotFilm: TIWRectangle， ComGrid: TIWDBGrid。我们将在 NewFilm 中输出最新电影列表，在 HotFilm 中输出点击排行榜电影列表。ComGrid 是用来编写页面超级链接所要引用的窗口函数的。窗口界面如图 4-1-25：



第 145页/共 301页

图 4-1-25 MainForm窗口界面

unit FMainForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompLabel, IWCompButton, IWCompRectangle, IWGrids, IWDBGrids, IWCompListbox; type TMainForm = class(TBaseForm) NewFilm: TIWRectangle; ComGrid: TIWDBGrid; HotFilm: TIWRectangle; procedure IWAppFormRender(Sender: TObject); procedure ComGridColumns0Click(ASender: TObject; const AValue: string); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure IWAppFormCreate(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public

NewFilm: TIWRectangle

HotFilm: TIWRectangle

ComGrid: TIWDBGrid

第 146页/共 301页

{ Public declarations } end; var MainForm: TMainForm; implementation uses ServerController, FlistForm, FplayForm, FSystem; {$R *.dfm} procedure TMainForm.IWAppFormRender(Sender: TObject); var VLIst: TStringList; New, Hot: Integer; begin inherited; VLIst := TStringList.Create; VLIst.LoadFromFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini');// 读取

FilmSystem.ini文件中我们设置的显示新电影的部数和显示点击排行榜的电影部数。 New := Strtoint(IIF(VLIst.ValueFromIndex[1], '4')); Hot := Strtoint(IIF(VLIst.ValueFromIndex[2], '14')); VLIst.Free; NewFilm.Text := NewFilms(UserSession.NewFilm, New);//调用在 ServerController 单元中的NewFilms函数生成最新电影列表的 HTML代码，大家可以查看原函数。 HotFilm.Text := HotFilms(UserSession.HotFilm, Hot); //调用在 ServerController单元中的 HotFilms函数，生成点击排行榜电影列表的 HTML代码，大家可以查看原函数。 end; //页面上实现播放功能的超级链接所调用的函数。 procedure TMainForm.ComGridColumns0Click(ASender: TObject; const AValue: string); begin inherited; UserSession.Film := AValue;//给 UserSession中的 Film参数赋值，Avalue是从页面传递来的电影名，页面中的函数为 SubmitClickConfirm('ComGrid','0_舞街,绝对经典', true, '')，第二个参数下划线后的字串将会赋值给 Avalue。从这里可以看出，这个窗口要传递电影名给 PlayForm 窗口是通过

UserSession中的 Film参数来实现的。 if not ShowForm('PlayForm') then TPlayForm.Create(WebApplication).Show;//显示播放页面，自动播放电影名为 UserSession.Film的电影。 end; //这个函数是用来响应页面的电影分类超级链接的。页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TMainForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin



第 147页/共 301页

inherited; if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue;// 给 UserSession中的 FilmType参数赋值 if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show; //显示电影列表页面，按以下电影分类 UserSession.FilmType查询电影。 end; end; //这是一个可以不要的函数，当 IE中输入 http://IP:端口/?admin=administrator时，页面打开后是管理员的身份。这相当于一个后门吧。 procedure TMainForm.IWAppFormCreate(Sender: TObject); var IsAdmin: string; begin inherited; IsAdmin := WebApplication.RunParams.Values['admin'];//取得从 IE地址栏传递过来的 admin参数的值 if IsAdmin = 'administrator' then begin UserSession.IsAdmin := True; UserSession.IsRegUser := True; UserSession.UserLoginName := '管理员'; end; end; initialization TMainForm.SetAsMainForm; RegisterClass(TMainForm); end.

4.1.2.5 FlistForm单元这个页面用来显示查询（点击查询按钮或点击分类超级链接）到的电影列表。这是从窗口BaseForm

继承的。在这个窗口中新加了三个控件：ListGrid: TIWDBGrid， Page: TIWRectangle，ComGrid: TIWDBGrid。ListGrid 中将显示电影列表，Page 中将显示分页导航条，ComGrid 用来响应页面的中的相应超级链接。窗口界面如图 4-1-26：



第 148页/共 301页

图 4-1-26 ListForm窗口界面

unit FlistForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWGrids, IWDBGrids; type TListForm = class(TBaseForm) ListGrid: TIWDBGrid; Page: TIWRectangle; ComGrid: TIWDBGrid; procedure IWAppFormRender(Sender: TObject); procedure ListGridRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); procedure ComGridColumns0Click(ASender: TObject; const AValue: string); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ComGridColumns2Click(ASender: TObject; const AValue: string); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations }

ListGrid: TIWDBGrid

Page: TIWRectangle

ComGrid: TIWDBGrid

第 149页/共 301页

public FilmType: string; { Public declarations } end; var ListForm: TListForm; implementation uses ServerController, FplayForm, FMainForm; {$R *.dfm} //页面输出前执行，分三种情况进行查找 procedure TListForm.IWAppFormRender(Sender: TObject); begin inherited; if UserSession.FilmSearch <> '' then begin //查找 1，如果搜索字符串不为空，按电影名称查找 with UserSession.ListFilm do begin Close; SQL.Clear; SQL.Add('select * from movie where title like' + QuotedStr('%' + UserSession.FilmSearch + '%')); Open; end; UserSession.FilmSearch := ''; end; if (UserSession.FilmType <> '') and (UserSession.FilmType <> 'All') then begin//查找 2，如果电影类型不为空且不为 All，则按电影类型查找 with UserSession.ListFilm do begin Close; SQL.Clear; SQL.Text := 'select * from movie where typeid=''' + UserSession.FilmType + ''' and IsDate(Movie.dateandtime) ORDER BY datevalue(Movie.dateandtime) DESC'; Open; end; end; if UserSession.FilmType = 'All' then begin//查找 3，如果电影类型为 All，则显示所有电影 with UserSession.ListFilm do begin Close; SQL.Clear; SQL.Text := 'select * from movie '; Open; end; end;



第 150页/共 301页

UserSession.FilmType := '';//清空给电影类型的赋值 ListGrid.DataSource := UserSession.ListFilmSource;//给 ListGrid.DataSource赋值，下面这个函数ListGridRenderCell执行才有意义 Page.Text := GetToolStr(ListGrid.DataSource.DataSet.RecNo, ListGrid.DataSource.DataSet.RecordCount, ListGrid.RowLimit, 0, 6, ' 部电影 ');// 调用在ServerController单元中的 GetToolStr函数，在 Page框中生成分页导航条，请查看 ServerController单元内的原函数说明。 end; //当 ListGrid 在页面中输出前执行，在 IWAppFormRender 执行之后执行。目的是给表格手工赋值，请仔细研究学会使用。ListGrid已经被设定成只有一列，在其 columns属性中可以看到。 procedure TListForm.ListGridRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); var Temp: TStringList; Pic: string; Memo: string; begin inherited; Temp := TStringList.Create; try if ListGrid.DataSource.DataSet.IsEmpty then//如果查询到的电影数量为 0，则退出 exit; if (AColumn = 0) and (ARow > 0) then//确保是在 ListGrid第一列，从第三行开始 begin with ListGrid.DataSource.DataSet do begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\ListFilm.Html');//导入模板 ListFilm.Html，显示效果如图 4-1-27（相当于 ListGrid的每一个 cell 中输入一个表格）。格式化显示 ListGrid.DataSource.DataSet的一条记录。

图 4-1-27 ListFilm.Html在 IE中的视图 Pic := ''; Memo := Pic; Pic := pictureString(FieldByname('url').AsString, 'med');//生成显示图片的 HTML代码 if Length(FieldByname('content').AsString) >= 250 then//电影介绍如果超过 250个则用....代

第 151页/共 301页

替 Memo := Copy(FieldByname('content').AsString, 0, 250) + '....' else Memo := FieldByname('content').AsString; Temp.Text := StringReplace(Temp.Text, 'Pic', GetLinkString('2', FieldByname('title').AsString, Pic), [rfReplaceAll]);// 有超级链接，传递的参数是 title字段内容，网页上显示的是 Pic所表示的图片 Temp.Text := StringReplace(Temp.Text, 'title', GetLinkString('2', FieldByname('title').AsString, FieldByname('title').AsString), [rfReplaceAll]); //有超级链接，传递的参数是 title字段内容，网页上显示的是 title字段内容 Temp.Text := StringReplace(Temp.Text, 'Author', FieldByname('name').AsString, [rfReplaceAll]);// 没有超级链接，仅将 Author替换成 Author字段内容 Temp.Text := StringReplace(Temp.Text, 'Memo', Memo, [rfReplaceAll]); // 没有超级链接，仅将 Memo替换成Memo所代表的 content字段内容 ACell.Text := Temp.Text;//给当前 cell赋值 end; end; except ACell.Text := Temp.Text; end; Temp.Free; end; procedure TListForm.ComGridColumns0Click(ASender: TObject; const AValue: string); begin inherited; SetPage(ListGrid, AValue); // 调用在 ServerController单元中的 SetPage函数，响应在 Page框中生成的分页导航条链接，跳到相应页面。请查看 ServerController单元内的原函数说明。 end; //这个函数是用来响应页面的电影分类超级链接的。页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TListForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin inherited; if AValue = 'MainForm' then//点击首页时 begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue;//点击其它分类链接时 end; end;



第 152页/共 301页

//当点击图片和电影标题的链接时执行播放电影界面 procedure TListForm.ComGridColumns2Click(ASender: TObject;const AValue: string); begin inherited; if not ShowForm('PlayForm') then TPlayForm.Create(WebApplication).Show; UserSession.Film := AValue;//给 PlayForm窗口传递电影名 end; initialization RegisterClass(TListForm); end.

4.1.2.6 FRegForm单元这个页面用来进行新用户注册和修改注册信息。这是从窗口 BaseForm 继承的。在这个窗口中新

加了 8 个控件：RegBtn: TIWButton，ResetBtn: TIWButton， Boy: TIWRadioButton，Girl: TIWRadioButton， CheckPass: TIWEdit，UserName: TIWEdit，PassWord: TIWEdit，Email: TIWEdit，ComGrid: TIWDBGrid。RegBtn是添加按钮，ResetBtn是返回按钮，ComGrid用来响应页面的中的相应超级链接，其余的就不用介绍了。窗口界面如图 4-1-28：

图 4-1-28 RegForm窗口界面

unit FRegForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWCompRadioButton, IWDBStdCtrls,

ComGrid: TIWDBGrid



第 153页/共 301页

DB, ADODB, IWGrids, IWDBGrids; type TRegForm = class(TBaseForm) RegBtn: TIWButton; ResetBtn: TIWButton; Boy: TIWRadioButton; Girl: TIWRadioButton; CheckPass: TIWEdit; UserName: TIWEdit; PassWord: TIWEdit; Email: TIWEdit; ComGrid: TIWDBGrid; procedure RegBtnClick(Sender: TObject); procedure IWAppFormRender(Sender: TObject); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ResetBtnClick(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public procedure Textclear; { Public declarations } end; var RegForm: TRegForm; implementation uses ServerController, FMainForm, FlistForm, FSystem; {$R *.dfm} //清除所有输入框中的字符 procedure TRegForm.Textclear; var i: Integer; begin for i := 0 to self.ComponentCount - 1 do begin if (self.Components[i] is TIWEdit) then (self.Components[i] as TIWEdit).Text := ''; end; end; //按下添加按钮后执行 procedure TRegForm.RegBtnClick(Sender: TObject); function GetSex: string;//得到用户所选择的性别，这是一个子函数 begin



第 154页/共 301页

if Boy.Checked = True then result := '男' else result := '女'; end; var TemUserTable: Tadoquery; begin inherited; TemUserTable := Tadoquery.Create(self);//创建临时查询表 TemUserTable.Connection :=UserSession.cn; if RegBtn.Caption = '添加' then begin//如果 RegBtn按钮显示为添加时，则执行插入一个新记录 try with TemUserTable do begin Close; SQL.Clear; SQL.Add('insert into Usertables(userid,passwords,sex,email,Regtime) values(:1,:2,:3,:4,:5)'); Parameters[0].Value := Trim(UserName.Text); Parameters[1].Value := Trim(PassWord.Text); Parameters[2].Value := GetSex; Parameters[3].Value := Trim(Email.Text); Parameters[4].Value := DateToStr(Date); ExecSQL; WebApplication.ShowMessage('恭喜注册成功'); end; except UserName.Text := UserSession.qryUserTable.SQL.Text;//如果插入不成功，则表示有重名了 WebApplication.ShowMessage('用户名重复,请重新输入!'); end; end else begin//如果 RegBtn按钮不显示为添加时（显示为修改），则执行修改用户记录 try with TemUserTable do begin Close; SQL.Clear; SQL.Add('Update Usertables set Passwords=:1,Sex=:2,email=:3 where userid=:4'); Parameters[0].Value := Trim(PassWord.Text); Parameters[1].Value := GetSex; Parameters[2].Value := Trim(Email.Text); Parameters[3].Value := Trim(UserName.Text); ExecSQL; WebApplication.ShowMessage('恭喜修改成功'); end;

第 155页/共 301页

except end; end; TemUserTable.Free; end; //输出该网页时执行 procedure TRegForm.IWAppFormRender(Sender: TObject); procedure SetSex(Istring: string);//得到用户所选择的性别 begin if Istring = '男' then Boy.Checked := True else Girl.Checked := True; end; begin inherited; if UserSession.isEditAppendUser <> '' then begin//如果是修改用户时 RegBtn.Caption := '修改'; with UserSession.qryUserTable do begin UserName.Text := FieldByname('userid').AsString; PassWord.Text := FieldByname('Passwords').AsString; CheckPass.Text := FieldByname('Passwords').AsString; Email.Text := FieldByname('email').AsString; SetSex(FieldByname('Sex').AsString); end; UserName.ReadOnly := True;//用户名不让改 UserSession.isEditAppendUser := ''; end else begin//如果是添加用户 RegBtn.Caption := '添加'; Textclear;//清除所有输入框中的字符 UserName.ReadOnly := False; //用户名输入框可以编辑 end; end; //这个函数是用来响应页面的电影分类超级链接的。例如爱情片的页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TRegForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin inherited; if AValue = 'MainForm' then//点击首页时 begin



第 156页/共 301页

if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show; end; end; procedure TRegForm.ResetBtnClick(Sender: TObject);//回到首页 begin inherited; if not ShowForm('MainForm') then TSystemForm.Create(WebApplication).Show; end; end; initialization RegisterClass(TRegForm); end.

4.1.2.7 FplayForm单元这个页面用来进行播放电影的界面。这是从窗口 BaseForm继承的。在这个窗口中新加了 2个控

件：PlayFilm: TIWRectangle，ComGrid: TIWDBGrid，PlayFilm 中将输出播放电影的播放器和相关的电影信息，将调用 ServerController单元中的 PlayFilms函数来生成 HTML代码，ComGrid用来响应页面的中的相应超级链接。窗口界面如图 4-1-29：

图 4-1-29 playForm窗口界面

unit FplayForm;

ComGrid: TIWDBGrid

PlayFilm: TIWRectangle



第 157页/共 301页

interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWGrids, IWDBGrids; type TPlayForm = class(TBaseForm) PlayFilm: TIWRectangle; ComGrid: TIWDBGrid; procedure IWAppFormRender(Sender: TObject); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ComGridColumns0Click(ASender: TObject; const AValue: string); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public { Public declarations } end; var PlayForm: TPlayForm; implementation uses ServerController, FMainForm, FlistForm; {$R *.dfm} procedure TPlayForm.IWAppFormRender(Sender: TObject); begin inherited; if UserSession.IsRegUser then//如果是注册用户，则调用 ServerController单元中的 PlayFilms函数来生成 HTML代码，请参考 ServerController单元相应代码 PlayFilm.Text := PlayFilms(UserSession.PlayFlim, UserSession.Film, UserSession.PlayFilmNum) else PlayFilm.Text := '请注册后才可以观看电影!'; UserSession.PlayFilmNum := 0;//将播放集数设为 0 end; //请参考前一单元 procedure TPlayForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin inherited;



第 158页/共 301页

if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show; end; end; //响应此页中播放集数的超级链接 procedure TPlayForm.ComGridColumns0Click(ASender: TObject; const AValue: string); begin inherited; UserSession.PlayFilmNum := Strtoint(AValue);//给播放集数赋值 end; initialization RegisterClass(TPlayForm); end.

4.1.2.8 FSystem单元这个页面用来设定 files\FilmSystem.ini 文件内容的，也是系统的一些设定参数。这是从窗口

BaseForm 继承的。在这个窗口中新加了 9 个控件：EdtPort: TIWEdit，EdtNewFilm: TIWEdit，EdtHotFilm: TIWEdit， FilmControl: TIWRectangle，UserControl: TIWRectangle，IWCheckBox1: TIWCheckBox，AffirmBtn: TIWButton，ReturnBtn: TIWButton，ComGrid: TIWDBGrid;，EdtPort为输入端口，EdtNewFilm 为首页最新电影列表记录数，EdtHotFilm 为首页万里排行榜电影列表的记录数，FilmControl 输出电影控制的超级链接：【添加】【修改,删除】，UserControl 输出用户控制的超级链接：【添加】【修改,删除】，IWCheckBox1设定是否使用页面特效，AffirmBtn 保存信息，ReturnBtn 返回显示首页，ComGrid用来响应页面的中的相应超级链接。窗口界面如图 4-1-30：



第 159页/共 301页

图 4-1-30 SystemForm窗口界面

unit FSystem; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWCompCheckbox, IniFiles, IWGrids, IWDBGrids, Iwhtmltag; type TSystemForm = class(TBaseForm) EdtPort: TIWEdit; EdtNewFilm: TIWEdit; EdtHotFilm: TIWEdit; FilmControl: TIWRectangle; UserControl: TIWRectangle; IWCheckBox1: TIWCheckBox; AffirmBtn: TIWButton; ReturnBtn: TIWButton; ComGrid: TIWDBGrid; procedure IWAppFormRender(Sender: TObject); procedure AffirmBtnClick(Sender: TObject); procedure IWAppFormCreate(Sender: TObject); procedure ComGridColumns2Click(ASender: TObject; const AValue: string); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ComGridColumns3Click(ASender: TObject; const AValue: string); procedure EdtPortHTMLTag(ASender: TObject; ATag: TIWHTMLTag); procedure ReturnBtnClick(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public myinifile: TInifile; { Public declarations } end; var SystemForm: TSystemForm; implementation uses FRegForm, ServerController, FplayForm, FMainForm, FlistForm, FControl, Fadminform, FUserForm;



第 160页/共 301页

{$R *.dfm} procedure TSystemForm.IWAppFormRender(Sender: TObject); var VLIst: TStringList; begin inherited; VLIst := TStringList.Create; VLIst.LoadFromFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini'); //导入 files\FilmSystem.ini文件内容，分别填入以下 4个输入框中，如果值为空，则雨填入默认值。 EdtPort.Text := IIF(VLIst.ValueFromIndex[0], '8080'); EdtNewFilm.Text := IIF(VLIst.ValueFromIndex[1], '4'); EdtHotFilm.Text := IIF(VLIst.ValueFromIndex[2], '14'); IWCheckBox1.Checked := StrToBoolDef(VLIst.ValueFromIndex[3], False); VLIst.Free; FilmControl.Text := GetSpace(1) + GetLinkString('2', 'append', '【添加】 ') + GetSpace(1) + GetLinkString('2', 'appendOrDelete', '【修改 ,删除】 ');//生成对电影操作的链接，函数ComGridColumns2Click 将响应此链接，根据传递的参数不同 append 或者 appendOrDelete 执行不同的代码 UserControl.Text := GetSpace(1) + GetLinkString('3', 'append', '【添加】 ') + GetSpace(1) + GetLinkString('3', 'appendOrDelete', '【修改 ,删除】 '); //生成对用户操作的链接，函数ComGridColumns3Click 将响应此链接，根据传递的参数不同 append 或者 appendOrDelete 执行不同的代码 end; //点击保存按钮后 procedure TSystemForm.AffirmBtnClick(Sender: TObject); var VLIst: TStringList; begin inherited; VLIst := TStringList.Create; with VLIst do begin Values['Port'] := IIF(EdtPort.Text, '8080'); Values['New'] := IIF(EdtNewFilm.Text, '4'); Values['Hot'] := IIF(EdtHotFilm.Text, '14'); Values['effect'] := BoolToStr(IWCheckBox1.Checked); end; VLIst.SaveToFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini');

//将 4组数据存成文件：files\FilmSystem.ini,如图 4-1-31：



第 161页/共 301页

图 4-1-31 文件 FilmSystem.ini显示内容

VLIst.Free; end; //当窗口生成时，在这页中这个最先执行 procedure TSystemForm.IWAppFormCreate(Sender: TObject); var VLIst: TStringList; begin inherited; if not FileExists(WebApplication.ApplicationPath + 'files\FilmSystem.ini') then//如果文件不存在则初始化并生成该文件 begin VLIst := TStringList.Create; with VLIst do begin Values['Port'] := '8080'; Values['New'] := '4'; Values['Hot'] := '14'; Values['effect'] := 'false'; end; VLIst.SaveToFile(WebApplication.ApplicationPath + 'files\FilmSystem.ini'); VLIst.Free; end; end; // 响应添加 ,删除电影超级链接 procedure TSystemForm.ComGridColumns2Click(ASender: TObject;const AValue: string); begin inherited; if AValue = 'append' then begin//如果是增加电影，打开电影文件管理窗口 if not ShowForm('ModiforAddForm') then TModiforAddForm.Create(WebApplication).Show; UserSession.isEditAppendFilm := Avalue;//将 append值赋值给 UserSession.isEditAppendFilm end



第 162页/共 301页

else begin//如果是编辑电影，将 UserSession.FilmType赋值为 All，再打开 adminForm 窗口，这里将显示所有的电影文件，每一条记录都有编辑和删除按钮 UserSession.FilmType := 'All'; if not ShowForm('adminForm') then TAdminForm.Create(WebApplication).Show; end; end; //参考前面单元 procedure TSystemForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin inherited; if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show; end; end; // 响应添加,删除用户超级链接 procedure TSystemForm.ComGridColumns3Click(ASender: TObject;const AValue: string); begin inherited; if AValue = 'append' then begin//如果是增加用户，打开 RegForm窗口 if not ShowForm('RegForm') then TRegForm.Create(WebApplication).Show; UserSession.isEditAppendUser := ''; end else begin//如果是编辑用户，将 UserSession.isEditAppendUser赋值为 All，再打开 UserForm窗口，这里将显示所有的用户，每一条记录都有编辑和删除按钮 UserSession.isEditAppendUser := 'all'; if not ShowForm('UserForm') then TUserform.Create(WebApplication).Show; end; end; // EdtPort的 HTML代码中加入 javascropt代码 procedure TSystemForm.EdtPortHTMLTag(ASender: TObject; ATag: TIWHTMLTag); begin inherited; ATag.AddStringParam('onpaste', 'return false;');//当粘贴时，不让执行 end;



第 163页/共 301页

procedure TSystemForm.ReturnBtnClick(Sender: TObject);//显示主页面 begin inherited; if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end; initialization RegisterClass(TSystemForm); end.



第 164页/共 301页

4.1.2.9 FUserForm单元这个页面用来所有用户列表，在点击管理页面的用户【修改,删除】按钮后出现，每一条记录都有

编辑和删除的超级链接。这也是从窗口 BaseForm继承的。在这个窗口中新加了 3个控件： ListUser: TIWDBGrid，Page: TIWRectangle ，ComGrid: TIWDBGrid。ListUser 用来显示注册用户列表，Page 用来显示 ListUser 列表的分页导航条，ComGrid 用来响应页面的中的相应超级链接。窗口界面如图4-1-32：

图 4-1-32 Userform窗口界面

unit FUserForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWGrids, IWDBGrids; type TUserform = class(TBaseForm) Page: TIWRectangle; ComGrid: TIWDBGrid;

ComGrid: TIWDBGrid

ListUser: TIWRectangle

Page: TIWRectangle

第 165页/共 301页

ListUser: TIWDBGrid; procedure ComGridColumns0Click(ASender: TObject; const AValue: string); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ComGridColumns2Click(ASender: TObject; const AValue: string); procedure ComGridColumns3Click(ASender: TObject; const AValue: string); procedure ListUserRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); procedure IWAppFormRender(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public { Public declarations } end; var UserForm: TUserform; implementation uses ServerController, FRegForm, FMainForm, FlistForm; {$R *.dfm} procedure TUserform.ComGridColumns0Click(ASender: TObject; const AValue: string); begin inherited; SetPage(ListUser, AValue); // 调用在 ServerController单元中的 SetPage函数，响应在 Page框中生成的分页导航条链接，跳到相应页面。请查看 ServerController单元内的原函数说明。 end; //这个函数是用来响应页面的电影分类超级链接的。例如爱情片的页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TUserform.ComGridColumns1Click(ASender: TObject;const AValue: string); begin inherited; if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; if not ShowForm('ListForm') then TListForm.Create(WebApplication).Show; end; end;



第 166页/共 301页

//响应页面中的“修改”超级链接，从链接代码可以看出，此处 AValue 为 Modify。 procedure TUserform.ComGridColumns2Click(ASender: TObject;const AValue: string); begin inherited; if not ShowForm('RegForm') then TRegForm.Create(WebApplication).Show;//打开用户注册窗口页面 UserSession.isEditAppendUser := AValue;//将 UserSession.isEditAppendUser赋值为Modify，这样用户注册窗口 RegForm打开时就会在页面中事先显示用户已注册的信息，以便修改。 end; procedure TUserform.ComGridColumns3Click(ASender: TObject;const AValue: string); begin inherited; //响应删除超级链接，超级链接将用户名传递给 AValue UserSession.qryUserTable.Locate('userid', AValue, []);//在数据库中找到该用户 UserSession.qryUserTable.Delete;//删除该用户 end; // ListUser只有一列，当给单元格赋值时执行 procedure TUserform.ListUserRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); var Temp: TStringList; begin inherited; Temp := TStringList.Create; if ListUser.DataSource.DataSet.IsEmpty then//如果 ListUser查询的注册用户数为 0则退出此函数的执行 exit; if (AColumn = 0) and (ARow > 0) then//如果当前单元格是第一列，且不是第一行 begin with ListUser.DataSource.DataSet do begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\UserFilm.html');//导入\files\Skin\1\UserFilm.html皮肤模板文件，显示效果如图 4-1-33：

图 4-1-33 UserFilm.html在 IE中的视图

以下代码为替换相应的字符为我们所需要的代码 Temp.Text := StringReplace(Temp.Text, 'User', FieldByname('Userid').AsString, [rfReplaceAll]);//将 User替换成 Userid字段内容 Temp.Text := StringReplace(Temp.Text, 'Sex', FieldByname('Sex').AsString, [rfReplaceAll]); //

第 167页/共 301页

将 Sex替换成 Sex字段内容 Temp.Text := StringReplace(Temp.Text, 'LoginCount', FieldByname('LoginCount').AsString, [rfReplaceAll]); //将 LoginCount替换成 LoginCount字段内容 Temp.Text := StringReplace(Temp.Text, 'DateTime', FieldByname('RegTime').AsString, [rfReplaceAll]); //将 DateTime替换成 DateTime字段内容 Temp.Text := StringReplace(Temp.Text, 'Modify', GetLinkString('2', FieldByname('userid').AsString, '修改'), [rfReplaceAll]); //将 Modify替换成“修改”链接，传递要删除的用户名 userid Temp.Text := StringReplace(Temp.Text, 'Del', Format('<a href="#none" onclick="deleteUser(' + QuotedStr(FieldByname('userid').AsString) + ')";>%S</a>',['删除']), [rfReplaceAll]); //显示在浏览器的“删除”超级链接，在窗口的 javascript属性中的最下面加入以下三行 javascript代码： function deleteUser(del) { if(confirm("你确定要删除 "+del+" 用户吗?")) {return SubmitClickConfirm('ComGrid','3_'+del+'', true, '');}} ACell.Text := Temp.Text;//将得到的 HTML代码赋值给这个单元格 end; end; Temp.Free; end; procedure TUserform.IWAppFormRender(Sender: TObject); begin inherited; if UserSession.isEditAppendUser = 'all' then begin//如果条件成立 with UserSession.qryUserTable do begin//查询所有用户 Close; SQL.Clear; SQL.Text := 'select * from usertables '; Open; end; end; UserSession.isEditAppendUser := '';//赋为空值 ListUser.DataSource := UserSession.dsUserTable;//给 ListUser.DataSource赋值 Page.Text := GetToolStr(ListUser.DataSource.DataSet.RecNo, ListUser.DataSource.DataSet.RecordCount, ListUser.RowLimit, 0, 10, ' 人 '); // 调用在

ServerController单元中的 GetToolStr函数，在 Page框中生成分页导航条，请查看 ServerController单元内的原函数说明。 end; initialization RegisterClass(TUserform); end.



第 168页/共 301页

4.1.2.10 Fadminform单元这个页面用来所有电影列表，在点击管理页面的电影【修改,删除】按钮后出现，每一条记录都有

编辑和删除的超级链接。这也是从窗口 BaseForm继承的。在这个窗口中新加了 3个控件： ListFilm: TIWDBGrid，Page: TIWRectangle ，ComGrid: TIWDBGrid。ListUser 用来显示注册用户列表，Page 用来显示 ListFilm 列表的分页导航条，ComGrid 用来响应页面的中的相应超级链接。窗口界面如图4-1-34：

图 4-1-34 AdminForm窗口界面

unit Fadminform; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWGrids, IWDBGrids; type TAdminForm = class(TBaseForm) Page: TIWRectangle; ListFilm: TIWDBGrid; ComGrid: TIWDBGrid;

ComGrid: TIWDBGrid

ListFilm: TIWRectangle

Page: TIWRectangle



第 169页/共 301页

procedure ListFilmRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); procedure IWAppFormRender(Sender: TObject); procedure ComGridColumns0Click(ASender: TObject; const AValue: string); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure ComGridColumns2Click(ASender: TObject; const AValue: string); procedure ComGridColumns3Click(ASender: TObject; const AValue: string); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public FilmType: string; { Public declarations } end; var AdminForm: TAdminForm; implementation uses ServerController, FplayForm, FMainForm, FlistForm, FControl; {$R *.dfm} // ListFilm只有一列，当给单元格赋值时执行 procedure TAdminForm.ListFilmRenderCell(ACell: TIWGridCell; const ARow, AColumn: Integer); var Temp: TStringList; begin inherited; Temp := TStringList.Create; if ListFilm.DataSource.DataSet.IsEmpty then//如果 ListFilm查询的注册用户数为 0则退出此函数的执行 exit; if (AColumn = 0) and (ARow > 0) then//如果当前单元格是第一列，且不是第一行 begin with ListFilm.DataSource.DataSet do begin Temp.Clear; Temp.LoadFromFile(WebApplication.ApplicationPath + '\files\Skin\' + GSkin + '\adminList.html'); //导入\files\Skin\1\ adminList.html皮肤模板文件，在 IE中的显示效果如图 4-1-35：

图 4-1-35 adminList.html在 IE中的视图

以下代码为替换相应的字符为我们所需要的代码

第 170页/共 301页

Temp.Text := StringReplace(Temp.Text, 'Type', FieldByname('typeid').AsString, [rfReplaceAll]); //将 Type替换成 typeid字段内容 Temp.Text := StringReplace(Temp.Text, 'Title', GetLinkString('2', FieldByname('title').AsString, FieldByname('title').AsString), [rfReplaceAll]); //将 Title替换成 Title的链接字段内容，传递的参数也是Title字段的内容 Temp.Text := StringReplace(Temp.Text, 'Hit', FieldByname('hits').AsString, [rfReplaceAll]); //将 Hit替换成 Hits字段内容 Temp.Text := StringReplace(Temp.Text, 'DateTime', FieldByname('dateandTime').AsString, [rfReplaceAll]); //将 DateTime替换成 dateandTime字段内容 Temp.Text := StringReplace(Temp.Text, 'Modify', GetLinkString('2', FieldByname('title').AsString, '修改'), [rfReplaceAll]); //将 Modify替换成“修改”链接，传递要删除的电影名 title Temp.Text := StringReplace(Temp.Text, 'Del', Format('<a href="#none" onclick="deletefilms(' + QuotedStr(FieldByname('title').AsString) + ')";>%S</a>',['删除']), [rfReplaceAll]); //显示在浏览器的“删除”超级链接，在窗口的 javascript属性中的最下面加入以下三行 javascript代码： function deleteUser(del) { if(confirm("你确定要删除 "+del+" 用户吗?")) {return SubmitClickConfirm('ComGrid','3_'+del+'', true, '');}} ACell.Text := Temp.Text; //将得到的 HTML代码赋值给这个单元格 end; end; Temp.Free; end; procedure TAdminForm.IWAppFormRender(Sender: TObject); begin inherited; if (UserSession.FilmType <> '') and (UserSession.FilmType <> 'All') then begin//如果条件成立 with UserSession.ListFilm do begin//查询相关类型的电影 Close; SQL.Clear; SQL.Text := 'select * from movie where typeid=''' + UserSession.FilmType + ''' and IsDate(Movie.dateandtime) ORDER BY datevalue(Movie.dateandtime) DESC'; Open; end; end; if UserSession.FilmType = 'All' then begin//查询所有类型的电影 with UserSession.ListFilm do begin Close; SQL.Clear; SQL.Text := 'select * from movie '; Open; end;

第 171页/共 301页

end; UserSession.FilmType := ''; //赋为空值 ListFilm.DataSource := UserSession.ListFilmSource;// 给 ListFilm.DataSource赋值 Page.Text := GetToolStr(ListFilm.DataSource.DataSet.RecNo, ListFilm.DataSource.DataSet.RecordCount, ListFilm.RowLimit, 0); // 调用在ServerController单元中的 GetToolStr函数，在 Page框中生成分页导航条，请查看 ServerController单元内的原函数说明。 end; procedure TAdminForm.ComGridColumns0Click(ASender: TObject;const AValue: string); begin inherited; SetPage(ListFilm, AValue); // 调用在 ServerController单元中的 SetPage函数，响应在 Page框中生成的分页导航条链接，跳到相应页面。请查看 ServerController单元内的原函数说明。 end; //这个函数是用来响应页面的电影分类超级链接的。例如爱情片的页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TAdminForm.ComGridColumns1Click(ASender: TObject;const AValue: string); begin inherited; if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; end; end; //响应页面中的“修改”超级链接，从链接代码可以看出，此处 AValue 为 Modify。 procedure TAdminForm.ComGridColumns2Click(ASender: TObject; const AValue: string); begin inherited; if not ShowForm('ModiforAddForm') then TModiforAddForm.Create(WebApplication).Show; //打开电影修改窗口页面 UserSession.isEditAppendFilm := AValue; //将 UserSession.isEditAppendFilm赋值为 Modify，这样电影修改窗口 RegForm打开时就会在页面中事先显示该电影的相关信息，以便修改。 end; procedure TAdminForm.ComGridColumns3Click(ASender: TObject;const AValue: string); //响应“删除”超级链接，超级链接将用户名传递给 AValue begin



第 172页/共 301页

inherited; UserSession.ListFilm.Locate('title', AValue, []);//在数据库中找到该用户 UserSession.ListFilm.Delete; //删除该用户 end; initialization RegisterClass(TAdminForm); end.

4.1.2.11 FControl单元这个页面用来编辑电影记录的，在点击管理页面的电影【添加】或电影列表中的修改按钮后出现。

这也是从窗口 BaseForm 继承的。在这个窗口中新加了很多控件：IWLabel1: TIWLabel，TitleEdt: TIWEdit，IWLabel2: TIWLabel，IWLabel3: TIWLabel，IWLabel4: TIWLabel，IWLabel5: TIWLabel，IWLabel7: TIWLabel，MainNameEdt: TIWEdit，UpTimEdt: TIWEdit，TypeIdCbb: TIWComboBox，Memo: TIWMemo，IWLabel8: TIWLabel，IWLabel9: TIWLabel，IWLabel11: TIWLabel，IWLabel10: TIWLabel，IWLabel12: TIWLabel，FilmLong: TIWComboBox，whereEdt: TIWEdit，IWLabel13: TIWLabel，UpFilms: TIWButton，UpFilelist: TIWMemo，FilmNumEdt: TIWCheckBox，IWLabel6: TIWLabel， BackBtn: TIWButton， SearchFilm: TIWButton， LookBtn: TIWButton， ComGrid: TIWDBGrid， EdtNumTo: TIWEdit， SaveFilmCbb: TIWComboBox， SaveFilmEdt: TIWEdit，SavePictureEdt: TIWEdit，UpFilm: TIWEdit，UpPictrueEdt: TIWEdit，EdtNumFrom: TIWEdit。同样ComGrid用来响应页面的中的相应超级链接。窗口界面如图 4-1-36：



第 173页/共 301页

图 4-1-36 ModiforAddForm窗口界面

首先请在本窗口 javascript属性的最后面加上如下 javascript代码： function Getdates() { var day=""; var month=""; var ampm=""; var ampmhour=""; var myweekday=""; var year=""; mydate=new Date(); myweekday=mydate.getDay(); mymonth=mydate.getMonth()+1; myday= mydate.getDate(); myyear= mydate.getYear(); year=(myyear > 200) ? myyear : 1900 + myyear; return year+"-"+mymonth+"-"+myday } function CBB_onchange() { tempObj = SAVEFILMCBBIWCL; i = tempObj.selectedIndex; if(tempObj.options[i].innerHTML==" 喜剧片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/comedy/";SAVEPICTUREEDTIWCL.value ="/files/Movies/comedy/";} if(tempObj.options[i].innerHTML==" 动作片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/action/";SAVEPICTUREEDTIWCL.value = "/files/Movies/action/";} if(tempObj.options[i].innerHTML==" 恐怖片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/dracula/";SAVEPICTUREEDTIWCL.value ="/files/Movies/dracula/";} if(tempObj.options[i].innerHTML==" 爱情片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/love/";SAVEPICTUREEDTIWCL.value ="/files/Movies/love/";} if(tempObj.options[i].innerHTML==" 战争片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/war/";SAVEPICTUREEDTIWCL.value ="/files/Movies/war/";} if(tempObj.options[i].innerHTML==" 动画片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/cartoon/";SAVEPICTUREEDTIWCL.value ="/files/Movies/cartoon/";} if(tempObj.options[i].innerHTML=="科幻片") {SAVEFILMEDTIWCL.value = "/files/Movies/science fiction/";SAVEPICTUREEDTIWCL.value ="/files/Movies/science fiction/";}



第 174页/共 301页

if(tempObj.options[i].innerHTML==" 惊险片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/adventruous/";SAVEPICTUREEDTIWCL.value ="/files/Movies/adventruous/";} if(tempObj.options[i].innerHTML==" 伦理片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/ethical/";SAVEPICTUREEDTIWCL.value ="/files/Movies/ethical/";} if(tempObj.options[i].innerHTML==" 故事片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/story/";SAVEPICTUREEDTIWCL.value ="/files/Movies/story/";} if(tempObj.options[i].innerHTML==" 成人片 ") {SAVEFILMEDTIWCL.value = "/files/Movies/adult/";SAVEPICTUREEDTIWCL.value ="/files/Movies/adult/";} if(tempObj.options[i].innerHTML==" 电视剧 ") {SAVEFILMEDTIWCL.value = "/files/Movies/teleplay/";SAVEPICTUREEDTIWCL.value ="/files/Movies/teleplay/";} if(tempObj.options[i].innerHTML==" 其它 ") {SAVEFILMEDTIWCL.value = "/files/Movies/other/";SAVEPICTUREEDTIWCL.value ="/files/Movies/other/";} } function Check_Edit(btn){ UPTIMEDTIWCL.value=Getdates(); var obj = TITLEEDTIWCL; if(obj.value == "") { alert("影片标题不能为空!"); obj.focus(); return false; } tempObj = TYPEIDCBBIWCL; i = tempObj.selectedIndex; if(tempObj.options[i].innerHTML=="-- No Selection --") { alert("请选择影片分类!"); return false; } var obj = UPPICTRUEEDTIWCL; if(obj.value == "") { alert("上传图片不能为空!"); obj.focus(); return false; }

第 175页/共 301页

var obj = WHEREEDTIWCL; if(obj.value == "") { alert("影片地区不能为空!"); obj.focus(); return false; } tempObj = FILMLONGIWCL; i = tempObj.selectedIndex; if(tempObj.options[i].innerHTML=="-- No Selection --") { alert("请选择影片长度!"); return false; } var obj = UPFILMIWCL; if(obj.value == "") { alert("上传影片不能为空!"); obj.focus(); return false; } if (FindElem('FILMNUMEDT_CHECKBOX').checked == true) { if (EDTNUMTOIWCL.value=""){alert("电影集数不能为空!");} } if (FindElem('FILMNUMEDT_CHECKBOX').checked == true) { var str1 = UPFILMIWCL.value; var str2 = str1.indexOf("1"); if(str2<0) { alert("上传影片缺少关键字 1 ,例如 D:\我的电影\仙女传奇 1"); return false; } } tempObj = SAVEFILMCBBIWCL; i = tempObj.selectedIndex; if(tempObj.options[i].innerHTML=="-- No Selection --") { alert("请选择影片保存类型!"); return false; } SubmitClickConfirm(''+btn+'','', true, ''); }



第 176页/共 301页

请在 SearchFilm按钮（初始化配置）的 scriptevents的 onclick中加入如下 javascript代码： Check_Edit("SEARCHFILM"); 以上目的是检查输入数据的完整性。请在 UpFilms按钮（添加）的 scriptevents的 onclick中加入如下 javascript代码： if (SEARCHFILMIWCL.value=="初始化成功") { Check_Edit("UPFILMS"); } else { alert("请先按初始化配置!以便能为所需要的电影分配空间!") ; } 以上目的是检查输入数据的完整性。

unit FControl; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, FBaseform, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompRectangle, IWCompButton, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompEdit, IWHTMLControls, IWCompMemo, IWCompListbox, IWCompLabel, DB, ADODB, IWLayoutMgrHTML, IWLayoutMgrForm, IWCompCheckbox, IWGrids, IWDBGrids, Iwhtmltag; type TModiforAddForm = class(TBaseForm) IWLabel1: TIWLabel; TitleEdt: TIWEdit; IWLabel2: TIWLabel; IWLabel3: TIWLabel; IWLabel4: TIWLabel; IWLabel5: TIWLabel; IWLabel7: TIWLabel; MainNameEdt: TIWEdit; UpTimEdt: TIWEdit; TypeIdCbb: TIWComboBox; Memo: TIWMemo; IWLabel8: TIWLabel; IWLabel9: TIWLabel; IWLabel11: TIWLabel; IWLabel10: TIWLabel;



第 177页/共 301页

IWLabel12: TIWLabel; FilmLong: TIWComboBox; whereEdt: TIWEdit; IWLabel13: TIWLabel; UpFilms: TIWButton; UpFilelist: TIWMemo; FilmNumEdt: TIWCheckBox; IWLabel6: TIWLabel; BackBtn: TIWButton; SearchFilm: TIWButton; LookBtn: TIWButton; ComGrid: TIWDBGrid; EdtNumTo: TIWEdit; SaveFilmCbb: TIWComboBox; SaveFilmEdt: TIWEdit; SavePictureEdt: TIWEdit; UpFilm: TIWEdit; UpPictrueEdt: TIWEdit; EdtNumFrom: TIWEdit; procedure IWAppFormRender(Sender: TObject); procedure UpFilmsClick(Sender: TObject); procedure IWAppFormCreate(Sender: TObject); procedure BackBtnClick(Sender: TObject); procedure ComGridColumns1Click(ASender: TObject; const AValue: string); procedure LookBtnClick(Sender: TObject); procedure SearchFilmClick(Sender: TObject); procedure SaveFilmCbbHTMLTag(ASender: TObject; ATag: TIWHTMLTag); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: String); private { Private declarations } public procedure GetField(IQuery: Tadoquery); procedure SetField(IQuery: Tadoquery); procedure Textclear; { Public declarations } end; var ModiforAddForm: TModiforAddForm; implementation uses ServerController, Fadminform, FMainForm, FplayForm, UserSessionUnit; {$R *.dfm}

第 178页/共 301页

//目的是清空当前页面内的所有输入框中的字符 procedure TModiforAddForm.Textclear; var i: Integer; begin for i := 0 to self.ComponentCount - 1 do begin if (self.Components[i] is TIWEdit) then begin if (self.Components[i] as TIWEdit).Name <> 'EdtNumFrom' then// 输入框 EdtNumFrom除外 (self.Components[i] as TIWEdit).Text := ''; end; if (self.Components[i] is TIWComboBox) then//下拉框回复默认值 begin (self.Components[i] as TIWComboBox).ItemIndex := -1; end; Memo.Lines.Clear;//清空 Memo输入 UpFilelist.Lines.Clear;// 清空 UpFilelist输入 end; end; //在修改该电影记录时，在页面上显示数据库中该电影记录的相关数据，也就是将数据库中的当前记录的字段值取出来放在相应的页面显示控件中 procedure TModiforAddForm.GetField(IQuery: Tadoquery); var AdoTempMovieList: Tadoquery; begin Textclear; with IQuery do begin TitleEdt.Text := FieldByname('title').AsString; SavePictureEdt.Text := FieldByname('url').AsString; TypeIdCbb.ItemIndex := TypeIdCbb.Items.IndexOf(FieldByname('Typeid').AsString); MainNameEdt.Text := FieldByname('name').AsString; UpTimEdt.Text := FieldByname('dateandtime').AsString; whereEdt.Text := FieldByname('where').AsString; FilmLong.ItemIndex := FilmLong.Items.IndexOf(FieldByname('howlong').AsString); Memo.Text := FieldByname('content').AsString; FilmNumEdt.Checked := FieldByname('IsFilmNum').AsBoolean; UpFilelist.Lines.Add(FieldByname('domurl').AsString); SaveFilmEdt.Text := FieldByname('domurl').AsString; UpFilm.Text := Copy(WebApplication.ApplicationPath, 0, Length(WebApplication.ApplicationPath) - 1) + RenString(SaveFilmEdt.Text);

第 179页/共 301页

UpPictrueEdt.Text := Copy(WebApplication.ApplicationPath, 0, Length(WebApplication.ApplicationPath) - 1) + RenString(SavePictureEdt.Text); end; if IQuery.FieldByname('IsFilmNum').AsBoolean = True then begin//如果是多集电影 AdoTempMovieList := Tadoquery.Create(self); AdoTempMovieList.Connection := UserSession.cn; with AdoTempMovieList do begin Close; SQL.Clear; SQL.Add('select * from movieList where title=' + QuotedStr(IQuery.FieldByname('title').AsString)); Open; UpFilelist.Lines.Clear; while not Eof do begin UpFilelist.Lines.Add(FieldByname('playurl').AsString); Next; end; end; AdoTempMovieList.Close; AdoTempMovieList.Free; end; end; //与上一个函数刚好相反，这是将页面的输入信息存入数据库中 procedure TModiforAddForm.SetField(IQuery: Tadoquery); var AdoTempMovieList: Tadoquery; i: Integer; begin with IQuery do begin FieldByname('title').AsString := TitleEdt.Text; FieldByname('url').AsString := trim(SavePictureEdt.Text); FieldByname('Typeid').AsString := TypeIdCbb.Items[TypeIdCbb.ItemIndex]; FieldByname('name').AsString := MainNameEdt.Text; if UpTimEdt.Text <> '' then UpTimEdt.Text := DateToStr(Now); FieldByname('dateandtime').AsString := UpTimEdt.Text; FieldByname('where').AsString := whereEdt.Text; FieldByname('howlong').AsString := FilmLong.Items[FilmLong.ItemIndex]; FieldByname('content').AsString := Memo.Text; FieldByname('IsFilmNum').AsBoolean := FilmNumEdt.Checked; FieldByname('domurl').AsString :=trim(UpFilelist.Lines.Strings[0]); end;

第 180页/共 301页

if (FilmNumEdt.Checked = True) and (UpFilelist.Lines.Text <> '') then begin//如果是多集电影 AdoTempMovieList := Tadoquery.Create(self); AdoTempMovieList.Connection := UserSession.cn; with AdoTempMovieList do begin Close; SQL.Clear; SQL.Add('delete from movieList where title=' + QuotedStr(TitleEdt.Text)); ExecSQL; end; with AdoTempMovieList do begin Close; SQL.Clear; SQL.Add('select * from movieList where 1=2 '); Open; for i := 0 to UpFilelist.Lines.Count - 1 do begin Append; FieldByname('title').AsString := IQuery.FieldByname('title').AsString; FieldByname('playurl').AsString :=trim(UpFilelist.Lines.Strings[i]); FieldByname('Filmnum').AsInteger := i + 1; Post; end; IQuery.FieldByname('domurl').AsString := ''; end; AdoTempMovieList.Close; AdoTempMovieList.Free; end; end; //生成该页面的 HTML文件时执行 procedure TModiforAddForm.IWAppFormRender(Sender: TObject); begin inherited; if UserSession.isEditAppendFilm = 'append' then begin//如果是增加电影 UpFilms.Caption := '添加';// UpFilms显示为添加 if not UserSession.IsFresh then//如果不在编辑状态 Textclear;//清空所有输入 UserSession.IsFresh := False; //标示为没有更新 end else begin UpFilms.Caption := '修改';//如果不是添加则是修改 UserSession.ListFilm.Locate('title', UserSession.isEditAppendFilm, []);//在 ListFilm 数据集中找到当前修改的电影记录，UserSession.isEditAppendFilm被事先赋值为要修改的电影名，从上一节的TAdminForm.ComGridColumns2Click函数可以看出来



第 181页/共 301页

if not UserSession.IsFresh then//如果不是刚刚更新 GetField(UserSession.ListFilm);//在页面上显示人修改的记录 UserSession.isEditAppendFilm := '';//清空，以防再次执行 UserSession.IsFresh := False; //标示为没有更新 end; end; //点击 UpFilms按钮时执行 procedure TModiforAddForm.UpFilmsClick(Sender: TObject); begin inherited; if UpFilms.Caption = '添加' then begin//如果是添加电影 with UserSession.ListFilm do begin Close; SQL.Clear; SQL.Add('select * from movie where 1=2 '); Open; Append;//新增加一条记录 SetField(UserSession.ListFilm);//将页面数据存入数据库中 Post; end; UserSession.IsFresh := True;//标示为刚刚更新 end else begin //如果是修改 with UserSession.ListFilm do begin Locate('title', UserSession.isEditAppendFilm, []);//找到当前记录 Edit;//设定到编辑状态 SetField(UserSession.ListFilm);// 将页面数据存入数据库中 Post; end; UserSession.IsFresh := True; //标示为刚刚更新 end; SearchFilm.Caption := '初始化配置'; end; //页面生成时最先执行的代码，给两个下拉框赋值 procedure TModiforAddForm.IWAppFormCreate(Sender: TObject); var AdoTempType: Tadoquery;//设定一个临时查询用的 Tadoquery控件，在本函数中用完就释放 begin inherited; AdoTempType := Tadoquery.Create(self); AdoTempType.Connection := UserSession.cn;

第 182页/共 301页

with AdoTempType do begin Close; SQL.Clear; SQL.Text := 'select * from type';//查询出所有的电影类型 Open; while not Eof do begin TypeIdCbb.Items.Add(FieldByname('type').AsString);//给 TypeIdCbb赋值，所有预定义的电影类型 SaveFilmCbb.Items.Add(FieldByname('type').AsString);// 给 SaveFilmCbb赋值，所有预定义的电影保存类型 Next; end; Close; AdoTempType.Free;//释放 end; end; //点击返回按钮后执行 procedure TModiforAddForm.BackBtnClick(Sender: TObject); begin inherited; if not ShowForm('AdminForm') then TAdminForm.Create(WebApplication).Show;//显示电影列表页面 end; //这个函数是用来响应页面的电影分类超级链接的。例如爱情片的页面代码为<a href="#none" onclick="return SubmitClickConfirm('ComGrid','1_爱情片', true, '');">爱情片</a>，此处 Avalue将被赋值为爱情片 procedure TModiforAddForm.ComGridColumns1Click(ASender: TObject; const AValue: string); begin inherited; if AValue = 'MainForm' then begin if not ShowForm('MainForm') then TMainForm.Create(WebApplication).Show; end else begin UserSession.FilmType := AValue; if not ShowForm('AdminForm') then TAdminForm.Create(WebApplication).Show; end; end;



第 183页/共 301页

//点击预览按钮后执行 procedure TModiforAddForm.LookBtnClick(Sender: TObject); begin inherited; if not ShowForm('PlayForm') then TPlayForm.Create(WebApplication).Show;//显示播放页面 UserSession.Film := TitleEdt.Text;//指定要播放的电影名 end; // 点击初始化配置按钮后执行 procedure TModiforAddForm.SearchFilmClick(Sender: TObject); var GetPicName, GetFilmExt, GetFilename, GetHz: string; i, FromNum, toNum: Integer; function GetLastDir(Istring: string): string;//得到字串中最后一个\符号后的字串 var Count: Integer; Fstring: string; begin Fstring := Istring; Count := LastDelimiter('\', Fstring);//字符\最后出现的位置 result := Copy(Fstring, Count + 1, Length(Fstring) - Count); end; procedure CopyOneFilm; var NewFilms: string; begin NewFilms := Copy(WebApplication.ApplicationPath, 0, Length(WebApplication.ApplicationPath) - 1) + RenString(SaveFilmEdt.Text) + gethzPy(TitleEdt.Text) + '\'; if not DirectoryExists(NewFilms) then ForceDirectories(PChar(NewFilms));//保证有此文件夹，没有就创建 CopyFile(PChar(UpFilm.Text), PChar(NewFilms + GetFilename), False); //拷贝电影 CopyFile(PChar(UpPictrueEdt.Text), PChar(NewFilms + GetPicName), False); //拷贝图片 end; procedure CopyDirFilm; var Dir, DestDir: string; HZ, LastDir: string; begin HZ := gethzPy(TitleEdt.Text) + '\'; DestDir := Copy(WebApplication.ApplicationPath, 0, Length(WebApplication.ApplicationPath) - 1) + RenString(SaveFilmEdt.Text); Dir := ExtractFileDir(UpFilm.Text);

第 184页/共 301页

if not DirectoryExists(DestDir) then ForceDirectories(PChar(DestDir)); CopyDirectory(Dir, DestDir); //gethzPy(TitleEdt.Text) LastDir := GetLastDir(Dir); RenDirectory(DestDir + LastDir, DestDir + HZ); CopyFile(PChar(UpPictrueEdt.Text), PChar(DestDir + HZ + GetPicName), False); //图片 end; begin inherited; try GetFilmExt := extractfileext(UpFilm.Text); GetFilename := ExtractFileName(UpFilm.Text); GetPicName := ExtractFileName(UpPictrueEdt.Text); UserSession.IsFresh := True; if FilmNumEdt.Checked = True then begin//如果是多集电影 UpFilelist.Lines.Clear; FromNum := StrToIntDef(EdtNumFrom.Text, 1); toNum := StrToIntDef(EdtNumTo.Text, 0); GetFilename := Copy(GetFilename, 0, Length(GetFilename) - (Length(GetFilmExt) + 1)); for i := FromNum to toNum do begin UpFilelist.Lines.Add(SaveFilmEdt.Text + GetFilename + inttostr(i) + GetFilmExt); end; GetHz := SaveFilmEdt.Text + gethzPy(TitleEdt.Text) + '/'; SavePictureEdt.Text := GetHz + GetPicName; CopyDirFilm; EdtNumFrom.Text := '0'; EdtNumTo.Text := '0'; end else//如果是单集电影 begin GetHz := SaveFilmEdt.Text + gethzPy(TitleEdt.Text) + '/'; SavePictureEdt.Text := GetHz + GetPicName; UpFilelist.Lines.Clear; UpFilelist.Lines.Add(GetHz + GetFilename); CopyOneFilm; end; SearchFilm.Caption := '初始化成功'; except SearchFilm.Caption := '初始化失败'; end; end; //在 SaveFilmCbb 控件的 HTML 代码中加入 javascript 代码，本控件的 HTML 代码为：<select



第 185页/共 301页

name="SAVEFILMCBB" size="1" width="153" title="一旦资料改变必须按生成电影按钮初始化配置否则保存资料将会失败 !" class="fmtxtra" style="z-index:100;width:153;height:21;" id="SAVEFILMCBB" onchange="CBB_onchange()" tabindex="22"> procedure TModiforAddForm.SaveFilmCbbHTMLTag(ASender: TObject; ATag: TIWHTMLTag); begin inherited; ATag.AddStringParam('onchange', 'CBB_onchange()'); end; initialization RegisterClass(TModiforAddForm); end. 补充说明：本程序想用最少的控件来完成程序的编写，所以代码显得较多，但只要明白了其中的原理，开发

一个比这个更复杂的程序将会很简单。本程序中有很多的函数可以直接拷贝使用。大部分只作相应局

部修改即可扩充功能。这是一个很好的编程资源，这种方法在 delphi7以后的版本中也可应用。所有模板文件用 dreamweaverMX 编辑，如有不明白的地方，请打开源代码自己细看。请注意模

板的图片文件的相对路径。直接放在 templates 目录下是可以的。放在 templates\1 目录下就看不到了。

FilmServerdll_gy.dpr 为生成 dll 版本的工程文件。要用 IIS 发布生才能查看。所有代码在WinXPSP2+Dlphi7.0 +IntraWeb7.2.41下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 4．2 一个英语教学网站的综合编程作者：高勇


第 186页/共 301页

4．2 一个英语教学网站的综合编程 4.2.1 网站整体设计简要说明在第一章时，我们提到过一个英语教学网站。这里，我们对它进行完整讲解。这个程序基本上是使用 intraweb自带的控件来实现的，通过程序的相关控件自己直接组装的代码

比较少（这是与 4.1最大的区别）。程序中除了用到 intraweb控件外还用到了 intraweb的第三方控件：TMS，这个控件组是对 intrweb 是一个非常实用的功能扩充，有对 intraweb对应控件的升级也有具有全新功能的自己的控件，总之你也把它看成 intraweb组件的一部分就行了，它要单独购买，这是它唯一的缺点，在 intraweb的每一安装版本中都已经集成了。（本程序源代码在文件夹 4.2中）闲话少述，先说一下整个程序的总体思路： 1、网站一般都有一个每页都有的导航条之类的东西，例如菜单等，就是每页都出现的一些公共界

面，我们在一个 TFrame窗口中实现，它可以被注册成为控件面版上的一个控件（在其上点击右键即有选项 add to pallete，点击它，这时会出现一个对话框，选择一控件面版即可），其它页面要拥有这些公共界面，将注册的 TFrame窗口控件拖到窗口中即可。

2、所有窗口要调用的共用函数我们都写在 IWUserSession 窗口中，其它窗口只要 uses UserSessionUnit单元，就可以通过 UserSession调用这些函数（如 UserSession.closesessoion;）。

3、各单元之间要传递的参数我们都事先在 IWUserSession 窗口中定义，传递时先给相应的参数赋值，接收时从这个参数取值。这样就可以实现各网页之间的参数传递。

4、界面布局我们依然采用模板的方法，用 HTML文件作为模板，相应的窗口调用相应的模板将我们的 IntraWeb控件自动嵌入到相应的位置中。不同的模板可以实现不同的网页风格。

5、每一个窗口基本上完成一个比较独立的功能，因为 intraweb 的窗口一般对应一个页面，我们在同一个窗口中放上很多个 TIWRegion控件，每一个 TIWRegion控件中放入相应的可视控件完成相对独立的功能，改变 IWRegionA的 visible属性就实现了不同界面的切换。在本程序中我们一般用到了两个放了很多其它控件的 TIWRegion控件，一个用来完成程序功能显示，一个用来完成后台程序维护。也就是说一个窗口可以通过改变 TIWRegion控件的显示属性来显示成不同的页面，完成不同的功能。我们的模板放在 templates\目录下，改变 IWServerController里 TemplateDir属性可以更换模板风

格，本程序中提供两套精美的模板。这里共有 9个页面，它们的文件名小数点前的部分都和相应的窗口名称（name属性）是一样的。数据文件为 datas\data.mdb，没有密码，这是 Access 数据库，大家打开看即可。字段名如果不

是汉字则大多为拼音，应该很好理解。我们的讲解和学习重点在程序编写而不在数据库应用，所以这

里不再详述。 4.2.2 unit ServerController导读 ServerController这是程序的控制中心，是一个比较重要的单元。其重要属性简介如下： AllowSubFolders：请选择 true。这将允许程序使用下级文件夹。有利于我们的编程。 AppName：这个属性为 Web 应用指定一个名称，请尽量保证此名称的唯一性，如果两个应用的

名称相同则它们不能同时运行在一个系统中。这里为Graduate English for the 21st Century。 BoundIP：（发布成 exe 形式时有效）填写将要发布的服务器的 IP，如果空着，则自动被设为

127.0.0.1，这样就只能本机访问了，其它用户通过 internet 不能访问。如果 IntraWeb 是体验版本的话，这个值会被固定为 127.0.0.1，不管你改为多少，如果服务器没有网络，则用指定的 IP打开时会出错。它出现在 IE地址里（加黑部分）http://127.0.0.1:8899。

ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。否则会出错，这是经验，如果用到数据库，是不能选择 ciNone的，运行会有错。



第 187页/共 301页

ExeCmd：可以任意指定，默认为“exec”。这里为 exe，它出现在 IE 地址里 exe（加黑部分）：http://127.0.0.1:8899/ exe。

Port：指定端口，只要是当前计算机没有使用的端口都可以。如果 IntraWeb是体验版本的话，则修改无效。它出现在 IE地址的 IP加冒号的后面，如下所示 8899（加黑部分）http://127.0.0.1:8899。


进行交互，则认为用户已经离开了，程序就会关闭他的 Session。这个时间如果太少，则可能导致用户不能正常使用，太长了又浪费资源，120分钟较为合适。

SessionTrackingMethod：如果不想 IE地址太长的话，请选择 tmHidden，这样 Session的 ID就不会出现在 IE地址里了，它被隐藏在网页里（网址最后的那一串经常变动的字符就没有了）。其它的属性取默认值就行了。下面解读一下程序代码： function GetLocalIP: string;//为取得本机 IP地址。如果本机不在网络上，则为 127.0.0.1。 procedure TIWServerController.IWServerControllerBaseCreate(Sender: TObject); var ip: string; begin self.CacheDir := self.AppPath + 'cache';//将临时生成的 cache目录放在网站根目录下 ip := GetLocalIP;// 网络版本，如果要限定 IP的话请使用下一句，ip为自定义的一个变量 //ip:='127.0.0.1';//单机版本 self.BoundIP:=ip;//设定程序要绑定的 IP self.Port:=8899;//指定端口 self.TemplateDir:='Templates\'; //设定模板文件夹 end; 4.2.3 unit UserSessionUnit导读 UserSessionUnit 是一个很有意思的单元。这里的变量和函数每一用户（这里的用户是指你用 IE

打开一下这个程序，你就是一个用户了，不管你登不登录都已经是了）都是独立的。也就是说只要你

用 IE 打开一下这个程序，服务器就会通过 UserSessionUnit 产生一个 Session，这个 Session 是独一无二的，只有刚才打开的 IE界面能够使用它，当 SessionTimeout所设置的时间到时，这个 Session才会自动销毁。这样就保证了每一个使用这个程序的人都有自己私有的状态数据。要不然多人同时使

用时就会乱套了。下面解读一下程序代码：在 public中我们声明了一些编程要用到的变量和函数，之所以在这个单元是声明这些变量和函数，

是因为其它的页面随时都可以调用它们。我们声明了如下变量和函数： public a, b, c, d, e,f, XingMing, mm, KaHao, mima, ip: string; flag, YiDengLu: Boolean; yuyinid: Integer; DengLuShiJian: string; //登录时间 XiaWangShiJian: string; //下网时间 LeiJiShangWangShiJian: string; //累积上网时间 JinRiShangWangShiJian: string; //今日上网时间 GuanLi_News: Boolean; //管理新闻系统

http://127.0.0.1:8899/

http://127.0.0.1



第 188页/共 301页

GuanLi_YuYin: Boolean; //管理语音天地系统 procedure closesessoion; //响应 IE的关闭事件，关闭当前活动窗口 procedure Move(AFormClass: TIWAppFormClass); function showBanQuan: string; //查询版权 function ReplaceStrs(str, SearchStr, ReplaceStr: string): string; { Public declarations } 窗口中有如图 4-2-1所示控件：

图 4-2-1 UserSession窗口中的控件

每一个单元中请 uses ServerController, UserSessionUnit。这个自定义函数用来销毁当前活动窗口，打开参数 AFormClass指定的，要 use IWAppForm单

元 procedure TIWUserSession.Move(AFormClass: TIWAppFormClass); begin TIWAppForm(WebApplication.ActiveForm).Free; AFormClass.Create(WebApplication).Show; end; 当新生成一个 Session时执行以下程序。给一些变量赋初值，指定数据库连接并打开 procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject); begin mm := '~!@#$%^&*()_+|`1234567890-=\';//设定的一个密码 b := '1'; c := '1'; a := '101'; d := '1'; e := '1'; f := '1'; //全局数据连接 ADOConnection1.Close; ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +

IWServerController.AppPath + 'datas\data.mdb;Persist Security Info=False'; ADOConnection1.Open; end; 这个自定义函数用来替换指定字符的，通用的，不用详细查看，打开源代码自己看。 function TIWUserSession.ReplaceStrs(str, SearchStr, ReplaceStr: string): string; 响应 IE的关闭事件，关闭当前活动窗口，我们始终只使程序有一个窗口，关闭当前活动窗口就相

当于关闭了所有窗口，从而主动销毁当前 Session。 procedure TIWUserSession.closesessoion;

第 189页/共 301页

begin try TIWAppForm(WebApplication.ActiveForm).Free; except Exit; end; end; 这个自定义函数用来得到版权信息，并在其中加入了响应 IE 关闭事件的代码。

SubmitClickConfirm(''ComGrid'',''0_close'', true, '''')用来通知 intraweb执行窗口中的类似如下函数： procedure TIWindex.ComGridColumns0Click(ASender: TObject;const AValue: string); begin UserSession.closesessoion; end; 用来关闭当前活动窗口，从而主动销毁当前 Session，减少服务器的内存开支。当程序运行时点

击 IE的关闭按钮就会看到一个提示信息：“欢迎下次再来！”，就是在这里设定的。在每个有输出页面的窗口中我都放了一个 ComGrid控件，它的第一行 Columns0的 onclick事件都是如上，用来响应 IE的关闭事件。

function TIWUserSession.showBanQuan: string; begin ADOQuerylogin.Close; ADOQuerylogin.SQL.Clear; ADOQuerylogin.SQL.Add('select 版权信息 from G00网站管理员 '); ADOQuerylogin.Open; if ADOQuerylogin.RecordCount > 0 then begin Result := Trim(ADOQuerylogin.FieldByname('版权信息').Value); end; Result := Result + '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid'',''0_close'', true, '''');window.alert('' 欢迎下次再来！

'');}</script>'; ADOQuerylogin.Close; end; 4.2.4 unit MainMenu1导读这是一个 Tframe窗口。按如图 4-2-2示可以生成这种窗口：

图 4-2-2 生成 Frame窗口的菜单



第 190页/共 301页

其窗口界面如图 4-2-3所示：

图 4-2-3 Frame窗口内的控件布局

这是每页都出现的一些公共界面，我们在这个 TFrame 窗口中实现，它可以被注册成为控件面版

上的一个控件（在其上点击右键即有选项 add to pallete，点击它，这时会出现一个对话框，如图 4-2-4所示，选择一控件面版即可），其它页面要拥有这些公共界面，将注册的 TFrame窗口控件拖到窗口中即可。

图 4-2-4 Frame窗口注册对话框

左边是选择教材课程的册和章节，右边是菜单。下面解读一下程序代码：这个单元主要是响应菜单的点击。执行 UserSession.Move 函数，一般都是销毁当前窗口，打开

指定窗口。函数的参数是在窗口名前加 T即可。 procedure TMainMenu1.N5Click(Sender: TObject); begin UserSession.Move(TIWFormYongHuGuanLi);//打开用户管理窗口 IWFormYongHuGuanLi end; procedure TMainMenu1.MenuItem2Click(Sender: TObject); begin UserSession.Move(TIWFormShenQingZhuCe); //打开用户注册窗口 IWFormShenQingZhuCe end; procedure TMainMenu1.N15Click(Sender: TObject); begin if not UserSession.YiDengLu then//如果没有登录就不执行了 begin WebApplication.ShowMessage('请你先登录。'); Exit; end;



第 191页/共 301页

UserSession.Move(TIWFormYongHuXinXiChaXun);// 打开用户信息查询窗口

IWFormYongHuXinXiChaXun end; procedure TMainMenu1.N24Click(Sender: TObject); begin if not UserSession.YiDengLu then begin WebApplication.ShowMessage('请你先登录。'); Exit; end; UserSession.Move(TIWFormxiazaiYuYin); //打开音像剪接窗口 IWFormxiazaiYuYin，又名下载

语音 end; procedure TMainMenu1.N10Click(Sender: TObject); begin WebApplication.TerminateAndRedirect('files/exit.htm');//退出程序销毁 Session并打开 exit.htm

页面 end; 这个函数在点击确定链接时执行。主要是根据用户所选择的册和章节来显示相应的页面。 procedure TMainMenu1.IWLink1Click(Sender: TObject); begin UserSession.b := Trim(eIWComboBox1.Text); if IWRadioButton1.Checked then begin UserSession.a := '1'; UserSession.f :=

'1';UserSession.c := '1'; end; if IWRadioButton2.Checked then begin UserSession.a := '2'; UserSession.f :=

'2';UserSession.c := '2'; end; if Length(Trim(eIWComboBox1.Text)) = 1 then UserSession.a := UserSession.a + '0' + Trim(eIWComboBox1.Text) //学习的单元 else UserSession.a := UserSession.a + Trim(eIWComboBox1.Text); UserSession.d := Trim(eIWComboBox1.Text); UserSession.e := Trim(eIWComboBox2.Text); if Trim(eIWComboBox2.Text) = '1' then //显示 part1 的试题内容 begin UserSession.Move(TIWindex); Exit; end; if Trim(eIWComboBox2.Text) = '2' then //显示 part2 的试题内容 begin UserSession.Move(TIWFormpart2); Exit;



第 192页/共 301页

end; if Trim(eIWComboBox2.Text) = '3' then //显示 part3 的试题内容 begin UserSession.Move(TIWFormpart3); Exit; end; if Trim(eIWComboBox2.Text) = '4' then //显示 part4 的试题内容 begin UserSession.Move(TIWFormpart4); Exit; end; end; 每当生成时检查上一次的对册和章节的选择情况，使页面上的选择保持不变。 procedure TMainMenu1.IWFrameRegionCreate(Sender: TObject); begin if UserSession.f = '2' then IWRadioButton2.Checked:=true else IWRadioButton1.Checked:=true;//显示上次选择的册 eIWComboBox1.ItemIndex:=strtoint(UserSession.d)-1;// 显示上次选择的章 eIWComboBox2.ItemIndex:=strtoint(UserSession.e)-1;// 显示上次选择的节 end; 如果你在编程时有错误，请对应查阅本单元中 uses中的内容： uses {$IFDEF Linux}QForms, {$ELSE}Forms, {$ENDIF} {$IFDEF Linux}QControls, {$ELSE}Controls, {$ENDIF} {$IFDEF Linux}QGraphics, {$ELSE}Graphics, {$ENDIF} {$IFDEF Linux}QDialogs, {$ELSE}Dialogs, {$ENDIF} {$IFNDEF Linux} Windows, Messages, {$ENDIF} SysUtils, Classes, IWControl, IWHTMLControls, IWCompButton, IWCompLabel, IWAppForm, IWContainer, IWRegion, IWBaseControl, IWCompMenu, Menus, ImgList, IWImageList, IWVCLBaseControl, IWBaseHTMLControl, IWVCLBaseContainer, IWHTMLContainer, IWTMSMenus, IWCompListbox, IWCompRadioButton; 4.2.5 unit Uindex导读此窗口的模板文件为 IWindex.html，图 4-2-5是这个模板文件的视图：请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的 name。请用 delphi打开 unit

Uindex查看。IWRegionA和 IWRegion2控件内的所有控件不要在模板中出现。其内的所有控件会按照在 delphi中设计时的布局出现在网页中。当设置 IWRegionA的 visible属性为 false时，IWRegionA和



第 193页/共 301页

其内的所有控件都不会出现在网页中。Intraweb 不会生成它。这种方式很有用。例如：如果你是普通用户，只让你看到 IWRegionA内的内容，如果你是管理员，你可以通过一个按钮将 IWRegionA的 visible的属性改为 false，同时把 IWRegion2的 visible的属性改为 true，这样就进入管理页面了。是不是很简单？

图 4-2-5 IWindex.html模板文件视图

此页面是本程序的首页。主要完成登录和显示每一课的 part1的内容。IWRegionA内为学习功能模块，IWRegion2为管理功能模块。这个程序的权限控制是这样的。任何人都可以学习 32个英语课程，但只有注册过并登录的人才可以使用音像剪接和测试园地。登录的人如果是管理员的，则可以维护各

个模块。图 4-2-6为普通用户显示界面，图 4-2-7为管理员点击右下角的管理员维护后的界面：



第 194页/共 301页

图 4-2-6 普通用户显示界面

图 4-2-7 管理员维护后的界面

对应以上两个界面的窗口控件布局如图 4-2-8（各控件类型请打开源代码自己查看：将鼠标放在窗

口控件上即可显示）：TIWRegion内的控件运行时与设计时是一样的。在模板中只需要指定 TIWRegion控件出现的位置即可。



第 195页/共 301页

图 4-2-8 IWindexl窗口控件布局

各控件的使用方法与 delphi 中数据库编程时应用的控件使用方法类似。下面我说一下我的编程思

第 196页/共 301页

路。当窗口生成时，从数据库中取出版权信息，判断是否已经登录，是否显示欢迎信息，是否显示管

理员维护按钮，清除所填答案，根据 UserSession里的册和章节参数来查询 Part1的两种题型，将相应的字段取出来放在对应的显示控件里。答案也放在相应的控件中，当点击查看全部答案按钮时将这个

控件的 visible属性改为 true即可。当点击管理员维护按钮时将对应的信息显示在维护界面，修改完后点击确认修改向数据库提交数据。上传按钮是用来上传文件的。每个窗口中都放了一个控件：IWTemplateProcessorHTML1，并请指定每个窗口的 layoutmgr 属性

为 IWTemplateProcessorHTML1。使该页面可以使用 html模板。此处不用写任何代码。下面对一些代码进行讲解。 Procedure TIWindex.IWAppFormCreate(Sender: Tobject); begin BanQuan.Width := 750; BanQuan.HTMLText := ‘<div align=”center”>’ + UserSession.showBanQuan +

‘</div>’; //设置版权信息 if UserSession.YiDengLu then//如果已经登录 begin DengLuRuKo.Visible := False;//不再显示登录输入界面，DengLuRuKo是一个 TIWRegion控件，

它不可见，其内的所有控件都不可见。 IWRectangle1.Visible := true;//用来显示欢迎信息 IWRectangle1.Text := ‘ 欢迎 ’ +

UserSession.XingMing + ‘ 成功登录!关闭 IE 前请点击"退出程序"菜单。’;//欢迎信息内容，是 html代码。

If UserSession.GuanLi_News then//如果是管理员 IWLink8.Visible := true//显示管理员维护按钮 else IWLink8.Visible := False; end; IWRegion2.Visible := False;//不显示维护界面 IWLink1Click(Sender);//执行一段代码（如下一个函数）。 End; 以下函数从数据库中取出 Part1 的试题信息给界面控件赋值。这段代码如果不用 html 代码来格式

化显就会很简洁，代码虽多，但借助于 dreamweaver等网页编辑软件来实现还是很简单的。请参阅 html相关参考书。

procedure TIWindex.IWLink1Click(Sender: TObject); var luyinfile: string; begin IWEdit1.Text := ''; IWEdit2.Text := ''; IWEdit3.Text := ''; IWEdit4.Text := '';

第 197页/共 301页

IWEdit5.Text := ''; IWEdit6.Text := ''; IWEdit7.Text := ''; IWEdit8.Text := ''; IWEdit9.Text := ''; IWEdit10.Text := ''; IWMemo6.Text := ''; IWMemo7.Text := ''; IWMemo8.Text := ''; IWMemo9.Text := ''; IWMemo10.Text := ''; TIWHTMLLabeldaan.HTMLText := ''; //以上清空所填答案 //以下组装 TIWHTMLLabel1.HTMLText的 html代码（html代码可以借助 dreamweaver完成）： UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Iunitname where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount > 0 then TIWHTMLLabel1.HTMLText := 'Unit ' + UserSession.d + ': ' + Trim(UserSession.ADOQuerytemp.FieldByname('name').AsString) + ' ' + //显示课程名称

' <table width="100%" border="0" cellspacing="0">' + '<tr>' + '<td><div align="center">Part ' + '1 Listening</div></td>' + '</tr>' + '<tr>' + '<td><div align="center"> ---------Section' + 'A Spot' + ' Dictation---------</div></td>' + '</tr>' + '<tr>' + '<td>Lexical ' + 'Items:</td>' + '</tr>' + '</table>'; UserSession.ADOQuerytemp.Close; //------------------------------------------- if true then //以下显示 part1 的试题内容

第 198页/共 301页

begin UserSession.ADOQuerytemp.Close; //第一种题型 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Asd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给页面可视控件赋值（有很多值用 html代码来格式化显示）： if UserSession.ADOQuerytemp.RecordCount > 0 then begin IWMemo1.Lines.Text := Trim(UserSession.ADOQuerytemp.FieldByname('shengci').AsString); TIWHTMLLabel2.Text := '<table width="100%" border="0">' + '<tr>' + '<td>Directions:'; luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('directions').AsString); //如果录音

文件存在，就显示 if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then TIWHTMLLabel2.Text := TIWHTMLLabel2.Text + ' ' + '<a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img

border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>';//请注意这一句的组装技巧，应用此句的前提是要使用本程序对应的模板，切记。

TIWHTMLLabel2.Text := TIWHTMLLabel2.Text + '</td>' + '</tr>' + '</table>' + ' In this section you will hear a passage. While

listening, fill in the blanks with ' + 'the words or phrases you hear.'; IWMemo2.Lines.Text := '

'+Trim(UserSession.ADOQuerytemp.FieldByname('timu').AsString); IWMemo2.Lines.Text := UserSession.ReplaceStrs(IWMemo2.Lines.Text, ')', ')____'); luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('luyin').AsString); if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then TIWHTMLLabel3.HTMLText := ' 题目： ' + '<a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img

border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>';//如何调用 rm播放器播放事先设定好的视频文件

//----------------------------------- 当鼠标移动到题号上时显示单个答案 IWLabel4.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString); IWLabel5.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString);

第 199页/共 301页

IWLabel6.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan3').AsString); IWLabel7.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan4').AsString); IWLabel8.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString); IWLabel9.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan6').AsString); IWLabel10.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan7').AsString); IWLabel11.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan8').AsString); IWLabel12.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan9').AsString); IWLabel13.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan10').AsString); end; UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.Close; //第二种题型 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Bsd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给页面可视控件赋值（有很多值用 html代码来格式化显示）： if UserSession.ADOQuerytemp.RecordCount > 0 then begin TIWHTMLLabel4.Text := '<table width="100%" border="0"> ' + '<tr> ' + '<td><div align="center"> ---------Section' +

'B Sentence ' + 'Dictation---------</div></td>' + '</tr>' + '<tr> ' + '<td>Directions:'; luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('directions').AsString); //如果录音

文件存在，就显示 if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then TIWHTMLLabel4.Text := TIWHTMLLabel4.Text + ' ' + '<a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img

border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>'; TIWHTMLLabel4.Text := TIWHTMLLabel4.Text + '</td>' + '</tr>' + '</table>' + ' In this section you will hear five sentenes. ' + 'Write them down exactly as you hear them.';

第 200页/共 301页

luyinfile := Trim(UserSession.ADOQuerytemp.FieldByname('luyin1').AsString); if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then TIWHTMLLabel5.HTMLText := ' <a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>';








+ 'files/luyin/' + luyinfile + ''')" ><a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>'; //----------------------------------- 当鼠标移动到题号上时显示单个答案

IWLabel14.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString); IWLabel15.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString); IWLabel16.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan3').AsString); IWLabel17.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan4').AsString); IWLabel18.Hint:=Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString); end; UserSession.ADOQuerytemp.Close; end; end;

点击登录按钮后，执行如下代码： procedure TIWindex.IWLink5Click(Sender: Tobject); begin



第 201页/共 301页

if IWEdit16.Text = ‘’ then //输入框的验证 begin self.WebApplication.ShowMessage(‘请填入卡号!’); exit; end; if password.Text = ‘’ then //输入框的验证 begin self.WebApplication.ShowMessage(‘请填入密码!’); exit; end; UserSession.ADOQuerytemp.Close;//使用 UserSession内的变量例子 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add(‘select * from G01网站用户 where 卡号=:username and 密

码=:password’); UserSession.ADOQuerytemp.Parameters.ParamByName(‘username’).Value :=

GY.Encrypt_text(Trim(IWEdit16.Text), UserSession.mm); UserSession.ADOQuerytemp.Parameters.ParamByName(‘password’).Value :=

GY.Encrypt_text(Trim(password.Text), UserSession.mm); UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount = 1 then //从数据库取出登录信息存入 UserSession以

公用，请不要详究数据定义，请关注实现方法即可 begin UserSession.XingMing := UserSession.ADOQuerytemp.FieldByname(‘姓名’).Value; UserSession.KaHao := UserSession.ADOQuerytemp.FieldByname(‘卡号’).Value; UserSession.mima := UserSession.ADOQuerytemp.FieldByname(‘密码’).Value; UserSession.GuanLi_News := UserSession.ADOQuerytemp.FieldByname(‘管理新闻系统’).Value; UserSession.GuanLi_YuYin := UserSession.ADOQuerytemp.FieldByname(‘管理语音天地系

统’).Value; UserSession.DengLuShiJian := UserSession.ADOQuerytemp.FieldByname(‘登录时间’).AsString; UserSession.XiaWangShiJian := UserSession.ADOQuerytemp.FieldByname(‘下网时间’).AsString; UserSession.LeiJiShangWangShiJian := UserSession.ADOQuerytemp.FieldByname(‘累积上网时

间’).Value; UserSession.JinRiShangWangShiJian := UserSession.ADOQuerytemp.FieldByname(‘今日上网时

间’).Value; //在数据库中标记为已经登录，并更新一些字段信息 UserSession.ADOQuerytemp.Edit; UserSession.ADOQuerytemp.FieldByname(‘已登录’).Value := true; UserSession.YiDengLu := true; UserSession.ADOQuerytemp.FieldByname(‘ 登录时间 ’).Value := DateTimeToStr(Now);

UserSession.DengLuShiJian := DateTimeToStr(Now); UserSession.ADOQuerytemp.FieldByname(‘登录 IP’).Value := WebApplication.ip; UserSession.ip := WebApplication.ip;

第 202页/共 301页

UserSession.ADOQuerytemp.FieldByname(‘ 登录次数 ’).Value := UserSession.ADOQuerytemp.FieldByname(‘登录次数’).Value + 1;

UserSession.ADOQuerytemp.Post; UserSession.ADOQuerytemp.Close; DengLuRuKo.Visible := False;//不再显示登录输入界面 IWRectangle1.Visible := true;//显示欢迎信息如下 IWRectangle1.Text :=’ ’+’ 欢迎 ’ + UserSession.XingMing + ‘ 成功登录 !关闭 IE 前请点击"退出程序"菜单。’;

IWEdit16.Text := ‘’; password.Text := ‘’;

if UserSession.GuanLi_News then//如果是管理员 IWLink8.Visible := true//显示管理员维护按钮 else IWLink8.Visible := False; end; end else//如果没有此用户 begin self.WebApplication.ShowMessage(‘用户名或密码错误，请重新输入!’);//显示一个弹出的信息框 IWEdit16.Text := ‘’;//清空用户名输入框 password.Text := ‘’; //清空密码输入框 end;

UserSession.ADOQuerytemp.Close;//关闭查询控件，请每次这样做 end;

点击请先安装 RealPlayer按钮时执行如下代码： procedure TIWindex.IWLinkRMClick(Sender: Tobject); begin self.WebApplication.SendFile(WebApplication.ApplicationPath +

‘files\RealPlayer10.5.rar’,false,’’,’RealPlayer10-5.rar’);//让用户下载 files\RealPlayer10.5.rar 文件，下载保存文件名默认为 RealPlayer10-5.rar

end; 点击管理员维护按钮时执行如下代码： procedure TIWindex.IWLink8Click(Sender: Tobject); begin IWRegionA.Visible := False;//不显示学习界面 TIWHTMLLabeldaan.Visible:=false; //不显示题型一答案界面

TIWHTMLLabeldaan2.Visible:=false; //不显示题型二答案界面 IWRegion2.Visible := true;//显示管理员维护界面 end; procedure TIWindex.IWRegion2Render(Sender: Tobject);//当管理员维护界面 IWRegion2在页面



第 203页/共 301页

输出时执行，目的是将数据库的记录取出赋值给相应的控件。 begin UserSession.ADOQuerytemp.Close; //第一种题型 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Asd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给页面可视控件赋值： if UserSession.ADOQuerytemp.RecordCount > 0 then begin IWMemo3.Text := Trim(UserSession.ADOQuerytemp.FieldByname('shengci').AsString); IWMemo4.Text := Trim(UserSession.ADOQuerytemp.FieldByname('timu').AsString); IWMemo5.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyintxt').AsString); IWEdit17.Text := Trim(UserSession.ADOQuerytemp.FieldByname('directions').AsString); IWEdit18.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin').AsString); IWEdit19.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString); IWEdit20.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString); IWEdit21.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan3').AsString); IWEdit22.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan4').AsString); IWEdit23.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString); IWEdit24.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan6').AsString); IWEdit25.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan7').AsString); IWEdit26.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan8').AsString); IWEdit27.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan9').AsString); IWEdit28.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan10').AsString); end;

UserSession.ADOQuerytemp.Close; //第二种题型 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Bsd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给页面可视控件赋值： if UserSession.ADOQuerytemp.RecordCount > 0 then begin IWMemo11.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString); IWMemo12.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString); IWMemo13.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan3').AsString); IWMemo14.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan4').AsString); IWMemo15.Text := Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString); IWEdit34.Text := Trim(UserSession.ADOQuerytemp.FieldByname('directions').AsString); IWEdit35.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin1').AsString); IWEdit36.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin2').AsString); IWEdit37.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin3').AsString); IWEdit38.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin4').AsString); IWEdit39.Text := Trim(UserSession.ADOQuerytemp.FieldByname('luyin5').AsString);

第 204页/共 301页

end; UserSession.ADOQuerytemp.Close; end; 点击第一个查看全部答案链接（即第一种题型答案）时执行如下代码： procedure TIWindex.IWLink2Click(Sender: TObject); begin

TIWHTMLLabeldaan2.HTMLText := '';//清空第二个题型的答案内容 //以下查询答案 UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Asd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //以下对答案进行 html处理，也就是用 html代码来格式化显示答案，将答案用特定的颜色标示出

来 if UserSession.ADOQuerytemp.RecordCount > 0 then begin TIWHTMLLabeldaan.HTMLText := 'Spot Dictation

Tapescript: &nbsp' + UserSession.ReplaceStrs(Trim(UserSession.ADOQuerytemp.FieldByname('luyintxt').AsString), '#', ' &nbsp');

TIWHTMLLabeldaan.HTMLText := UserSession.ReplaceStrs(TIWHTMLLabeldaan.HTMLText, Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString), '' + Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString) + '');







TIWHTMLLabeldaan.HTMLText := UserSession.ReplaceStrs(TIWHTMLLabeldaan.HTMLText, Trim(UserSession.ADOQuerytemp.FieldByname('daan8').AsString), '' +

第 205页/共 301页

Trim(UserSession.ADOQuerytemp.FieldByname('daan8').AsString) + ''); TIWHTMLLabeldaan.HTMLText := UserSession.ReplaceStrs(TIWHTMLLabeldaan.HTMLText,

Trim(UserSession.ADOQuerytemp.FieldByname('daan9').AsString), '' + Trim(UserSession.ADOQuerytemp.FieldByname('daan9').AsString) + '');


//如果答案正确则标示为红色： if Trim(IWEdit1.Text) = Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString) then

IWEdit1.Font.Color := clRed; if Trim(IWEdit2.Text) = Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString) then









IWEdit10.Font.Color := clRed; end; UserSession.ADOQuerytemp.Close; end; 点击第二个查看全部答案链接（即第二种题型答案）时执行如下代码： procedure TIWindex.IWLink3Click(Sender: TObject); begin TIWHTMLLabeldaan.HTMLText := '';//清空第一种题型答案 //查询答案： UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Bsd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //以下对答案进行 html处理，也就是用 html代码来格式化显示答案，将答案用特定的颜色标示出

来

第 206页/共 301页

if UserSession.ADOQuerytemp.RecordCount > 0 then begin TIWHTMLLabeldaan2.HTMLText := 'Sentenes Dictation

Tapescript:' + ' 1.' +

Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString) + ' 2.' +




Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString); //如果答案正确则标示为红色： if Trim(IWMemo6.Text) = Trim(UserSession.ADOQuerytemp.FieldByname('daan1').AsString) then

IWMemo6.Font.Color := clRed; if Trim(IWMemo7.Text) = Trim(UserSession.ADOQuerytemp.FieldByname('daan2').AsString) then



IWMemo9.Font.Color := clRed; if Trim(IWMemo10.Text) = Trim(UserSession.ADOQuerytemp.FieldByname('daan5').AsString)

then IWMemo10.Font.Color := clRed; end; UserSession.ADOQuerytemp.Close; end; 点击确认修改时执行如下代码： procedure TIWindex.IWLink7Click(Sender: TObject); begin

UserSession.ADOQuerytemp.Close; //第一种题型：找到该记录 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Asd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给该记录赋值： if UserSession.ADOQuerytemp.RecordCount > 0 then begin UserSession.ADOQuerytemp.Edit; UserSession.ADOQuerytemp.FieldByname('shengci').AsString := IWMemo3.Text; UserSession.ADOQuerytemp.FieldByname('timu').AsString := IWMemo4.Text; UserSession.ADOQuerytemp.FieldByname('luyintxt').AsString := IWMemo5.Text; UserSession.ADOQuerytemp.FieldByname('directions').AsString := IWEdit17.Text;



第 207页/共 301页

UserSession.ADOQuerytemp.FieldByname('luyin').AsString := IWEdit18.Text; UserSession.ADOQuerytemp.FieldByname('daan1').AsString := IWEdit19.Text; UserSession.ADOQuerytemp.FieldByname('daan2').AsString := IWEdit20.Text; UserSession.ADOQuerytemp.FieldByname('daan3').AsString := IWEdit21.Text; UserSession.ADOQuerytemp.FieldByname('daan4').AsString := IWEdit22.Text; UserSession.ADOQuerytemp.FieldByname('daan5').AsString := IWEdit23.Text; UserSession.ADOQuerytemp.FieldByname('daan6').AsString := IWEdit24.Text; UserSession.ADOQuerytemp.FieldByname('daan7').AsString := IWEdit25.Text; UserSession.ADOQuerytemp.FieldByname('daan8').AsString := IWEdit26.Text; UserSession.ADOQuerytemp.FieldByname('daan9').AsString := IWEdit27.Text; UserSession.ADOQuerytemp.FieldByname('daan10').AsString := IWEdit28.Text; UserSession.ADOQuerytemp.Post; end;

UserSession.ADOQuerytemp.Close; //第二种题型：找到该记录 UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Bsd where unit =''' + UserSession.a + ''''); UserSession.ADOQuerytemp.Open; //给该记录赋值： if UserSession.ADOQuerytemp.RecordCount > 0 then begin UserSession.ADOQuerytemp.Edit; UserSession.ADOQuerytemp.FieldByname('daan1').AsString := IWMemo11.Text; UserSession.ADOQuerytemp.FieldByname('daan2').AsString := IWMemo12.Text; UserSession.ADOQuerytemp.FieldByname('daan3').AsString := IWMemo13.Text; UserSession.ADOQuerytemp.FieldByname('daan4').AsString := IWMemo14.Text; UserSession.ADOQuerytemp.FieldByname('daan5').AsString := IWMemo15.Text; UserSession.ADOQuerytemp.FieldByname('directions').AsString := IWEdit34.Text; UserSession.ADOQuerytemp.FieldByname('luyin1').AsString := IWEdit35.Text; UserSession.ADOQuerytemp.FieldByname('luyin2').AsString := IWEdit36.Text; UserSession.ADOQuerytemp.FieldByname('luyin3').AsString := IWEdit37.Text; UserSession.ADOQuerytemp.FieldByname('luyin4').AsString := IWEdit38.Text; UserSession.ADOQuerytemp.FieldByname('luyin5').AsString := IWEdit39.Text; UserSession.ADOQuerytemp.Post; end; UserSession.ADOQuerytemp.Close; self.WebApplication.ShowMessage('修改完毕！'); end; 这一节代码虽不少但都是一些给相应的控件的赋值操作，代码可以重复拷贝稍作修改即可，所以，

如果界面设计好后程序编写速度应该很快。这与原 delphi下的编程完全类似。各个控件的使用参考相应的代码即可学会，而且这种编程方法将程序设计与界面设计分开，也有利于编程的分工合作。最后请在每个窗口的 javascript属性中加入如下代码，目的是让鼠标放在链接上时有彩虹效果。不

用明白代码是怎么实现的，照抄就行：



第 208页/共 301页

var rate = 30; var obj; var act = 0; var elmH = 0; var elmS = 128; var elmV = 255; var clrOrg; var TimerID; if (navigator.appName.indexOf(“Microsoft”,0) != -1 && parseInt(navigator.appVersion) >= 4) { Browser = true; } else { Browser = false; } if (Browser) { document.onmouseover = doRainbowAnchor; document.onmouseout = stopRainbowAnchor; } function doRainbow() { if (Browser && act != 1) { act = 1; obj = event.srcElement; clrOrg = obj.style.color; TimerID = setInterval(“ChangeColor()”,100); } } function stopRainbow() { if (Browser && act != 0) { obj.style.color = clrOrg; clearInterval(TimerID); act = 0; } } function doRainbowAnchor() { if (Browser && act != 1) { obj = event.srcElement; while (obj.tagName != ‘A’ && obj.tagName != ‘BODY’) { obj = obj.parentElement; if (obj.tagName == ‘A’ || obj.tagName == ‘BODY’) break;

第 209页/共 301页

} if (obj.tagName == ‘A’ && obj.href != ‘’) { act = 1; clrOrg = obj.style.color; TimerID = setInterval(“ChangeColor()”,100); } } } function stopRainbowAnchor() { if (Browser && act != 0) { if (obj.tagName == ‘A’) { obj.style.color = clrOrg; clearInterval(TimerID); act = 0; } } } function ChangeColor() { obj.style.color = makeColor(); } function makeColor() { if (elmS == 0) { elmR = elmV; elmG = elmV; elmB = elmV; } else { t1 = elmV; t2 = (255 – elmS) * elmV / 255; t3 = elmH % 60; t3 = (t1 – t2) * t3 / 60; if (elmH < 60) { elmR = t1; elmB = t2; elmG = t2 + t3; } else if (elmH < 120) { elmG = t1; elmB = t2; elmR = t1 – t3; } else if (elmH < 180) { elmG = t1; elmR = t2; elmB = t2 + t3; } else if (elmH < 240) {

第 210页/共 301页

elmB = t1; elmR = t2; elmG = t1 – t3; } else if (elmH < 300) { elmB = t1; elmG = t2; elmR = t2 + t3; } else if (elmH < 360) { elmR = t1; elmG = t2; elmB = t1 – t3; } else { elmR = 0; elmG = 0; elmB = 0; } } elmR = Math.floor(elmR); elmG = Math.floor(elmG); elmB = Math.floor(elmB); clrRGB = ‘#’ + elmR.toString(16) + elmG.toString(16) + elmB.toString(16); elmH = elmH + rate; if (elmH >= 360) elmH = 0; return clrRGB; }

请在每个窗口的 extraheader属性中加入如下代码，目的是让窗口每次输出页面时都有一个特效： <meta HTTP-EQUIV=”Page-Enter” CONTENT=”revealtrans(duration=0.5, transition=23)”>

每个窗口中放了一个 ComGrid控件，是用来响应页面 IE的关闭事件的。在 UserSession中已有相

关说明。以后不再提及。 procedure TIWindex.ComGridColumns0Click(ASender: TObject;const AValue: string); begin UserSession.closesessoion;//用来关闭当前活动窗口 end; 4.2.6 unit Upart2导读这个单元与 unit Uindex单元很类似，这个单元用来显示一个英语课程的 Part2 的两种题型。此窗

口的模板文件为 IWFormpart2.html，图 4-2-9是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegionA和 IWRegion2控件内的所有控件不要在模板中出现。其内的所有控件会按照在 delphi中设计时的布局出现在网页中。当设置 IWRegionA的 visible属性为 false时，IWRegionA和其内的所有控件都不会出现在网页中。Intraweb不会生成它。这种方式很有用。例如：如果你是普通用户，只让你看到 IWRegionA内的内容，如果你是管理员，你可以通过一个按钮将 IWRegionA的 visible的属性改为 false，同时把 IWRegion2的 visible的属性改为 true，这样就进入管理页面了。



第 211页/共 301页

图 4-2-9 IWFormpart2.html模板文件视图

图 4-2-10为普通用户显示界面，图 4-2-11为管理员点击右下角的管理员维护后的界面：


图 4-2-11 管理员维护界面对应以上两个界面的窗口控件布局如图 4-2-12（各控件类型请打开源代码自己查看：将鼠标放在



第 212页/共 301页

窗口控件上即可显示）：TIWRegion 内的控件运行时与设计时是一样的。在模板中只需要指定TIWRegion控件出现的位置即可。



第 213页/共 301页

图 4-2-12 IWFormpart2窗口控件布局



第 214页/共 301页




控件的 visible属性改为 true即可。当点击管理员维护按钮时将对应的信息显示在维护界面，修改完后点击确认修改向数据库提交数据。上传按钮是用来上传文件的。此页面代码难度与 unit Uindex单元一样。主要的不同在于可视控件不完全一样，这主要是因为题

型不一样的缘故。如果 unit Uindex单元的代码可以看明白，这个单元当然也没有问题。在此不对代码作进一步的说明。

4.2.7 unit Upart3导读这个单元与 unit Uindex单元很类似，这个单元用来显示一个英语课程的 Part3 的三种题型。此窗

口的模板文件为 IWFormpart3.html，图 4-2-13 是这个模板文件的视图。请大家用 dreamweaver 打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegionA和 IWRegion2控件内的所有控件不要在模板中出现。其内的所有控件会按照在 delphi 中设计时的布局出现在网页中。当设置 IWRegionA 的visible属性为 false时，IWRegionA和其内的所有控件都不会出现在网页中。Intraweb不会生成它。这种方式很有用。例如：如果你是普通用户，只让你看到 IWRegionA内的内容，如果你是管理员，你可以通过一个按钮将 IWRegionA的 visible的属性改为 false，同时把 IWRegion2的 visible的属性改为 true，这样就进入管理页面了。

图 4-2-13 IWFormpart3.html模板文件视图图 4-2-14为普通用户显示界面，图 4-2-15为管理员点击右下角的管理员维护后的界面：



第 215页/共 301页






第 216页/共 301页





控件的 visible属性改为 true即可。当点击管理员维护按钮时将对应的信息显示在维护界面，修改完后点击确认修改向数据库提交数据。上传按钮是用来上传文件的。此页面代码难度与 unit Uindex单元一样。主要的不同在于可视控件不完全一样，这主要是因为题

型不一样的缘故。如果 unit Uindex单元的代码可以看明白，这个单元当然也没有问题。在此不对代码作进一步的说明。

4.2.8 unit Upart4导读这个单元与 unit Uindex单元很类似，这个单元用来显示一个英语课程的 Part4 的一种题型。此窗

口的模板文件为 IWFormpart4.html，图 4-2-17 是这个模板文件的视图。请大家用 dreamweaver 打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegionA和 IWRegion2控件内的所有控件不要在模板中出现。其内的所有控件会按照在 delphi 中设计时的布局出现在网页中。当设置 IWRegionA 的



第 217页/共 301页

visible属性为 false时，IWRegionA和其内的所有控件都不会出现在网页中。Intraweb不会生成它。这种方式很有用。例如：如果你是普通用户，只让你看到 IWRegionA内的内容，如果你是管理员，你可以通过一个按钮将 IWRegionA的 visible的属性改为 false，同时把 IWRegion2的 visible的属性改为 true，这样就进入管理页面了。

图 4-2-17 IWFormpart4.html模板文件视图







第 218页/共 301页




理员维护按钮，清除所填答案，根据 UserSession里的册和章节参数来查询 Part4的题型，将相应的字段取出来放在对应的显示控件里。答案也放在相应的控件中，当点击查看全部答案按钮时将这个控件

的 visible属性改为 true即可。当点击管理员维护按钮时将对应的信息显示在维护界面，修改完后点击确认修改向数据库提交数据。上传按钮是用来上传文件的。



第 219页/共 301页

此页面代码难度比 unit Uindex单元简单。主要的不同在于可视控件不完全一样，这主要是因为题型不一样的缘故。如果 unit Uindex单元的代码可以看明白，这个单元当然也没有问题。在此不对代码作进一步的说明。到这里为止，大家可以看出，这与原来的用 delphi 编程没有什么区别，只是换了几个控件而已。

而且这些控件的使用都是很简单的。属性几乎一看就明白，方法也基本上一看就知道是什么意思。而

且这 4个单元极其相似，真正编程时有大部分代码是可以拷贝重用的。所以编程效率是很高的。

4.2.9 unit Unitcsyd（测试园地）导读这个单元与 unit Uindex单元很类似，这个单元用来显示一个英语测试的两种题型。此窗口的模板

文件为 IWFormcsyd.html，图 4-2-21是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegionA和 IWRegion2控件内的所有控件不要在模板中出现。其内的所有控件会按照在 delphi 中设计时的布局出现在网页中。当设置 IWRegionA 的 visible 属性为false时，IWRegionA和其内的所有控件都不会出现在网页中。Intraweb不会生成它。这种方式很有用。例如：如果你是普通用户，只让你看到 IWRegionA内的内容，如果你是管理员，你可以通过一个按钮将 IWRegionA的 visible的属性改为 false，同时把 IWRegion2的 visible的属性改为 true，这样就进入管理页面了。

图 4-2-21 IWFormcsyd.html模板文件视图




第 220页/共 301页






第 221页/共 301页

图 4-2-24 IWFormcsyd窗口控件布局

下面对一些代码进行讲解。 procedure TIWFormcsyd.IWComboBox1Change(Sender: TObject);//根据选择的单元进行出题 var luyinfile, a, script, key, key2: string; begin

第 222页/共 301页

//清空答案 IWEdit1.Text := ''; IWEdit2.Text := ''; IWEdit3.Text := ''; IWEdit4.Text := ''; IWEdit5.Text := ''; IWEdit6.Text := ''; IWEdit7.Text := ''; IWEdit8.Text := ''; IWEdit9.Text := ''; IWEdit10.Text := ''; IWEdit11.Text := ''; IWEdit12.Text := ''; IWEdit13.Text := ''; IWEdit14.Text := ''; IWEdit15.Text := ''; //清空答案 a := rightstr(trim(IWComboBox1.Text), 2);//得出是哪个单元 UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Jcsyd where uint =''' + a + '''');//查询该单元题目 UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount = 1 then //如果此单元有题目 begin TIWHTMLLabel0.HTMLText := '<table width="100%" border="0">' + '<tr> ' + '<td>测试' + a + ': LISTENING COMPREHENSION (15 minutes, 15 points)'; luyinfile := trim(UserSession.ADOQuerytemp.FieldByname('luyin').AsString); if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\luyin\' + luyinfile) then //如果录音文件存在，就显示 TIWHTMLLabel0.Text := TIWHTMLLabel0.Text + ' Directions:' + '<a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音"></a>'; //以上两句为在页面上生成播放该录音文件的链接，前提是使用本程序自带的模板，因为它调用了模板内的相应代码。请大家好好研究一下模板，该模板可以用来制作播放影音文件的相关程序。 TIWHTMLLabel0.Text := TIWHTMLLabel0.Text + ' </td> ' + '</tr> ' + '<tr> ' + '<td>Section A (1 point each) ' + '</td>' +

第 223页/共 301页

'</tr>' + '<tr> ' + '<td>Directions: In this section, you will hear nine short ' + 'conversations between two speakers. At the end of each conversation, a third ' + 'voice will ask a question about what was said. The question will be spoken ' + 'only once. Choose the best answer from the four choices given by marking ' + 'the corresponding letter with a single bar across the square brackets on ' + 'your Machine-scoring Answer Sheet.</td>' + '</tr>' + '</table> '; //以上为用 html代码格式化显示题干内容，显示效果如图 4-2-22最上面所示。 //以下显示试题内容和答案，在点击“查看答案”按钮前，所有显示答案的控件的 visible属性都是 false。 TIWHTMLLabel1.Text := '1.' + trim(UserSession.ADOQuerytemp.FieldByname('A1').AsString);//在TIWHTMLLabel1中显示 A1字段的内容(第一小题) TIWHTMLLabel1.Text := UserSession.ReplaceStrs(TIWHTMLLabel1.Text, '[B', ' [B');//对该题目的字串进行 html 改造：将[B替换成 [B，目的是换行且留下两个空格。以下两句相似。 TIWHTMLLabel1.Text := UserSession.ReplaceStrs(TIWHTMLLabel1.Text, '[C', ' [C'); TIWHTMLLabel1.Text := UserSession.ReplaceStrs(TIWHTMLLabel1.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript1').AsString);//取出录音文字材料 key := trim(UserSession.ADOQuerytemp.FieldByname('Akey1').AsString);//取出该题目的答案 TIWSmartPanel1.Lines.Text := '1.Tape Script: ' + script + ' [Key]:' + key + '';//将录音文字材料和答案放在TIWSmartPanel1控件中。 //************************************以下每个题目都是使用了类似的方法： TIWHTMLLabel2.Text := '2.' + trim(UserSession.ADOQuerytemp.FieldByname('A2').AsString); TIWHTMLLabel2.Text := UserSession.ReplaceStrs(TIWHTMLLabel2.Text, '[B', ' [B'); TIWHTMLLabel2.Text := UserSession.ReplaceStrs(TIWHTMLLabel2.Text, '[C', ' [C'); TIWHTMLLabel2.Text := UserSession.ReplaceStrs(TIWHTMLLabel2.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript2').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey2').AsString); TIWSmartPanel2.Lines.Text := '2.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel3.Text := '3.' + trim(UserSession.ADOQuerytemp.FieldByname('A3').AsString); TIWHTMLLabel3.Text := UserSession.ReplaceStrs(TIWHTMLLabel3.Text, '[B', ' [B');

第 224页/共 301页

TIWHTMLLabel3.Text := UserSession.ReplaceStrs(TIWHTMLLabel3.Text, '[C', ' [C'); TIWHTMLLabel3.Text := UserSession.ReplaceStrs(TIWHTMLLabel3.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript3').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey3').AsString); TIWSmartPanel3.Lines.Text := '3.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel4.Text := '4.' + trim(UserSession.ADOQuerytemp.FieldByname('A4').AsString); TIWHTMLLabel4.Text := UserSession.ReplaceStrs(TIWHTMLLabel4.Text, '[B', ' [B'); TIWHTMLLabel4.Text := UserSession.ReplaceStrs(TIWHTMLLabel4.Text, '[C', ' [C'); TIWHTMLLabel4.Text := UserSession.ReplaceStrs(TIWHTMLLabel4.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript4').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey4').AsString); TIWSmartPanel4.Lines.Text := '4.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel5.Text := '5.' + trim(UserSession.ADOQuerytemp.FieldByname('A5').AsString); TIWHTMLLabel5.Text := UserSession.ReplaceStrs(TIWHTMLLabel5.Text, '[B', ' [B'); TIWHTMLLabel5.Text := UserSession.ReplaceStrs(TIWHTMLLabel5.Text, '[C', ' [C'); TIWHTMLLabel5.Text := UserSession.ReplaceStrs(TIWHTMLLabel5.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript5').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey5').AsString); TIWSmartPanel5.Lines.Text := '5.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel6.Text := '6.' + trim(UserSession.ADOQuerytemp.FieldByname('A6').AsString); TIWHTMLLabel6.Text := UserSession.ReplaceStrs(TIWHTMLLabel6.Text, '[B', ' [B'); TIWHTMLLabel6.Text := UserSession.ReplaceStrs(TIWHTMLLabel6.Text, '[C', ' [C'); TIWHTMLLabel6.Text := UserSession.ReplaceStrs(TIWHTMLLabel6.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript6').AsString);

第 225页/共 301页

key := trim(UserSession.ADOQuerytemp.FieldByname('Akey6').AsString); TIWSmartPanel6.Lines.Text := '6.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel7.Text := '7.' + trim(UserSession.ADOQuerytemp.FieldByname('A7').AsString); TIWHTMLLabel7.Text := UserSession.ReplaceStrs(TIWHTMLLabel7.Text, '[B', ' [B'); TIWHTMLLabel7.Text := UserSession.ReplaceStrs(TIWHTMLLabel7.Text, '[C', ' [C'); TIWHTMLLabel7.Text := UserSession.ReplaceStrs(TIWHTMLLabel7.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript7').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey7').AsString); TIWSmartPanel7.Lines.Text := '7.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel8.Text := '8.' + trim(UserSession.ADOQuerytemp.FieldByname('A8').AsString); TIWHTMLLabel8.Text := UserSession.ReplaceStrs(TIWHTMLLabel8.Text, '[B', ' [B'); TIWHTMLLabel8.Text := UserSession.ReplaceStrs(TIWHTMLLabel8.Text, '[C', ' [C'); TIWHTMLLabel8.Text := UserSession.ReplaceStrs(TIWHTMLLabel8.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript8').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey8').AsString); TIWSmartPanel8.Lines.Text := '8.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************ TIWHTMLLabel9.Text := '9.' + trim(UserSession.ADOQuerytemp.FieldByname('A9').AsString); TIWHTMLLabel9.Text := UserSession.ReplaceStrs(TIWHTMLLabel9.Text, '[B', ' [B'); TIWHTMLLabel9.Text := UserSession.ReplaceStrs(TIWHTMLLabel9.Text, '[C', ' [C'); TIWHTMLLabel9.Text := UserSession.ReplaceStrs(TIWHTMLLabel9.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Ascript9').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Akey9').AsString); TIWSmartPanel9.Lines.Text := '9.Tape Script: ' + script + ' [Key]:' + key + ''; //************************************

第 226页/共 301页

//------------------------------------------- 另一题型 TIWHTMLLabelpassage.HTMLText := '<table width="100%" border="0">' + '<tr> ' + '<td>Section B (1 point each) ' + '</td>' + '</tr>' + '<tr> ' + '<td>Directions: In this section, you will hear three short passages. ' + 'At the end of each passage, there will be some questions. Both the passage and the questions ' + 'will be read to you only once. After each question, there will be a pause. During the pause, ' + 'you must choose the best answer from the four choices given by marking the corresponding letter ' + 'with a single bar across the square brackets on your Machine-scoring Answer Sheet.</td>' + '</tr>' + '</table> '; TIWHTMLLabel10.Text := '10.' + trim(UserSession.ADOQuerytemp.FieldByname('B10').AsString); TIWHTMLLabel10.Text := UserSession.ReplaceStrs(TIWHTMLLabel10.Text, '[B', ' [B'); TIWHTMLLabel10.Text := UserSession.ReplaceStrs(TIWHTMLLabel10.Text, '[C', ' [C'); TIWHTMLLabel10.Text := UserSession.ReplaceStrs(TIWHTMLLabel10.Text, '[D', ' [D'); //************************************ TIWHTMLLabel11.Text := '11.' + trim(UserSession.ADOQuerytemp.FieldByname('B11').AsString); TIWHTMLLabel11.Text := UserSession.ReplaceStrs(TIWHTMLLabel11.Text, '[B', ' [B'); TIWHTMLLabel11.Text := UserSession.ReplaceStrs(TIWHTMLLabel11.Text, '[C', ' [C'); TIWHTMLLabel11.Text := UserSession.ReplaceStrs(TIWHTMLLabel11.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Bscript1').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Bkey10').AsString); key2 := trim(UserSession.ADOQuerytemp.FieldByname('Bkey11').AsString); TIWSmartPanel11.Lines.Text := '10 and 11.Tape Script: ' + script + ' [Key]10:' + key + '' + ' [Key]11:' + key2 + ''; //************************************ TIWHTMLLabel12.Text := '12.' + trim(UserSession.ADOQuerytemp.FieldByname('B12').AsString); TIWHTMLLabel12.Text := UserSession.ReplaceStrs(TIWHTMLLabel12.Text, '[B', ' [B'); TIWHTMLLabel12.Text := UserSession.ReplaceStrs(TIWHTMLLabel12.Text, '[C',

第 227页/共 301页

' [C'); TIWHTMLLabel12.Text := UserSession.ReplaceStrs(TIWHTMLLabel12.Text, '[D', ' [D'); //************************************ TIWHTMLLabel13.Text := '13.' + trim(UserSession.ADOQuerytemp.FieldByname('B13').AsString); TIWHTMLLabel13.Text := UserSession.ReplaceStrs(TIWHTMLLabel13.Text, '[B', ' [B'); TIWHTMLLabel13.Text := UserSession.ReplaceStrs(TIWHTMLLabel13.Text, '[C', ' [C'); TIWHTMLLabel13.Text := UserSession.ReplaceStrs(TIWHTMLLabel13.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Bscript2').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Bkey12').AsString); key2 := trim(UserSession.ADOQuerytemp.FieldByname('Bkey13').AsString); TIWSmartPanel13.Lines.Text := '12 and 13.Tape Script: ' + script + ' [Key]12:' + key + '' + ' [Key]13:' + key2 + ''; //************************************ TIWHTMLLabel14.Text := '14.' + trim(UserSession.ADOQuerytemp.FieldByname('B14').AsString); TIWHTMLLabel14.Text := UserSession.ReplaceStrs(TIWHTMLLabel14.Text, '[B', ' [B'); TIWHTMLLabel14.Text := UserSession.ReplaceStrs(TIWHTMLLabel14.Text, '[C', ' [C'); TIWHTMLLabel14.Text := UserSession.ReplaceStrs(TIWHTMLLabel14.Text, '[D', ' [D'); //************************************ TIWHTMLLabel15.Text := '15.' + trim(UserSession.ADOQuerytemp.FieldByname('B15').AsString); TIWHTMLLabel15.Text := UserSession.ReplaceStrs(TIWHTMLLabel15.Text, '[B', ' [B'); TIWHTMLLabel15.Text := UserSession.ReplaceStrs(TIWHTMLLabel15.Text, '[C', ' [C'); TIWHTMLLabel15.Text := UserSession.ReplaceStrs(TIWHTMLLabel15.Text, '[D', ' [D'); script := trim(UserSession.ADOQuerytemp.FieldByname('Bscript3').AsString); key := trim(UserSession.ADOQuerytemp.FieldByname('Bkey14').AsString); key2 := trim(UserSession.ADOQuerytemp.FieldByname('Bkey15').AsString); TIWSmartPanel15.Lines.Text := '14 and 15.Tape Script: ' + script + ' [Key]14:' + key + '' + ' [Key]15:' + key2 + ''; //************************************ end



第 228页/共 301页

else //如果此单元无题目 begin TIWSmartPanel1.Lines.Text := ''; TIWSmartPanel2.Lines.Text := ''; TIWSmartPanel3.Lines.Text := ''; TIWSmartPanel4.Lines.Text := ''; TIWSmartPanel5.Lines.Text := ''; TIWSmartPanel6.Lines.Text := ''; TIWSmartPanel7.Lines.Text := ''; TIWSmartPanel8.Lines.Text := ''; TIWSmartPanel9.Lines.Text := ''; TIWSmartPanel11.Lines.Text := ''; TIWSmartPanel3.Lines.Text := ''; TIWSmartPanel5.Lines.Text := ''; TIWHTMLLabel1.Text := ''; TIWHTMLLabel2.Text := ''; TIWHTMLLabel3.Text := ''; TIWHTMLLabel4.Text := ''; TIWHTMLLabel5.Text := ''; TIWHTMLLabel6.Text := ''; TIWHTMLLabel7.Text := ''; TIWHTMLLabel8.Text := ''; TIWHTMLLabel9.Text := ''; TIWHTMLLabel10.Text := ''; TIWHTMLLabel11.Text := ''; TIWHTMLLabel12.Text := ''; TIWHTMLLabel13.Text := ''; TIWHTMLLabel14.Text := ''; TIWHTMLLabel15.Text := ''; self.WebApplication.ShowMessage('暂无题目，请等候加入。'); end; UserSession.ADOQuerytemp.Close;//关闭数据库查询控件 //以下 12句将答案显示控件隐藏 TIWSmartPanel1.Visible := false; TIWSmartPanel2.Visible := false; TIWSmartPanel3.Visible := false; TIWSmartPanel4.Visible := false; TIWSmartPanel5.Visible := false; TIWSmartPanel6.Visible := false; TIWSmartPanel7.Visible := false; TIWSmartPanel8.Visible := false; TIWSmartPanel9.Visible := false; TIWSmartPanel11.Visible := false;

第 229页/共 301页

TIWSmartPanel13.Visible := false; TIWSmartPanel15.Visible := false; end; procedure TIWFormcsyd.IWAppFormCreate(Sender: TObject);//窗口生成时执行 begin //版权信息 BanQuan.Width := 750; BanQuan.HTMLText := '<div align="center">' + UserSession.showBanQuan + '</div>'; if UserSession.GuanLi_News then//如果是管理员则显示 IWLink8控件，这样就有管理员维护按钮出现 IWLink8.Visible := true else

IWLink8.Visible := false;

IWRegion2.Visible := false;//隐藏管理员维护界面 IWComboBox1Change(Sender);//查询题目 end; procedure TIWFormcsyd.IWLink2Click(Sender: TObject);//点击查看答案按钮时执行 var s: string; i: integer; begin //答案显示控件全部可见 TIWSmartPanel1.Visible := true; TIWSmartPanel2.Visible := true; TIWSmartPanel3.Visible := true; TIWSmartPanel4.Visible := true; TIWSmartPanel5.Visible := true; TIWSmartPanel6.Visible := true; TIWSmartPanel7.Visible := true; TIWSmartPanel8.Visible := true; TIWSmartPanel9.Visible := true; TIWSmartPanel11.Visible := true; TIWSmartPanel13.Visible := true; TIWSmartPanel15.Visible := true; //以下为核对答案，如果对了，则显示为红色且总分数加一 i := 0; s := trim(IWEdit1.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey1').AsString) then begin IWEdit1.Font.Color := clRed; i := i + 1; end;

第 230页/共 301页

s := trim(IWEdit2.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey2').AsString) then begin IWEdit2.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit3.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey3').AsString) then begin IWEdit3.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit4.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey4').AsString) then begin IWEdit4.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit5.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey5').AsString) then begin IWEdit5.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit6.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey6').AsString) then begin IWEdit6.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit7.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey7').AsString) then begin IWEdit7.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit8.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey8').AsString) then begin IWEdit8.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit9.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Akey9').AsString) then begin IWEdit9.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit10.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey10').AsString) then begin IWEdit10.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit11.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey11').AsString) then begin IWEdit11.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit12.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey12').AsString) then begin IWEdit12.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit13.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey13').AsString) then begin IWEdit13.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit14.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey14').AsString) then begin IWEdit14.Font.Color := clRed; i := i + 1; end; s := trim(IWEdit15.Text); if s <> '' then if UpCase(s[1]) = trim(UserSession.ADOQuerytemp.FieldByname('Bkey15').AsString) then begin IWEdit15.Font.Color := clRed; i := i + 1; end; self.WebApplication.ShowMessage('你得了 ' + inttostr(i) + ' 分。答案变为红色表示答对了。');//向用户报告得分信息



第 231页/共 301页

end; procedure TIWFormcsyd.IWLink8Click(Sender: TObject);//点击管理员维护按钮后执行 begin IWRegionA.Visible := false;//隐藏题目显示 IWRegion2.Visible := true;//显示维护界面 end; procedure TIWFormcsyd.IWLink9Click(Sender: TObject);//点击返回按钮后执行 begin IWRegion2.Visible := false; //隐藏题目维护界面 IWRegionA.Visible := true; //显示出题界面 IWComboBox1Change(Sender); end; procedure TIWFormcsyd.IWRegion2Render(Sender: TObject);//当 IWRegion2显示时执行，取出要编辑的题目显示在维护界面的相应控件中。 var a: string; begin a := rightstr(trim(IWComboBox1.Text), 2); UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Jcsyd where uint =''' + a + '''');//查询该单元题目 UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount = 1 then //如果此单元有题目 begin //以下是将从数据库中取出的数据放入页面的相应编辑控件中，以便管理员修改 IWMemo1.Text := trim(UserSession.ADOQuerytemp.FieldByname('A1').AsString); IWMemo2.Text := trim(UserSession.ADOQuerytemp.FieldByname('A2').AsString); IWMemo3.Text := trim(UserSession.ADOQuerytemp.FieldByname('A3').AsString); IWMemo4.Text := trim(UserSession.ADOQuerytemp.FieldByname('A4').AsString); IWMemo5.Text := trim(UserSession.ADOQuerytemp.FieldByname('A5').AsString); IWMemo6.Text := trim(UserSession.ADOQuerytemp.FieldByname('A6').AsString); IWMemo7.Text := trim(UserSession.ADOQuerytemp.FieldByname('A7').AsString); IWMemo8.Text := trim(UserSession.ADOQuerytemp.FieldByname('A8').AsString); IWMemo9.Text := trim(UserSession.ADOQuerytemp.FieldByname('A9').AsString); IWMemo10.Text := trim(UserSession.ADOQuerytemp.FieldByname('B10').AsString); IWMemo11.Text := trim(UserSession.ADOQuerytemp.FieldByname('B11').AsString); IWMemo12.Text := trim(UserSession.ADOQuerytemp.FieldByname('B12').AsString); IWMemo13.Text := trim(UserSession.ADOQuerytemp.FieldByname('B13').AsString); IWMemo14.Text := trim(UserSession.ADOQuerytemp.FieldByname('B14').AsString); IWMemo15.Text := trim(UserSession.ADOQuerytemp.FieldByname('B15').AsString);



第 232页/共 301页

IWEdit16.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey1').AsString); IWEdit17.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey2').AsString); IWEdit18.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey3').AsString); IWEdit19.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey4').AsString); IWEdit20.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey5').AsString); IWEdit21.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey6').AsString); IWEdit22.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey7').AsString); IWEdit23.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey8').AsString); IWEdit30.Text := trim(UserSession.ADOQuerytemp.FieldByname('Akey9').AsString); IWEdit24.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey10').AsString); IWEdit25.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey11').AsString); IWEdit26.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey12').AsString); IWEdit27.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey13').AsString); IWEdit28.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey14').AsString); IWEdit29.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bkey15').AsString); IWMemo16.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript1').AsString); IWMemo17.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript2').AsString); IWMemo18.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript3').AsString); IWMemo19.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript4').AsString); IWMemo20.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript5').AsString); IWMemo21.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript6').AsString); IWMemo22.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript7').AsString); IWMemo23.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript8').AsString); IWMemo27.Text := trim(UserSession.ADOQuerytemp.FieldByname('Ascript9').AsString); IWMemo26.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bscript1').AsString); IWMemo24.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bscript2').AsString); IWMemo25.Text := trim(UserSession.ADOQuerytemp.FieldByname('Bscript3').AsString); IWEdit31.Text := trim(UserSession.ADOQuerytemp.FieldByname('luyin').AsString); end; end; procedure TIWFormcsyd.IWLink7Click(Sender: TObject);//点击确认修改后执行 var a: string; begin a := rightstr(trim(IWComboBox1.Text), 2); UserSession.ADOQuerytemp.Close; UserSession.ADOQuerytemp.SQL.Clear; UserSession.ADOQuerytemp.SQL.Add('select * from Jcsyd where uint =''' + a + '''');//查询该单元题目 UserSession.ADOQuerytemp.Open; if UserSession.ADOQuerytemp.RecordCount = 1 then //如果此单元有题目



第 233页/共 301页

begin //以下将修改好了的数据保存到数据库中 UserSession.ADOQuerytemp.Edit; UserSession.ADOQuerytemp.FieldByname('A1').AsString := trim(IWMemo1.Text); UserSession.ADOQuerytemp.FieldByname('A2').AsString := trim(IWMemo2.Text); UserSession.ADOQuerytemp.FieldByname('A3').AsString := trim(IWMemo3.Text); UserSession.ADOQuerytemp.FieldByname('A4').AsString := trim(IWMemo4.Text); UserSession.ADOQuerytemp.FieldByname('A5').AsString := trim(IWMemo5.Text); UserSession.ADOQuerytemp.FieldByname('A6').AsString := trim(IWMemo6.Text); UserSession.ADOQuerytemp.FieldByname('A7').AsString := trim(IWMemo7.Text); UserSession.ADOQuerytemp.FieldByname('A8').AsString := trim(IWMemo8.Text); UserSession.ADOQuerytemp.FieldByname('A9').AsString := trim(IWMemo9.Text); UserSession.ADOQuerytemp.FieldByname('B10').AsString := trim(IWMemo10.Text); UserSession.ADOQuerytemp.FieldByname('B11').AsString := trim(IWMemo11.Text); UserSession.ADOQuerytemp.FieldByname('B12').AsString := trim(IWMemo12.Text); UserSession.ADOQuerytemp.FieldByname('B13').AsString := trim(IWMemo13.Text); UserSession.ADOQuerytemp.FieldByname('B14').AsString := trim(IWMemo14.Text); UserSession.ADOQuerytemp.FieldByname('B15').AsString := trim(IWMemo15.Text); UserSession.ADOQuerytemp.FieldByname('Akey1').AsString := trim(IWEdit16.Text); UserSession.ADOQuerytemp.FieldByname('Akey2').AsString := trim(IWEdit17.Text); UserSession.ADOQuerytemp.FieldByname('Akey3').AsString := trim(IWEdit18.Text); UserSession.ADOQuerytemp.FieldByname('Akey4').AsString := trim(IWEdit19.Text); UserSession.ADOQuerytemp.FieldByname('Akey5').AsString := trim(IWEdit20.Text); UserSession.ADOQuerytemp.FieldByname('Akey6').AsString := trim(IWEdit21.Text); UserSession.ADOQuerytemp.FieldByname('Akey7').AsString := trim(IWEdit22.Text); UserSession.ADOQuerytemp.FieldByname('Akey8').AsString := trim(IWEdit23.Text); UserSession.ADOQuerytemp.FieldByname('Akey9').AsString := trim(IWEdit30.Text); UserSession.ADOQuerytemp.FieldByname('Bkey10').AsString := trim(IWEdit24.Text); UserSession.ADOQuerytemp.FieldByname('Bkey11').AsString := trim(IWEdit25.Text); UserSession.ADOQuerytemp.FieldByname('Bkey12').AsString := trim(IWEdit26.Text); UserSession.ADOQuerytemp.FieldByname('Bkey13').AsString := trim(IWEdit27.Text); UserSession.ADOQuerytemp.FieldByname('Bkey14').AsString := trim(IWEdit28.Text); UserSession.ADOQuerytemp.FieldByname('Bkey15').AsString := trim(IWEdit29.Text); UserSession.ADOQuerytemp.FieldByname('Ascript1').AsString := trim(IWMemo16.Text); UserSession.ADOQuerytemp.FieldByname('Ascript2').AsString := trim(IWMemo17.Text); UserSession.ADOQuerytemp.FieldByname('Ascript3').AsString := trim(IWMemo18.Text); UserSession.ADOQuerytemp.FieldByname('Ascript4').AsString := trim(IWMemo19.Text); UserSession.ADOQuerytemp.FieldByname('Ascript5').AsString := trim(IWMemo20.Text); UserSession.ADOQuerytemp.FieldByname('Ascript6').AsString := trim(IWMemo21.Text); UserSession.ADOQuerytemp.FieldByname('Ascript7').AsString := trim(IWMemo22.Text); UserSession.ADOQuerytemp.FieldByname('Ascript8').AsString := trim(IWMemo23.Text); UserSession.ADOQuerytemp.FieldByname('Ascript9').AsString := trim(IWMemo27.Text);

第 234页/共 301页

UserSession.ADOQuerytemp.FieldByname('Bscript1').AsString := trim(IWMemo26.Text); UserSession.ADOQuerytemp.FieldByname('Bscript2').AsString := trim(IWMemo24.Text); UserSession.ADOQuerytemp.FieldByname('Bscript3').AsString := trim(IWMemo25.Text); UserSession.ADOQuerytemp.FieldByname('luyin').AsString := trim(IWEdit31.Text); UserSession.ADOQuerytemp.Post; self.WebApplication.ShowMessage('修改完毕！'); end; UserSession.ADOQuerytemp.Close; end; procedure TIWFormcsyd.IWLink10Click(Sender: TObject);//点击上传按钮后执行 begin //上传文件: if (IWFile1.filename = '') and (IWFile2.filename = '') and (IWFile3.filename = '') and (IWFile4.filename = '') and (IWFile5.filename = '') then begin self.WebApplication.ShowMessage('请至少选择一个上传文件！'); exit; end; try try if IWFile1.filename <> '' then begin IWFile1.SaveToFile(WebApplication.ApplicationPath + 'files\luyin\' + IWFile1.filename); end; except self.WebApplication.ShowMessage(IWFile1.filename + '上传失败，请重新上传！'); end; try if IWFile2.filename <> '' then begin IWFile2.SaveToFile(WebApplication.ApplicationPath + 'files\luyin\' + IWFile2.filename); end; except self.WebApplication.ShowMessage(IWFile2.filename + '上传失败，请重新上传！'); end; try

第 235页/共 301页

if IWFile3.filename <> '' then begin IWFile3.SaveToFile(WebApplication.ApplicationPath + 'files\luyin\' + IWFile3.filename); end; except self.WebApplication.ShowMessage(IWFile3.filename + '上传失败，请重新上传！'); end; try if IWFile4.filename <> '' then begin IWFile4.SaveToFile(WebApplication.ApplicationPath + 'files\luyin\' + IWFile4.filename); end; except self.WebApplication.ShowMessage(IWFile4.filename + '上传失败，请重新上传！'); end; try if IWFile5.filename <> '' then begin IWFile5.SaveToFile(WebApplication.ApplicationPath + 'files\luyin\' + IWFile5.filename); end; except self.WebApplication.ShowMessage(IWFile5.filename + '上传失败，请重新上传！'); end; self.WebApplication.ShowMessage('上传完毕！'); except end; end;

4.2.10 unit UShenQingZhuCe（申请注册）导读这个单元用来让用户申请一个卡号。此窗口的模板文件为 IWFormShenQingZhuCe.html，图

4-2-25是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的name。IWRegion1控件中放置了我们的所需控件，这些控件的布局在我们在程序设计时就指定了。点击申请注册后程序直接打开该页面。



第 236页/共 301页

图 4-2-25 IWFormShenQingZhuCe.html模板文件视图

图 4-2-26为实际运行时的显示界面：

图 4-2-26 IWFormShenQingZhuCe运行时界面

对应以上界面的窗口控件布局如图 4-2-27（各控件类型请打开源代码自己查看：将鼠标放在窗口

控件上即可显示）：TIWRegion 内的控件运行时与设计时是一样的。在模板中只需要指定 TIWRegion控件出现的位置即可。

第 237页/共 301页

图 4-2-27 IWFormShenQingZhuCe窗口控件布局

这个窗口用到了 TADOQuery等数据库控件，输入框也有一部份是直接连接数据库的，请看源代码

时注意查看各个控件的属性值。当窗口生成时执行如下代码（显示版权信息，打开 ADOQuery2数据集，但没有记录，目的是当点

击申请注册按钮时可以直接向 ADOQuery2写入一条记录）： procedure TIWFormShenQingZhuCe.IWAppFormCreate(Sender: TObject); begin BanQuan.Width := 750; //版权信息： BanQuan.HTMLText := '<div align="center">' + UserSession.showBanQuan +

'</div>'; ADOQuery2.Close; ADOQuery2.SQL.Clear; ADOQuery2.SQL.Add('select * from G01网站用户 where id=-1'); ADOQuery2.Open; end; 点击申请注册将执行如下代码（首选检查一下必填输入框是否有值，否则给出提示信息，再检查

数据库是否有相同卡号，如有提示申请者修改，符合条件后，将页面数据存入数据库中，给出申请成

功提示信息）： procedure TIWFormShenQingZhuCe.IWLink1Click(Sender: TObject); begin if IWDBEdit1.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入姓名!'); Exit; end;

第 238页/共 301页

if IWDBEdit2.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入卡号!'); Exit; end; if IWDBEdit3.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入密码!'); Exit; end; if IWDBEdit3.Text <> IWEdit1.Text then //输入框的验证 begin IWDBEdit3.Text := ''; IWEdit1.Text := ''; self.WebApplication.ShowMessage('两次密码不一样，请重新填入密码!'); Exit; end; //检查有无相同的卡号 ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G01 网站用户 where 卡号 =''' +

Trim(GY.Encrypt_text(Trim(IWDBEdit2.Text), UserSession.mm)) + ''''); ADOQuery1.Open; if ADOQuery1.RecordCount > 0 then begin self.WebApplication.ShowMessage('有相同的卡号，请重新输入别的卡号.'); IWDBEdit2.Text := ''; Exit; end; //开始向数据库提交数据： ADOQuery2.Edit; ADOQuery2.FieldByname('专业').Value := '英语'; ADOQuery2.FieldByname('可用时间').Value := '100'; ADOQuery2.FieldByname(' 卡号 ').Value := GY.Encrypt_text(Trim(IWDBEdit2.Text),

UserSession.mm); ADOQuery2.FieldByname(' 密码 ').Value := GY.Encrypt_text(Trim(IWDBEdit3.Text),

UserSession.mm); ADOQuery2.FieldByname('有效期').Value := '2004-1-1'; ADOQuery2.FieldByname('免费').Value := 0; ADOQuery2.FieldByname('是否审核').Value := 0; ADOQuery2.FieldByname('累积上网时间').Value := '0'; ADOQuery2.FieldByname('今日上网时间').Value:='0'; ADOQuery2.FieldByname('登录 IP').Value:='127.0.0.1';

第 239页/共 301页

//非必填输入框给出默认值： if IWDBEdit4.Text = '' then ADOQuery2.FieldByname('年级').Value := '0000'; if IWDBEdit5.Text = '' then ADOQuery2.FieldByname('学号').Value := '0000'; if IWDBMemo1.Text = '' then ADOQuery2.FieldByname('备注').Value := '<无>'; ADOQuery2.Post; //申请成功后给出提示信息： self.WebApplication.ShowMessage('申请成功，请点击“返回首页”，输入卡号和密码登录。'); end; 点击返回首页时执行如下代码： procedure TIWFormShenQingZhuCe.IWLink2Click(Sender: TObject); begin UserSession.Move(TIWindex);//调用 UserSession内的一个函数，关闭当前活动窗口打开 Iwindex

窗口 end; 其余代码前面单元已有解释，此处不再详述。 4.2.11 unit UYongHuXinXiChaXun（用户信息查询，对应当前用户信息查询修改菜单）导读这个单元用来让用户登录后修改自己的相关信息。此窗口的模板文件为

IWFormYongHuXinXiChaXun.html，图 4-2-28是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegion1控件中放置了我们的所需控件，这些控件的布局在我们设计时指定。点击当前用户信息查询修改菜单后判断是否已经登录，没有登录则提示要先

登录，登录后则将该用户相应信息查询出来显示在页面相应控件中。

图 4-2-28 IWFormYongHuXinXiChaXun.html模板文件视图



第 240页/共 301页

图 4-2-29 IWFormYongHuXinXiChaXun运行时界面



第 241页/共 301页

图 4-2-30 IWFormYongHuXinXiChaXun窗口控件布局

窗口生成时将执行如下代码： procedure TIWFormYongHuXinXiChaXun.IWAppFormCreate(Sender: TObject); begin //版权信息： BanQuan.Width := 750; BanQuan.HTMLText := '<div align="center">' + UserSession.showBanQuan +

'</div>'; //将当前用户的相应信息查询出来显示在页面的相应控件中 ADOQuery2.Close; ADOQuery2.SQL.Clear; ADOQuery2.SQL.Add('select * from G01网站用户 where 卡号=''' + UserSession.KaHao + ''''); ADOQuery2.Open;

IWLabel11.Caption := UserSession.XingMing + ' 信息如下：'; //显示用户姓名 IWDBEdit2.Text := GY.DeEncrypt_text(trim(ADOQuery2.FieldByName(' 卡号 ').Value),

UserSession.mm); end; 点击确认修改后执行如下代码（先进行输入验证，再将修改好的信息存入数据库中，再更新当前

session的相关信息，最后给出修改成功的提示信息）： procedure TIWFormYongHuXinXiChaXun.IWButton1Click(Sender: TObject); begin

第 242页/共 301页

if IWDBEdit1.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入姓名!'); Exit; end; if IWDBEdit2.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入卡号!'); Exit; end; if IWDBEdit3.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入密码!'); Exit; end; if IWDBEdit3.Text <> IWEdit1.Text then //输入框的验证 begin IWDBEdit3.Text := ''; IWEdit1.Text := ''; self.WebApplication.ShowMessage('两次密码不一样，请重新填入密码!'); Exit; end; //更新数据库中的相应信息： ADOQuery2.edit; ADOQuery2.FieldByName(' 卡号 ').Value := GY.Encrypt_text(trim(IWDBEdit2.Text),

UserSession.mm); ADOQuery2.FieldByName(' 密码 ').Value := GY.Encrypt_text(trim(IWDBEdit3.Text),

UserSession.mm); ADOQuery2.Post; IWDBEdit2.Text := GY.DeEncrypt_text(trim(ADOQuery2.FieldByName(' 卡号 ').Value),

UserSession.mm); //以下更新登录 session的信息： UserSession.XingMing := ADOQuery2.FieldByName('姓名').Value; UserSession.KaHao := ADOQuery2.FieldByName('卡号').Value; UserSession.MiMa := ADOQuery2.FieldByName('密码').Value; self.WebApplication.ShowMessage('信息修改成功。'); end; 其余代码前面单元已有解释，此处不再详述。 4.2.12 unit UYongHuGuanLi（用户管理）导读这个单元实现让管理员对用户进行管理。此窗口的模板文件为 IWFormYongHuGuanLi.html，图

4-2-31是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的



第 243页/共 301页

name。YongHuGuanLi 控件中放置了我们的所需控件，这些控件的布局在我们程序设计时就指定了。点击当用户管理菜单后出现一个登录界面，输入管理员卡号和密码后，点击管理员登录，如果正常登

录，则将 YongHuGuanLi控件的 visible属性改为 true，这样页面中就出现了我们的用户管理界面。

图 4-2-31 IWFormYongHuGuanLi.html模板文件视图




第 244页/共 301页

图 4-2-32 IWFormYongHuGuanLi运行时界面





第 245页/共 301页

图 4-2-33 IWFormYongHuGuanLi窗口控件布局

这里主要用到了一个 TIWDBAdvWebGrid控件，这个与数据库直接相连的表格控件功能非常强大，

它的属性请详细查看，与 delphi中的数据库表格控件有相似的功能。这个控件的使用我们将单独介绍。在这里它与 ADOQuery1相关联。也就是说它将显示 ADOQuery1的数据。对 ADOQuery1的查询修改会在 TIWDBAdvWebGrid控件反映出来。点击管理员登录后执行的代码如下（根据 IWButton7.Caption值执行不同的操作。一个是修改卡

号和密码，一个是输入管理员卡号和密码后来登录。登录后就把 IWButton7.Caption改为修改卡号和密码）：

procedure TIWFormYongHuGuanLi.IWButton7Click(Sender: TObject); begin if IWButton7.Caption = '修改卡号和密码' then//修改卡号和密码 begin if IWEdit1.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入卡号!'); Exit; end;



第 246页/共 301页

if IWEdit2.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入密码!'); Exit; end; UserSession.ADOQuerylogin.Close; UserSession.ADOQuerylogin.SQL.Clear; UserSession.ADOQuerylogin.SQL.Add('select * from G00网站管理员 where 用户管理员=''' +

guliyuanquanxian1 + ''''); UserSession.ADOQuerylogin.Open; UserSession.ADOQuerylogin.Edit; UserSession.ADOQuerylogin.FieldByname('卡号').Value := GY.Encrypt_text(Trim(IWEdit1.Text),

UserSession.mm); UserSession.ADOQuerylogin.FieldByname('密码').Value := GY.Encrypt_text(Trim(IWEdit2.Text),

UserSession.mm); UserSession.ADOQuerylogin.Post; IWEdit1.Text := ''; IWEdit2.Text := ''; self.WebApplication.ShowMessage('卡号和密码修改成功!'); end; //if是修改卡和密码 if IWButton7.Caption = '管理员登录' then//管理员输入卡号和密码后来登录 begin if IWEdit1.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入卡号!'); Exit; end; if IWEdit2.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入密码!'); Exit; end; UserSession.ADOQuerylogin.Close; UserSession.ADOQuerylogin.SQL.Clear; UserSession.ADOQuerylogin.SQL.Add('select * from G00 网站管理员 where 卡号=:username

and 密码=:password'); UserSession.ADOQuerylogin.Parameters.ParamByName('username').Value :=

GY.Encrypt_text(Trim(IWEdit1.Text), UserSession.mm); UserSession.ADOQuerylogin.Parameters.ParamByName('password').Value :=

GY.Encrypt_text(Trim(IWEdit2.Text), UserSession.mm); UserSession.ADOQuerylogin.Open; if UserSession.ADOQuerylogin.RecordCount = 1 then //从数据库取出登录信息存入 UserSession



第 247页/共 301页

begin guliyuanquanxian1 := Trim(UserSession.ADOQuerylogin.FieldByname('用户管理员').Value); guliyuanquanxian2 := GY.DeEncrypt_text(Trim(guliyuanquanxian1), UserSession.mm); IWRegion3.Visible := true; IWButton7.Caption := '修改卡号和密码'; IWEdit1.Text := ''; IWEdit2.Text := ''; IWEdit2.PasswordPrompt := False; end else begin self.WebApplication.ShowMessage('卡号或密码错误，请重新输入!'); end; end; //if 是管理员 end; 点击查找按钮后执行如下代码（利用输入的查询条件对用户列表进行过滤，模糊查询模式）： procedure TIWFormYongHuGuanLi.IWButton1Click(Sender: TObject); begin ADOQuery1.Close; ADOQuery1.SQL.Clear;//以下组装一句 SQL查询语句： ADOQuery1.SQL.Add('select * from G01网站用户 where 姓名 like :xm and 卡号 like :kh '); ADOQuery1.SQL.Add('and 年级 like :lj and 学号 like :xh '); ADOQuery1.SQL.Add('and 备注 like :bz '); if IWCheckBox2.Checked then//是否只显示要审核的用户 begin ADOQuery1.SQL.Add('and 是否审核=:sh '); ADOQuery1.Parameters.ParamByName('sh').Value := False; end; //以下给各查询参数赋值： ADOQuery1.Parameters.ParamByName('xm').Value := Trim(IWEdit3.Text) + '%'; if Trim(IWEdit4.Text) = '' then

ADOQuery1.Parameters.ParamByName('kh').Value := '%' else ADOQuery1.Parameters.ParamByName('kh').Value := GY.Encrypt_text(Trim(IWEdit4.Text),

UserSession.mm) + '%'; ADOQuery1.Parameters.ParamByName('lj').Value := Trim(IWComboBox1.Text) + '%'; ADOQuery1.Parameters.ParamByName('xh').Value := Trim(IWEdit6.Text) + '%'; ADOQuery1.Parameters.ParamByName('bz').Value := '%' + Trim(IWEdit8.Text); ADOQuery1.Open; end;



第 248页/共 301页

点击设置版权信息时执行如下代码（更新数据库中的相应字段的信息）： procedure TIWFormYongHuGuanLi.IWLink1Click(Sender: TObject); begin if IWEdit10.Text = '' then //输入框的验证 begin self.WebApplication.ShowMessage('请填入您自己的版权信息!'); Exit; end; UserSession.ADOQuerylogin.Close; UserSession.ADOQuerylogin.SQL.Clear; UserSession.ADOQuerylogin.SQL.Add('select * from G00网站管理员'); UserSession.ADOQuerylogin.Open; UserSession.ADOQuerylogin.Edit; UserSession.ADOQuerylogin.FieldByname('版权信息').Value := Trim(IWEdit10.Text); UserSession.ADOQuerylogin.Post; UserSession.ADOQuerylogin.Next; UserSession.ADOQuerylogin.Edit; UserSession.ADOQuerylogin.FieldByname('版权信息').Value := Trim(IWEdit10.Text); UserSession.ADOQuerylogin.Post; self.WebApplication.ShowMessage('版权信息设置成功!'); end; 其余代码前面单元已有解释或一看就明白，此处不再详述。

4.2.13 unit UxiazaiYuYin（下载语音，对应音像剪接菜单）导读这个单元最复杂，除了没有用户和权限设置的操作外基本上是一个功能独立的模块。此窗口的模

板文件为 IWFormxiazaiyuyin.html，图 4-2-34是这个模板文件的视图。请大家用 dreamweaver打开查看即可。｛%%｝之间是窗口中的控件的 name。IWRegion1，IWRegion2，IWRegion3，IWRegion4，IWRegion5 控件中放置了我们的所需控件，这些控件的布局在我们设计时指定。通过改变前四个的visible属性，就可以进入不同的功能模块。

图 4-2-34 IWFormxiazaiyuyin.html模板文件视图



第 249页/共 301页

图 4-2-35为 IWFormxiazaiyuyin运行时界面一：主要用来向用户展示所有的音像剪接文件。左

边是一个目录树，显示了音像剪接文件的目录分类，右边是一个分页显示的表格，单击每一行可以在

网页中间部分显示相应的信息，如果文件存在则会显示一个播放链接，点击它会跳出一个 RM播放器来播放指定的音像剪接文件。右边的表格以上部分是用来对音像剪接文件进行过滤查找定位的。点击

搜索按钮可以在指定的分类中按指定的搜索关键词来查找。点击向上和向下所在的蓝色部分可以让显

示框中的文字以其下方指定的翻页速度向上或向下自动滚动。点击上传音像剪接将显示如图 4-2-37所示界面。点击我要发表评论按钮将显示如图 4-2-39所示界面。在这一页中，IWRegion1，IWRegion3，IWRegion4是不可见的。主要展示 IWRegion2内的控件内容。

图 4-2-35 IWFormxiazaiyuyin运行时界面一

图 4-2-36为 IWFormxiazaiyuyin运行时界面一对应的窗口控件布局，主要是 IWRegion2内的内

容。比上图好像多了两个控件，IWMemo2和 IWDBImage1，其实不是，每显示一条记录时程序会查找是否有相应的评论和图片，以上两个控件就是用来显示所有评论和相应图片的。如果没有则它们俩

的 visible属性为 false。这一页中的代码稍多，但没有很高的难度，都是一些对数据库或相关控件的一般操作。



第 250页/共 301页

图 4-2-36 IWFormxiazaiyuyin运行时界面一对应的窗口控件布局

图 4-2-37 IWFormxiazaiyuyin运行时界面二



第 251页/共 301页

图 4-2-38 IWFormxiazaiyuyin运行时界面二对应的窗口控件布局



第 252页/共 301页

图 4-2-39 IWFormxiazaiyuyin运行时界面三

图 4-2-40 IWFormxiazaiyuyin运行时界面三对应的窗口控件布局



第 253页/共 301页

图 4-2-41 IWFormxiazaiyuyin运行时界面四

第 254页/共 301页

图 4-2-42 IWFormxiazaiyuyin运行时界面四对应的窗口控件布局

窗口生成时执行如下代码： procedure TIWFormxiazaiYuYin.IWAppFormCreate(Sender: TObject); var I: Integer; str1: string; Temp, item1: TIWTreeViewItem; begin ok := true; BanQuan.Width := 750; //版权信息 BanQuan.HTMLText := '<div align="center">' + UserSession.showBanQuan + '</div>'; //检查是否有别人用你的卡 UserSession.ADOQuerylogin.Close; UserSession.ADOQuerylogin.SQL.Clear; UserSession.ADOQuerylogin.SQL.Add('select * from G01网站用户 where 卡号=:username and 密码=:password'); UserSession.ADOQuerylogin.Parameters.ParamByName('username').Value := UserSession.KaHao; UserSession.ADOQuerylogin.Parameters.ParamByName('password').Value := UserSession.mima; UserSession.ADOQuerylogin.Open; if UserSession.ADOQuerylogin.RecordCount = 1 then begin if (Trim(UserSession.ADOQuerylogin.FieldByname('登录 IP').Value) <> WebApplication.ip) then begin

第 255页/共 301页

self.WebApplication.Terminate('你的卡可能正在被别人使用,请重新登录,并立即更改密码!'); end; end; UserSession.ADOQuerylogin.Close; IWRegion1.BorderOptions.NumericWidth := 0; IWRegion2.BorderOptions.NumericWidth := 0; //IWRegion3.BorderOptions.NumericWidth := 0; //IWRegion4.BorderOptions.NumericWidth := 0; //+++++++++++++++++++++++++++++++++++++++++++++++ 对目录树进行操作： ADOQuery4.Close; //只用打开一次就能全部搞定的方法： ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G061语音分类 order by 分类 1,分类 2,id'); ADOQuery4.Open; IWTreeView1.Items.Add; IWTreeView1.Items[0].Caption := '所有分类：'; if ADOQuery4.RecordCount > 0 then begin ADOQuery4.First; str1 := ''; for I := 1 to ADOQuery4.RecordCount do begin if Trim(ADOQuery4.FieldByname('分类 1').Value) <> str1 then begin // 如果是新的开始，则加入两级目录 Temp := IWTreeView1.Items.Add; Temp.Caption := Trim(ADOQuery4.FieldByname('分类 1').Value); Temp.hint := Temp.Caption; Temp.Expanded := true; Temp.ParentItem := IWTreeView1.Items[0]; item1 := Temp; Temp.OnClick := TreeItemClick1; Temp := IWTreeView1.Items.Add; Temp.Caption := Trim(ADOQuery4.FieldByname('分类 2').Value); Temp.hint := Temp.Caption; Temp.ParentItem := item1; Temp.OnClick := TreeItemClick2; end; if (Trim(ADOQuery4.FieldByname('分类 1').Value) = str1) then begin //加入二级目录 Temp := IWTreeView1.Items.Add; Temp.Caption := Trim(ADOQuery4.FieldByname('分类 2').Value); Temp.hint := Temp.Caption;



第 256页/共 301页

Temp.ParentItem := item1; Temp.OnClick := TreeItemClick2; end; str1 := Trim(ADOQuery4.FieldByname('分类 1').Value); ADOQuery4.Next; end; end; ADOQuery4.Close; //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select distinct 分类 1 from G061语音分类'); ADOQuery4.Open; ADOQuery4.First; IWComboBox1.Clear; IWComboBox2.Clear; IWComboBox6.Clear; IWComboBox1.Items.Add('所有分类'); IWComboBox2.Items.Add('所有分类'); IWComboBox6.Items.Add(''); for I := 1 to ADOQuery4.RecordCount do begin IWComboBox1.Items.Add(Trim(ADOQuery4.FieldByname('分类 1').Value));//给三个下拉框赋值 IWComboBox2.Items.Add(Trim(ADOQuery4.FieldByname('分类 1').Value)); IWComboBox6.Items.Add(Trim(ADOQuery4.FieldByname('分类 1').Value)); ADOQuery4.Next; end; ADOQuery4.Close; IWComboBox1.ItemIndex := 0; IWComboBox2.ItemIndex := 0; if UserSession.GuanLi_YuYin then//如果是管理员则显示相应控件 begin IWButton7.Visible := true; IWButton8.Visible := true; IWButton9.Visible := true; IWButton14.Visible := true; IWButton19.Visible := true; IWDBCheckBox2.Visible := true; IWLabel22.Visible := true; end;



第 257页/共 301页

IWComboBox5Change(Sender); //查询相关的下载 end; procedure TIWFormxiazaiYuYin.TreeItemClick1(Sender: TObject);//目录树上点击一级目录时调用的函数 var fenlei1: string; begin fenlei1 := (Sender as TIWTreeViewItem).Caption; ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where (分类 1=:x) order by 加入时间 desc'); ADOQuery1.Parameters.ParamByName('x').Value := Trim(fenlei1); ADOQuery1.Open; end; procedure TIWFormxiazaiYuYin.TreeItemClick2(Sender: TObject); //目录树上点击二级目录时调用的函数 var fenlei1, fenlei2: string; begin fenlei1 := (Sender as TIWTreeViewItem).ParentItem.Caption; fenlei2 := (Sender as TIWTreeViewItem).Caption; ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where (分类 1=:x) and (分类 2=:y) order by 加入时间 desc'); ADOQuery1.Parameters.ParamByName('x').Value := Trim(fenlei1); ADOQuery1.Parameters.ParamByName('y').Value := Trim(fenlei2); ADOQuery1.Open; end; //语音有两级分类，当分类 1 改变时，搜索出相应的分类 2 并将其填入 IWComboBox5 中，之后执行ADOQuery1的相应查询。 procedure TIWFormxiazaiYuYin.IWComboBox1Change(Sender: TObject); var I: Integer; begin ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select distinct 分类 2 from G061语音分类 where 分类 1=:x'); ADOQuery4.Parameters.ParamByName('x').Value := Trim(IWComboBox1.Text); ADOQuery4.Open; ADOQuery4.First; IWComboBox5.Clear; IWComboBox5.Items.Add('所有分类');

第 258页/共 301页

for I := 1 to ADOQuery4.RecordCount do begin IWComboBox5.Items.Add(Trim(ADOQuery4.FieldByname('分类 2').Value)); ADOQuery4.Next; end; ADOQuery4.Close; IWComboBox5.ItemIndex := 0; if not IWCheckBox2.Checked then//如果没有选择推荐复选框 begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 审核人卡号<>:y order by 加入时间 desc'); if Trim(IWComboBox1.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox1.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := ' '; if Trim(IWComboBox5.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox5.Text) + '%'; ADOQuery1.Open; end else//如果选择了推荐复选框 begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 推荐=1 and 审核人卡号<>:y order by 加入时间 desc'); if Trim(IWComboBox1.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox1.Text) + '%'; if Trim(IWComboBox5.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox5.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := ' '; ADOQuery1.Open; end; if ADOQuery1.RecordCount > 0 then//如果查询出来记录数大于 0



第 259页/共 301页

begin IWLink1.hint := '给' + Trim(ADOQuery1.FieldByname('加入者姓名').Value) + '发信息。'; TIWScrollPanel1.Text.Text := Trim(ADOQuery1.FieldByname('内容').Value); end else//如果查询出来记录数=0 IWLink1.hint := ''; if ADOQuery1.RecordCount = 0 then Exit; IWMemo2.Text := '';//以下查找出该记录对应的语音评论 ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do//将所有的评论进行组装如下 begin IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; end; //以下点击搜索按钮后执行，可以键入多个词语，中间用空格分开即可 procedure TIWFormxiazaiYuYin.IWButton10Click(Sender: TObject); var I: Integer; d, e, SQL: string; y: Integer; begin if IWEdit3.Text = '' then

第 260页/共 301页

begin self.WebApplication.ShowMessage('请填入查找搜索词。'); IWEdit3.SetFocus; Exit; end; ADOQuery1.Cancel; d := Trim(IWEdit3.Text); d := UserSession.ReplaceStrs(d, ' ', ' '); //将中文空格换成对应的英文空格 SQL := ''; y := Pos(' ', d); if (Pos(' ', d) = 0) then SQL := ' and (标题 like ' + '''%' + d + '%''' + ' or 内容 like ' + '''%' + d + '%'')' else begin while y <> 0 do begin e := leftbstr(d, y - 1); Delete(d, 1, y); d := Trim(d); y := Pos(' ', d); SQL := SQL + ' and (标题 like ' + '''%' + e + '%''' + 'or 内容 like ' + '''%' + e + '%'')'; end; SQL := SQL + ' and (标题 like ' + '''%' + d + '%''' + ' or 内容 like ' + '''%' + d + '%'')'; end; ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where (审核人卡号<>:y) '); ADOQuery1.SQL.Add(SQL + ' order by 加入时间 desc'); ADOQuery1.Parameters.ParamByName('y').Value := ' '; ADOQuery1.Open; if ADOQuery1.RecordCount > 0 then IWLink1.hint := '给' + Trim(ADOQuery1.FieldByname('加入者姓名').Value) + '发信息。' else IWLink1.hint := ''; if ADOQuery1.RecordCount = 0 then Exit; IWMemo2.Text := ''; ADOQuery4.Close;



第 261页/共 301页

ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do begin IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; end; //以下点击上传音像剪接按钮后执行 procedure TIWFormxiazaiYuYin.IWButton5Click(Sender: TObject); var I: Integer; begin IWRegion2.Visible := true; IWRegion1.Visible := False; IWButton7.Caption := '我要修改'; IWDBEdit1.Editable := False; IWDBMemo2.Editable := False; IWDBCheckBox1.Editable := False; IWComboBox6.Editable := False; IWComboBox7.Editable := False; IWComboBox5Change(Sender); if ADOQuery1.RecordCount = 0 then Exit;



第 262页/共 301页

IWMemo2.Text := ''; try ADOQuery1.Locate('id', Trim(DangQiangid), []); except end; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do begin IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; ok := true; end; //以下点击发布此音像剪接按钮后执行 procedure TIWFormxiazaiYuYin.IWButton1Click(Sender: TObject); var year1, month1, day1, hour1, min1, sec1, msec1: word; filename: string; BStream: TMemoryStream; begin if IWComboBox6.Text = '' then begin

第 263页/共 301页

self.WebApplication.ShowMessage('请选择大类。'); IWComboBox6.SetFocus; Exit; end; if IWComboBox7.Text = '' then begin self.WebApplication.ShowMessage('请选择小类。'); IWComboBox7.SetFocus; Exit; end; if IWDBEdit1.Text = '' then begin self.WebApplication.ShowMessage('请填写标题。'); IWDBEdit1.SetFocus; Exit; end; if IWDBMemo2.Text = '' then begin self.WebApplication.ShowMessage('请填写内容。'); IWDBMemo2.SetFocus; Exit; end; if IWDBFile1.filename <> '' then begin if (ExtractFileExt(IWDBFile1.filename) <> '.jpg') and (ExtractFileExt(IWDBFile1.filename) <> '.JPG') and (ExtractFileExt(IWDBFile1.filename) <> '.JPEG') and (ExtractFileExt(IWDBFile1.filename) <> '.jpeg') and (ExtractFileExt(IWDBFile1.filename) <> '.bmp') and (ExtractFileExt(IWDBFile1.filename) <> '.BMP') then begin self.WebApplication.ShowMessage('图片只能是.jpg .jpeg .bmp格式！请重新选择！'); Exit; end; //上传图片 try BStream := TMemoryStream.Create; IWDBFile1.SaveToStream(BStream); Tblobfield(ADOQuery1.FieldByname('图片')).LoadFromStream(BStream); finally BStream.Free; end;

第 264页/共 301页

end; if IWFile1.filename = '' then begin //self.WebApplication.ShowMessage('注意，您没有选择音像剪接文件。'); end; //上传文件: if IWFile1.filename <> '' then begin SysUtils.DecodeDate(Now, year1, month1, day1); SysUtils.DecodeTime(Now, hour1, min1, sec1, msec1); filename := floattostr(year1) + floattostr(month1) + floattostr(day1) + floattostr(hour1) + floattostr(min1) + floattostr(sec1) + floattostr(msec1) + SysUtils.ExtractFileExt(IWFile1.filename); IWFile1.SaveToFile(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + filename); end; //以下更新数据库数据 ADOQuery1.FieldByname('点击次数').Value := 0; ADOQuery1.FieldByname('点击次数').Value := 0; ADOQuery1.FieldByname('加入时间').Value := Now; ADOQuery1.FieldByname('分类 1').Value := Trim(IWComboBox6.Text); ADOQuery1.FieldByname('分类 2').Value := Trim(IWComboBox7.Text); if (UserSession.GuanLi_YuYin) then ADOQuery1.FieldByname('审核人卡号').Value := UserSession.KaHao else ADOQuery1.FieldByname('审核人卡号').Value := ' '; ADOQuery1.FieldByname('加入者姓名').Value := UserSession.XingMing; ADOQuery1.FieldByname('加入者卡号').Value := UserSession.KaHao; if IWFile1.filename <> '' then ADOQuery1.FieldByname('下载地址').Value := filename else ADOQuery1.FieldByname('下载地址').Value := Trim(IWEdit2.Text); ADOQuery1.Post; IWComboBox7.Editable := False; IWButton1.Enabled := False; IWButton11.Enabled := true; IWButton12.Enabled := False; TIWDBAdvWebGrid2.Visible := true; IWDBImage2.Visible := true; IWDBEdit1.Editable := False;

第 265页/共 301页

IWDBMemo2.Editable := False; IWDBFile1.Visible := False; IWFile1.Visible := False; IWDBCheckBox1.Editable := False; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := False; IWButton7.Enabled := true; IWButton8.Enabled := true; IWComboBox4Change(Sender); if (not UserSession.GuanLi_YuYin) then//如果不是管理员 self.WebApplication.ShowMessage('谢谢您的投稿,请等待管理员审核您的资料后别人才能浏览。'); end; //点击我要修改或确认修改按钮时执行，目的是修改当前记录 procedure TIWFormxiazaiYuYin.IWButton7Click(Sender: TObject); var year1, month1, day1, hour1, min1, sec1, msec1: word; filename: string; BStream: TMemoryStream; begin if (ADOQuery1.RecordCount = 0) then//如果记录为 0则退出 begin IWButton12Click(Sender); self.WebApplication.ShowMessage('当前没有选定记录。'); Exit; end; //如果该记录不是当前登录者发布的就不能修改 if (ADOQuery1.FieldByname(' 加入者卡号 ').Value <> UserSession.KaHao) and (not UserSession.GuanLi_YuYin) then begin self.WebApplication.ShowMessage('这不是你发的，你无权修改。'); Exit; end; //根据 IWButton7.Caption的值进行不同操作，如果是我要修改则进入修改状态 if IWButton7.Caption = '我要修改' then begin IWDBEdit1.Editable := true; IWDBMemo2.Editable := true; IWDBCheckBox1.Editable := true; IWDBFile1.Visible := true; IWFile1.Visible := true; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := true; IWButton12.Enabled := true; IWButton11.Enabled := False;

第 266页/共 301页

IWButton8.Enabled := False; TIWDBAdvWebGrid2.Visible := False; IWDBImage2.Visible := False; ADOQuery1.Edit; IWButton7.Caption := '确认修改';//改变为确认修改，表示已经进入修改状态 end else//根据 IWButton7.Caption的值进行不同操作，如果不是我要修改则保存修改后的内容 begin if IWComboBox6.Text = '' then//检查输入不否合法 begin self.WebApplication.ShowMessage('请选择大类。'); IWComboBox6.SetFocus; Exit; end; if IWComboBox7.Text = '' then//检查输入不否合法 begin self.WebApplication.ShowMessage('请选择小类。'); IWComboBox7.SetFocus; Exit; end; if IWDBEdit1.Text = '' then//检查输入不否合法 begin self.WebApplication.ShowMessage('请填写标题。'); IWDBEdit1.SetFocus; Exit; end; if IWDBMemo2.Text = '' then//检查输入不否合法 begin self.WebApplication.ShowMessage('请填写内容。'); IWDBMemo2.SetFocus; Exit; end; if IWDBFile1.filename <> '' then//判断图片的格式 begin if (ExtractFileExt(IWDBFile1.filename) <> '.jpg') and (ExtractFileExt(IWDBFile1.filename) <> '.JPG') and (ExtractFileExt(IWDBFile1.filename) <> '.JPEG') and (ExtractFileExt(IWDBFile1.filename) <> '.jpeg') and (ExtractFileExt(IWDBFile1.filename) <> '.bmp') and (ExtractFileExt(IWDBFile1.filename) <> '.BMP') then begin self.WebApplication.ShowMessage('图片只能是.jpg .jpeg .bmp格式！请重新选择！');

第 267页/共 301页

Exit; end; //上传图片 try BStream := TMemoryStream.Create;//创建内存流 IWDBFile1.SaveToStream(BStream);//将图片保存到内存流 Tblobfield(ADOQuery1.FieldByname('图片')).LoadFromStream(BStream);//将图片从内存流中保存到数据库的图片字段中 finally BStream.Free;//释放内存流 end; end; if IWFile1.filename <> '' then begin //上传文件: if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value)) then//如果文件存在 SysUtils.DeleteFile(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value));//删除老文件 SysUtils.DecodeDate(Now, year1, month1, day1); SysUtils.DecodeTime(Now, hour1, min1, sec1, msec1); filename := floattostr(year1) + floattostr(month1) + floattostr(day1) + floattostr(hour1) + floattostr(min1) + floattostr(sec1) + floattostr(msec1) + ExtractFileExt(IWFile1.filename);//用当前时间组装出新文件的名称 IWFile1.SaveToFile(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + filename);//将客户端的文件上传到服务器的相应目录下：WebApplication.ApplicationPath + 'files\YuYinTianDi\' + filename ADOQuery1.FieldByname('下载地址').Value := filename;//将新的文件名存入到数据库 end; if (IWFile1.filename = '') and (Trim(IWEdit2.Text) <> '') then ADOQuery1.FieldByname('下载地址').Value := Trim(IWEdit2.Text); ADOQuery1.FieldByname('分类 1').Value := Trim(IWComboBox6.Text); ADOQuery1.FieldByname('分类 2').Value := Trim(IWComboBox7.Text); ADOQuery1.Post; IWButton7.Caption := '我要修改';//改回为我要修改 TIWDBAdvWebGrid2.Visible := true; IWDBImage2.Visible := true; IWDBEdit1.Editable := False; IWDBMemo2.Editable := False; IWComboBox6.Editable := False; IWComboBox7.Editable := False;

第 268页/共 301页

IWDBFile1.Visible := False; IWFile1.Visible := False; IWDBCheckBox1.Editable := False; IWButton12.Enabled := False; IWButton11.Enabled := true; IWButton8.Enabled := true; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := False; end; end; procedure TIWFormxiazaiYuYin.IWButton11Click(Sender: TObject); begin IWButton12.Enabled := true; IWButton11.Enabled := False; IWButton7.Enabled := False; IWComboBox7.Editable := False; IWButton8.Enabled := False; IWComboBox6.Editable := true; IWComboBox6.ItemIndex := -1; TIWDBAdvWebGrid2.Visible := False; IWDBImage2.Visible := False; IWEdit2.Text := ''; end; //点击确认删除按钮时执行 procedure TIWFormxiazaiYuYin.IWButton8Click(Sender: TObject); begin if (IWButton11.Enabled = False) or (ADOQuery1.RecordCount = 0) then//无记录可以删除 begin IWButton12Click(Sender); self.WebApplication.ShowMessage('当前没有选定记录。'); Exit; end; if (ADOQuery1.FieldByname(' 加入者卡号 ').Value <> UserSession.KaHao) and (not UserSession.GuanLi_YuYin) then//检查权限：自己发布的或者自己是管理员，否则无法删除 begin self.WebApplication.ShowMessage('这不是你发的，你无权删除。'); Exit; end; ADOQuery4.Close;//先删除当前记录对应的语音评论 ADOQuery4.SQL.Clear;

第 269页/共 301页

ADOQuery4.SQL.Add('delete from G063语音评论 where 下载 ID=:x'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.ExecSQL; //if pos('YuYinTianDi',trim(ADOQuery1.FieldByName('下载地址').Value))>0 then if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value)) then//再删除相应的语音文件 SysUtils.DeleteFile(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value)); ADOQuery1.Delete;//最后删除该条记录 IWDBEdit1.Editable := False; IWDBMemo2.Editable := False; IWDBCheckBox1.Editable := False; IWComboBox6.Editable := False; IWComboBox7.Editable := False; IWDBFile1.Visible := False; IWFile1.Visible := False; TIWDBAdvWebGrid2.Visible := true; IWDBImage2.Visible := true; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := False; IWComboBox4Change(Sender); self.WebApplication.ShowMessage('该音像剪接信息已经全部删除。') end; //点击允许此音像剪接发布按钮后执行，这将填入当前审核人的卡号，这样该音像剪接就可以被别人浏览到了。 procedure TIWFormxiazaiYuYin.IWButton9Click(Sender: TObject); begin if (IWButton11.Enabled = False) or (ADOQuery1.RecordCount = 0) then//记录为空，不可审核 begin IWButton12Click(Sender); self.WebApplication.ShowMessage('当前没有选定记录。'); Exit; end; if (not UserSession.GuanLi_YuYin) then//检查权限 begin self.WebApplication.ShowMessage('你不是管理员，你无权审核。'); Exit; end; if trim(ADOQuery1.FieldByname('审核人卡号').Value) <> '' then//如果已经审核 begin



第 270页/共 301页

self.WebApplication.ShowMessage('已经审核发布了。'); Exit; end; if UserSession.GuanLi_YuYin then//如果是管理员则执行审核：将自己的卡号填入审核人卡号字段 begin ADOQuery1.Edit; ADOQuery1.FieldByname('审核人卡号').Value := UserSession.KaHao; ADOQuery1.Post; end; IWDBEdit1.Editable := False; IWDBMemo2.Editable := False; IWDBCheckBox1.Editable := False; self.WebApplication.ShowMessage('审核完毕。') end; //点击放弃改动按钮后执行 procedure TIWFormxiazaiYuYin.IWButton12Click(Sender: TObject); begin ADOQuery1.Cancel;//取消数据库的当前操作 TIWDBAdvWebGrid2.Visible := true; IWDBImage2.Visible := true; IWButton1.Enabled := False; IWButton11.Enabled := true; IWButton7.Caption := '我要修改'; IWDBEdit1.Editable := False; IWDBMemo2.Editable := False; IWDBCheckBox1.Editable := False; IWDBFile1.Visible := False; IWFile1.Visible := False; IWButton12.Enabled := False; IWButton7.Enabled := true; IWButton8.Enabled := true; IWComboBox6.Editable := False; IWComboBox7.Editable := False; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := False; IWComboBox4Change(Sender); end; //点击音像剪接浏览时执行，进入浏览界面 procedure TIWFormxiazaiYuYin.IWButton13Click(Sender: TObject); begin

第 271页/共 301页

ok := False; IWRegion1.Visible := true;//这是浏览界面 IWRegion2.Visible := False; //这是编辑和上传界面 IWComboBox4Change(Sender); try ADOQuery1.Open; ADOQuery1.Locate('id', Trim(DangQiangid), []); except end; end; //点击要审核的音像剪接按钮时执行，这将搜索出所有要审核的音像剪接 procedure TIWFormxiazaiYuYin.IWButton14Click(Sender: TObject); begin if IWButton12.Enabled = true then begin self.WebApplication.ShowMessage('请先按放弃改动按钮。'); Exit; end; ADOQuery1.Cancel; ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062 语音内容 where (审核人卡号=:x1) order by 加入时间 desc'); ADOQuery1.Parameters.ParamByName('x1').Value := ' '; ADOQuery1.Open; if ADOQuery1.RecordCount <> 0 then begin IWComboBox6.ItemIndex := IWComboBox6.Items.IndexOf(Trim(ADOQuery1.FieldByname('分类1').Value)); IWComboBox7.Items.Clear; IWComboBox7.Items.Add(Trim(ADOQuery1.FieldByname('分类 2').Value)); IWComboBox7.ItemIndex := 0; end; end; //改变大类时执行 procedure TIWFormxiazaiYuYin.IWComboBox2Change(Sender: TObject); var I: Integer; begin if IWButton12.Enabled = true then begin



第 272页/共 301页

self.WebApplication.ShowMessage('请先按放弃改动按钮。'); Exit; end; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select distinct 分类 2 from G061语音分类 where 分类 1=:x'); ADOQuery4.Parameters.ParamByName('x').Value := Trim(IWComboBox2.Text); ADOQuery4.Open; ADOQuery4.First; IWComboBox4.Clear; IWComboBox4.Items.Add('所有分类'); for I := 1 to ADOQuery4.RecordCount do begin IWComboBox4.Items.Add(Trim(ADOQuery4.FieldByname('分类 2').Value)); ADOQuery4.Next; end; ADOQuery4.Close; IWComboBox4.ItemIndex := 0; if not UserSession.GuanLi_YuYin then begin if not IWCheckBox1.Checked then begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 加入者卡号=:y and 锁定=0 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery1.Open; end else begin



第 273页/共 301页

ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 加入者卡号=:y and 推荐=1 and 锁定=0 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery1.Open; end; end else begin if not IWCheckBox1.Checked then begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Open; end else begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 推荐=1 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%'

第 274页/共 301页

else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Open; end; end; if ADOQuery1.RecordCount <> 0 then begin IWComboBox6.ItemIndex := IWComboBox6.Items.IndexOf(Trim(ADOQuery1.FieldByname('分类1').Value)); IWComboBox7.Items.Clear; IWComboBox7.Items.Add(Trim(ADOQuery1.FieldByname('分类 2').Value)); IWComboBox7.ItemIndex := 0; end; end; //在编辑页面点击搜索时执行 procedure TIWFormxiazaiYuYin.IWButton4Click(Sender: TObject); var d, e, SQL: string; y: Integer; begin if IWButton12.Enabled = true then begin self.WebApplication.ShowMessage('请先按放弃改动按钮。'); Exit; end; if IWEdit1.Text = '' then begin self.WebApplication.ShowMessage('请填入查找搜索词。'); IWEdit1.SetFocus; Exit; end; ADOQuery1.Cancel; d := Trim(IWEdit1.Text); d := UserSession.ReplaceStrs(d, ' ', ' '); //将中文空格换成对应的英文空格 SQL := ''; y := Pos(' ', d); if (Pos(' ', d) = 0) then SQL := ' and (标题 like ' + '''%' + d + '%''' + ' or 内容 like ' + '''%' + d + '%'')'

第 275页/共 301页

else begin while y <> 0 do begin e := leftbstr(d, y - 1); Delete(d, 1, y); d := Trim(d); y := Pos(' ', d); SQL := SQL + ' and (标题 like ' + '''%' + e + '%''' + 'or 内容 like ' + '''%' + e + '%'')'; end; SQL := SQL + ' and (标题 like ' + '''%' + d + '%''' + ' or 内容 like ' + '''%' + d + '%'')'; end; if not UserSession.GuanLi_YuYin then begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where (锁定=0) and (加入者卡号=:y) '); ADOQuery1.SQL.Add(SQL + ' order by 加入时间 desc'); ADOQuery1.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery1.Open; end else begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where '); Delete(SQL, 1, 4); ADOQuery1.SQL.Add(SQL + ' order by 加入时间 desc'); ADOQuery1.Open; end; if ADOQuery1.RecordCount <> 0 then begin IWComboBox6.ItemIndex := IWComboBox6.Items.IndexOf(Trim(ADOQuery1.FieldByname('分类1').Value)); IWComboBox7.Items.Clear; IWComboBox7.Items.Add(Trim(ADOQuery1.FieldByname('分类 2').Value)); IWComboBox7.ItemIndex := 0; end; end; //点击推荐按钮时执行 procedure TIWFormxiazaiYuYin.IWCheckBox1Click(Sender: TObject);

第 276页/共 301页

begin if IWButton12.Enabled = true then begin self.WebApplication.ShowMessage('请先按放弃改动按钮。'); Exit; end; IWComboBox4Change(Sender); end; procedure TIWFormxiazaiYuYin.IWCheckBox2Click(Sender: TObject); begin IWComboBox5Change(Sender); end; //点击评论界面中的确认删除按钮时执行，这将删除相应的评论 procedure TIWFormxiazaiYuYin.IWButton18Click(Sender: TObject); begin if (IWButton20.Enabled = False) or (ADOQuery5.RecordCount = 0) then begin IWButton21Click(Sender); self.WebApplication.ShowMessage('当前没有选定记录。'); Exit; end; if (ADOQuery5.FieldByname(' 评论人卡号 ').Value <> UserSession.KaHao) and (not UserSession.GuanLi_YuYin) then//检查权限，是自己发布的或者是管理员才能够删除 begin self.WebApplication.ShowMessage('这不是你发的，你无权删除。'); Exit; end; ADOQuery5.Delete; IWDBEdit6.Editable := False; IWDBMemo3.Editable := False; IWButton20.Enabled := true; IWButton16.Enabled := False; IWButton21.Enabled := False; self.WebApplication.ShowMessage('该条评论已经删除。') end; //点击评论界面中的我要修改或确认修改按钮时执行 procedure TIWFormxiazaiYuYin.IWButton17Click(Sender: TObject); begin if (ADOQuery5.RecordCount = 0) then begin

第 277页/共 301页

IWButton21Click(Sender); self.WebApplication.ShowMessage('当前没有选定记录。'); Exit; end; if (ADOQuery5.FieldByname(' 评论人卡号 ').Value <> UserSession.KaHao) and (not UserSession.GuanLi_YuYin) then begin self.WebApplication.ShowMessage('这不是你发的，你无权修改。'); Exit; end; if IWButton17.Caption = '我要修改' then//进入修改状态 begin IWDBEdit6.Editable := true; IWDBMemo3.Editable := true; IWButton21.Enabled := true; IWButton20.Enabled := False; IWButton18.Enabled := False; ADOQuery5.Edit; IWButton17.Caption := '确认修改'; end else//保存编辑好了的数据 begin if IWDBEdit6.Text = '' then begin self.WebApplication.ShowMessage('请填写标题。'); IWDBEdit6.SetFocus; Exit; end; if IWDBMemo3.Text = '' then begin self.WebApplication.ShowMessage('请填写内容。'); IWDBMemo3.SetFocus; Exit; end; ADOQuery5.Post; IWButton17.Caption := '我要修改'; IWDBEdit6.Editable := False; IWDBMemo3.Editable := False; IWButton20.Enabled := true; IWButton16.Enabled := False;



第 278页/共 301页

IWButton21.Enabled := False; IWButton18.Enabled := true; end; end; //点击评论界面的音像剪接浏览时执行 procedure TIWFormxiazaiYuYin.IWButton22Click(Sender: TObject); var I: Integer; begin IWButton21Click(Sender); IWRegion2.Visible := true; IWRegion3.Visible := False; IWButton17.Caption := '我要修改'; IWDBEdit6.Editable := False; IWDBMemo3.Editable := False; IWMemo2.Text := ''; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := DangQiangid; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do begin IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; ADOQuery5.Close;



第 279页/共 301页

try ADOQuery1.Open; ADOQuery1.Locate('id', Trim(DangQiangid), []); except end; ok := true; end; //点击评论界面的放弃改动按钮后执行 procedure TIWFormxiazaiYuYin.IWButton21Click(Sender: TObject); begin ADOQuery5.Cancel; IWButton17.Caption := '我要修改'; IWDBEdit6.Editable := False; IWDBMemo3.Editable := False; IWButton20.Enabled := true; IWButton16.Enabled := False; IWButton21.Enabled := False; IWButton17.Enabled := true; IWButton18.Enabled := true; end; //点击评论界面的发布此评论时执行 procedure TIWFormxiazaiYuYin.IWButton16Click(Sender: TObject); begin if IWDBEdit6.Text = '' then begin self.WebApplication.ShowMessage('请填写标题。'); IWDBEdit6.SetFocus; Exit; end; if IWDBMemo3.Text = '' then begin self.WebApplication.ShowMessage('请填写内容。'); IWDBMemo3.SetFocus; Exit; end; //保存评论 ADOQuery5.FieldByname('下载 ID').Value := DangQiangid; ADOQuery5.FieldByname('评论时间').Value := Now; ADOQuery5.FieldByname('评论人姓名').Value := UserSession.XingMing; ADOQuery5.FieldByname('评论人卡号').Value := UserSession.KaHao;



第 280页/共 301页

ADOQuery5.Post; IWDBEdit6.Editable := False; IWDBMemo3.Editable := False; IWButton15Click(Sender); IWButton20.Enabled := true; IWButton16.Enabled := False; IWButton21.Enabled := False; IWButton17.Enabled := true; IWButton18.Enabled := true; end; //点击我发布的所有评论按钮时执行 procedure TIWFormxiazaiYuYin.IWButton15Click(Sender: TObject); begin if not UserSession.GuanLi_YuYin then//如果不是管理员，只显示当前用户的评论 begin ADOQuery5.Close; ADOQuery5.SQL.Clear; ADOQuery5.SQL.Add('select * from G063语音评论 where 下载 ID = :x and 评论人卡号=:y order by 评论时间 desc'); ADOQuery5.Parameters.ParamByName('x').Value := DangQiangid; ADOQuery5.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery5.Open; end else//如果是管理员，则显示所的评论 begin ADOQuery5.Close; ADOQuery5.SQL.Clear; ADOQuery5.SQL.Add('select * from G063语音评论 where 下载 ID = :x order by 评论时间 desc'); ADOQuery5.Parameters.ParamByName('x').Value := DangQiangid; ADOQuery5.Open; end; end; //点击增加评论按钮时执 procedure TIWFormxiazaiYuYin.IWButton20Click(Sender: TObject); begin IWDBEdit6.Editable := true; IWDBMemo3.Editable := true; ADOQuery5.Append; IWButton20.Enabled := False; IWButton17.Enabled := False;

第 281页/共 301页

IWButton18.Enabled := False; IWButton16.Enabled := true; IWButton21.Enabled := true; end; //点击我要发表评论按钮时执行 procedure TIWFormxiazaiYuYin.IWButton3Click(Sender: TObject); begin ok := False; ADOQuery1.Open; if (ADOQuery1.RecordCount = 0) then//如果没有当前记录则退出 begin self.WebApplication.ShowMessage('当前没有选定音像剪接。'); Exit; end; ADOQuery1.Close; IWRegion1.Visible := False; IWRegion2.Visible := False; IWRegion3.Visible := true; IWButton15Click(Sender); end; //点击表格的相应行，将记录指向到该记录，并给相应控件赋值 procedure TIWFormxiazaiYuYin.TIWDBAdvWebGrid2AfterGotoLink(Sender: TObject; RowIndex, ColumnIndex: Integer); begin if ADOQuery1.RecordCount <> 0 then begin IWComboBox6.ItemIndex := IWComboBox6.Items.IndexOf(Trim(ADOQuery1.FieldByname('分类1').Value)); IWComboBox7.Items.Clear; IWComboBox7.Items.Add(Trim(ADOQuery1.FieldByname('分类 2').Value)); IWComboBox7.ItemIndex := 0; TIWScrollPanel1.Text.Text := Trim(ADOQuery1.FieldByname('内容').Value); end; end; //删除某一个类别前要相应删除所有的语音评论，语音文件和语音记录 procedure TIWFormxiazaiYuYin.ADOQuery2BeforeDelete(DataSet: TDataSet); begin ADOQuery4.Close;



第 282页/共 301页

ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('delete from G063语音评论 where 下载 ID in (select id from G062语音内容 where 分类 1=:x1 and 分类 2=:x2)'); ADOQuery4.Parameters.ParamByName('x1').Value := ADOQuery2.FieldByname('分类 1').Value; ADOQuery4.Parameters.ParamByName('x2').Value := ADOQuery2.FieldByname('分类 2').Value; ADOQuery4.ExecSQL; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('delete from G062语音内容 where 分类 1=:x1 and 分类 2=:x2'); ADOQuery4.Parameters.ParamByName('x1').Value := ADOQuery2.FieldByname('分类 1').Value; ADOQuery4.Parameters.ParamByName('x2').Value := ADOQuery2.FieldByname('分类 2').Value; ADOQuery4.ExecSQL; end; //增加音像剪接分类 procedure TIWFormxiazaiYuYin.IWButton19Click(Sender: TObject); begin ADOQuery2.Open; IWRegion4.Visible := true; IWRegion1.Visible := False; end; //执行返回按钮的动作 procedure TIWFormxiazaiYuYin.IWButton24Click(Sender: TObject); begin IWRegion1.Visible := true; IWRegion4.Visible := False; ADOQuery2.Close; end; procedure TIWFormxiazaiYuYin.IWComboBox4Change(Sender: TObject); begin if IWButton12.Enabled = true then begin self.WebApplication.ShowMessage('请先按放弃改动按钮。'); Exit; end; if not UserSession.GuanLi_YuYin then begin if not IWCheckBox1.Checked then begin ADOQuery1.Close;



第 283页/共 301页

ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 加入者卡号=:y and 锁定=0 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery1.Open; end else begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 加入者卡号=:y and 推荐=1 and 锁定=0 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := UserSession.KaHao; ADOQuery1.Open; end; end else begin if not IWCheckBox1.Checked then begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%'

第 284页/共 301页

else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Open; end else begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 推荐=1 order by 加入时间 desc'); if Trim(IWComboBox2.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox2.Text) + '%'; if Trim(IWComboBox4.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox4.Text) + '%'; ADOQuery1.Open; end; end; if ADOQuery1.RecordCount <> 0 then begin IWComboBox6.ItemIndex := IWComboBox6.Items.IndexOf(Trim(ADOQuery1.FieldByname('分类1').Value)); IWComboBox7.Items.Clear; IWComboBox7.Items.Add(Trim(ADOQuery1.FieldByname('分类 2').Value)); IWComboBox7.ItemIndex := 0; end; end; procedure TIWFormxiazaiYuYin.IWComboBox5Change(Sender: TObject); var I: Integer; begin if not IWCheckBox2.Checked then begin ADOQuery1.Close; ADOQuery1.SQL.Clear;

第 285页/共 301页

ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 审核人卡号<>:y order by 加入时间 desc'); if Trim(IWComboBox1.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox1.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := ' '; if Trim(IWComboBox5.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox5.Text) + '%'; ADOQuery1.Open; end else begin ADOQuery1.Close; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('select * from G062语音内容 where 分类 1 like :x1 and 分类 2 like :x2 and 推荐=1 and 审核人卡号<>:y order by 加入时间 desc'); if Trim(IWComboBox1.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x1').Value := '%' else ADOQuery1.Parameters.ParamByName('x1').Value := Trim(IWComboBox1.Text) + '%'; if Trim(IWComboBox5.Text) = '所有分类' then ADOQuery1.Parameters.ParamByName('x2').Value := '%' else ADOQuery1.Parameters.ParamByName('x2').Value := Trim(IWComboBox5.Text) + '%'; ADOQuery1.Parameters.ParamByName('y').Value := ' '; ADOQuery1.Open; end; if ADOQuery1.RecordCount > 0 then begin IWLink1.hint := '给' + Trim(ADOQuery1.FieldByname('加入者姓名').Value) + '发信息。'; TIWScrollPanel1.Text.Text := Trim(ADOQuery1.FieldByname('内容').Value); end else IWLink1.hint := ''; if ADOQuery1.RecordCount = 0 then Exit;



第 286页/共 301页

IWMemo2.Text := ''; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do begin IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; end; //点击下载音像剪接按钮时执行 procedure TIWFormxiazaiYuYin.IWButton25Click(Sender: TObject); begin ok := False; try ADOQuery1.Open; ADOQuery1.Locate('id', Trim(DangQiangid), []); except end; if ADOQuery1.RecordCount = 0 then Exit; if Trim(ADOQuery1.FieldByname('下载地址').Value) = '' then Exit; if Pos('/', Trim(ADOQuery1.FieldByname('下载地址').Value)) = 0 then begin if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\YuYinTianDi\' +



第 287页/共 301页

Trim(ADOQuery1.FieldByname('下载地址').Value)) then//判断是否有此文件 WebApplication.SendFile(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value), true, '', '')//向客户端发送文件 else self.WebApplication.ShowMessage('无音像剪接文件下载。'); end else begin if SysUtils.FileExists(WebApplication.ApplicationPath + Trim(ADOQuery1.FieldByname('下载地址').Value)) then WebApplication.SendFile(WebApplication.ApplicationPath + Trim(ADOQuery1.FieldByname('下载地址 ').Value), true, '', Trim(ADOQuery1.FieldByname(' 标题 ').Value) + SysUtils.ExtractFileExt(WebApplication.ApplicationPath + Trim(ADOQuery1.FieldByname('下载地址').Value))) else self.WebApplication.ShowMessage('无音像剪接文件下载。'); end; if ADOQuery1.RecordCount = 0 then Exit; ADOQuery1.Edit; ADOQuery1.FieldByname('下载次数').Value := ADOQuery1.FieldByname('下载次数').Value + 1; ADOQuery1.Post; ok := true; end; procedure TIWFormxiazaiYuYin.IWComboBox6Change(Sender: TObject); var I: Integer; begin //判断自己是否选择了空的，否则就退出 if Trim(IWComboBox6.Text) = '' then begin self.WebApplication.ShowMessage('大类不能为空。'); IWComboBox6.SetFocus; Exit; end; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select distinct 分类 2 from G061语音分类 where 分类 1=:x'); ADOQuery4.Parameters.ParamByName('x').Value := Trim(IWComboBox6.Text); ADOQuery4.Open; ADOQuery4.First; IWComboBox7.Clear;

第 288页/共 301页

for I := 1 to ADOQuery4.RecordCount do begin IWComboBox7.Items.Add(Trim(ADOQuery4.FieldByname('分类 2').Value)); ADOQuery4.Next; end; ADOQuery4.Close; IWComboBox7.ItemIndex := -1; IWDBEdit1.Editable := true; IWDBMemo2.Editable := true; IWComboBox6.Editable := False; IWComboBox7.Editable := true; IWDBFile1.Visible := true; IWFile1.Visible := true; IWDBCheckBox1.Editable := true; IWButton12.Enabled := true; if IWDBCheckBox2.Visible = true then IWDBCheckBox2.Editable := true; ADOQuery1.Append; IWButton1.Enabled := true; end; //点击设定此速度后执行 procedure TIWFormxiazaiYuYin.IWButton26Click(Sender: TObject); begin TIWScrollPanel1.Speed := Strtoint(Trim(TIWAdvEdit1.Text)); end; //到达指定记录后执行 procedure TIWFormxiazaiYuYin.ADOQuery1AfterScroll(DataSet: TDataSet); var I: Integer; begin if ok = true then begin if ADOQuery1.RecordCount = 0 then Exit; if ADOQuery1.FieldByname('内容').Value = NULL then Exit; try ////++++++++++++++++++++++++++++++ if ADOQuery1.FieldByname('下载地址').Value <> NULL then begin if Pos('/', Trim(ADOQuery1.FieldByname('下载地址').Value)) = 0 then

第 289页/共 301页

begin if SysUtils.FileExists(WebApplication.ApplicationPath + 'files\YuYinTianDi\' + Trim(ADOQuery1.FieldByname('下载地址').Value)) then TIWHTMLLabel1.HTMLText := ' <a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音">播放</a>' else TIWHTMLLabel1.HTMLText := ''; end else begin if SysUtils.FileExists(WebApplication.ApplicationPath + Trim(ADOQuery1.FieldByname('下载地址').Value)) then//如果有此文件，以下将显示小喇叭和播放两个字，点击播放将调用 realplqyer播放该文件 TIWHTMLLabel1.HTMLText := ' <a href="javascript:;" onClick="MM_showHideLayers(''floater'','''',''show'')"><img border="0" src="../files/spk1.gif" width="21" height="20" alt="点击播放录音">播放</a>' else TIWHTMLLabel1.HTMLText := ''; end; end else TIWHTMLLabel1.HTMLText := ''; ////++++++++++++++++++++++++++++++ TIWScrollPanel1.Text.Text := Trim(ADOQuery1.FieldByname('内容').Value); IWMemo2.Text := ''; ADOQuery4.Close; ADOQuery4.SQL.Clear; ADOQuery4.SQL.Add('select * from G063语音评论 where 下载 ID=:x order by 评论时间 desc'); ADOQuery4.Parameters.ParamByName('x').Value := ADOQuery1.FieldByname('id').Value; ADOQuery4.Open; ADOQuery4.First; if ADOQuery4.RecordCount > 0 then begin IWMemo2.Visible := true; IWDBImage1.Top := 565; IWRegion2.Height := 578; for I := 1 to ADOQuery4.RecordCount do begin



第 290页/共 301页

IWMemo2.Text := IWMemo2.Text + ' ' + ADOQuery4.FieldByname('评论人姓名').Value + '于 ' + DateTimeToStr(ADOQuery4.FieldByname('评论时间 ').Value) + '发表如下评论 :' + #13 + ADOQuery4.FieldByname('评论内容').Value + #13 + #13; ADOQuery4.Next; end; end else begin IWMemo2.Visible := False; IWDBImage1.Top := 432; IWRegion2.Height := 578 - 129; end; ADOQuery4.Close; if ADOQuery1.RecordCount > 0 then IWLink1.hint := '给' + Trim(ADOQuery1.FieldByname('加入者姓名').Value) + '发信息。'; except ADOQuery4.Close; end; if ADOQuery1.RecordCount = 0 then begin IWLink1.hint := ''; IWLink1.Enabled := False; Exit; end; IWLink1.Enabled := true; jiarykahao := Trim(ADOQuery1.FieldByname('加入者卡号').Value); jiaruxingming := Trim(ADOQuery1.FieldByname('加入者姓名').Value); IWLink1.hint := '给' + Trim(ADOQuery1.FieldByname('加入者姓名').Value) + '发信息。'; DangQiangid := Trim(ADOQuery1.FieldByname('id').AsString); end; end; //更新点击次数 procedure TIWFormxiazaiYuYin.TIWDBAdvWebGrid3AfterGotoLink(Sender: TObject; RowIndex, ColumnIndex: Integer); begin if ADOQuery1.RecordCount = 0 then Exit; ADOQuery1.Edit; ADOQuery1.FieldByname('点击次数').Value := ADOQuery1.FieldByname('点击次数').Value + 1; ADOQuery1.Post; end;



第 291页/共 301页

//输出完 html代码后执行 procedure TIWFormxiazaiYuYin.IWAppFormAfterRender(Sender: TObject); begin if ok = true then begin ADOQuery1.Close; end; end; //输出 html代码时执行 procedure TIWFormxiazaiYuYin.IWAppFormRender(Sender: TObject); begin if UserSession.flag = true then begin try ADOQuery1.Open; ADOQuery1.Locate('id', Trim(DangQiangid), []); except end; end; UserSession.flag := False; self.WebApplication.SessionTimeOut := 30;//设定当前页的自动关闭时间 if IWRegion2.Visible = true then IWRegion5.Visible := true else IWRegion5.Visible := False; end; //关闭 session procedure TIWFormxiazaiYuYin.ComGridColumns0Click(ASender: TObject; const AValue: string); begin UserSession.closesessoion; end; 补充说明：本程序主要以应用 intraweb 控件和 TMS 控件为主，所以页面上有很多各种各样的控件。代码其

实是很简单的，主要是对数据库的操作和相应控件的属性和方法的操作。改变相应控件的 visible属性可以实现灵活多样的界面输出，请好好利用这一点可以减少编程窗口的数量和模板的数量。如有不懂的地方请多看看源代码，查看相应控件的事件即可明白它在程序中的作用。大家在看程

序时，不要力求全部明白程序的所有逻辑过程，应主要着眼于整个 intraweb程序的大体框架和实现的基本途径，数据库操作的细节和程序的整体应用逻辑是次要的，切记！



第 292页/共 301页

所有模板文件用 dreamweaverMX 编辑，如有不明白的地方，请打开源代码自己细看。请注意模板的图片文件的相对路径。

Server_dll.dpr 为生成 dll 版本的工程文件。要用 IIS 发布生才能查看。所有代码在

WinXPSP2+Dlphi7.0 +IntraWeb7.2.41下调试通过。IWServerController的属性 ComInitialization：发布到WinXPSP2，Win2000，请选择 ciMultiThreaded，发布到Win2003SP1请选择 ciNormal。

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 5．1 使用通用框架的目的作者：高勇


第 293页/共 301页

第五章 Intraweb编程通用框架

5．1 使用通用框架的目的 IntraWeb 编程开始都是一样的，它有一些通用的窗口和单元，例如 ServerController.pas 和

UserSessionUnit.pas 等。我们可以把一些常用的通用函数定义在这两个单元中。如果有导航条或者菜单之类的东西，则可以放在 UFormBase.pas 单元中，其它单元可以从它继承（在《用窗口继承的方法实现网页中的导航条》这一节中有详细讲解）。我们将工程命名为 exe.dpr和 dll.dpr，这样我们可以很清楚的看出其发布方法。有了以上框架，我们编写任何程序都可以从这个框架开始。我样做的好处是： 1、可以节省不少时间 2、常用函数和方法可以直接调用

5．2 通用框架的基本结构通用框架的基本结构我们从以下几个方面讲解： 1、程序的目录结构程序的所有源代码都存入在程序的根目录下，此外在该目录下还有如下 3个文件夹：database下

存放数据库文件，files 文件夹下存放所有的程序要用到的相关文件，templates 文件下存放程序模板文件。在这个框架中，我们用的是 database\data.mdb数据库，用它是因为它不用安装，发布简便，且可以很方便的移植到 SQL2000 等数据库中；files\Skin 中放的是我们的皮肤文件模板，也就是一些帮助我们美化输出数据的一些事先定义好的带有特定标记的 html文件（在《用 html 模板格式化输出数据库中的数据》这一节中有详细讲解），其中的文件夹 1 表示这是该程序的一套皮肤，如果有文件夹 2,3等，程序就具有换肤功能了，files\dtree是一个显示 tree结构的 javascript相关文件，可以当作控件对待（在《实现网页中的目录树》这一节中有详细讲解），files\ images是一个在网页中实现复杂html编辑器的“控件”（在《在 IntraWeb中轻松实现通用的 HTML文本编辑器》这一节中有详细讲解），files\ tip.js是一个实现复杂信息提示框的 javascript文件（在《实现网页复杂提示信息框》这一节中有详细讲解），files\ exit.htm为程序退出时调用的页面，files\ System.ini中记录了一些程序系统设置信息，如程序使用的端口，IP，数据库连接密码，是否使用网页特效，默认使用的模板和皮肤文件夹等等，其它文件是模板所要调用的文件，一些图片等；templates 下放的是模板文件，它和皮肤文件一样，可以有很多文件夹，更换文件夹就可以实现不同的网站风格。根目录下的 Clean.bat 可以用来清除编程所留下的临时文件。根目录下的 GY.pas中存放了一些常用的函数集合。如图 5-1所示：

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 5．2 通用框架的基本结构作者：高勇


第 294页/共 301页

图 5-1程序的目录结构

2、程序的编程结构我们先完成 exe 发布方式的编程，这是因为这种方式可以很方便的进行调试，当完成程序后，也

要可以很方便的转化成 dll的形式，这方便我们利用 IIS正式进行发布。我们需要一个主界面，同时也要有导航条或菜单，如果方便的话，程序中最好自带一些我们常用的共用函数和一些通用的处理模块，

如加密、解密，自动调用模板，自动退出处理等等。按照以上要求我们的设计框图如图 5-2所示：

图 5-2 通用框架结构示意图

1、打开 dll.dpr工程文件，将 exe.dpr工程中用到的单元文件加入到该工程中即可将.exe形式转化

创建我们的 intraweb程序

exe.dpr dll.dpr

ServerController.pas UserSessionUnit.pas UFormBase.pas Umain.pas GY.pas

生成 exe.exe 生成 dll.dll

以默认文件名保

存，设置程序多个

重要参数。我们精

选了一些常用的

函数，其它窗口可

以直接调用

以默认文件名保

存，处理数据库的

连接和程序退出

结束 Session 的函数，其它窗口以如

下方式调用其中

的函数和变量

UserSession.CloseSession;

这是程序中被

继承的窗口，

用来完成导

航、菜单或登

录、退出等相

关处理

这是程序的

主页面，从

UFormBase.pas继承。可以在这里实

现我们的主

界面

常用函

数集合，

自己可

以任意

添加

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 5．3 通用函数导读与讲解作者：高勇


第 295页/共 301页

成.dll形式用 IIS发布（参考《IntraWeb程序.exe与.dll两种发布形式的相互转换》这一节）。 2、ServerController.pas是一个很重要的单元，该单元中的一些属性设置对程序很重要（参考《建

立一个以独立的应用程序的形式发布的程序》这一节）。此外，该单元还定义了很多有用的函数，下面

有详细介绍。 3、UserSessionUnit.pas是一个很特殊的单元，为什么这么说呢？因为它相当于一个 Session的

共用数据存储区，所有 use它的窗口都可以直接使用它的变量和函数，这为各个窗口之间的数据交换提供了方便（参考《窗口之间数据参数传递详解》这一节）。

4、UFormBase.pas 是一个被继承的单元，其使用方法请参考《用窗口继承的方法实现网页中的导航条》这一节。

5．3 通用函数导读与讲解 1、ServerController.pas单元中新加入了如下函数：本单元代码太多，请打开通用框架文件夹内的源代码查看。此处只列出函数声明，并简单说明一

下函数的作用，同时指出了相应的参考章节。 function GetLocalIP: string; //得到本机 IP地址 procedure ShowForm(AFormName: string;FreeActiveForm:boolean=false);//打开页面的通用函

数 function GetLinkStringEx(Row: Integer; ID, Link: string; Cof: string = ''; GridName: string =

'ComGrid'): string; // 请参考《用自己的代码实现表格翻页控件》这一节 function GetToolStr(RecNo, RecordCount, RowLimit: Integer; GridID: Integer; Nums: Integer =

10; Captions: string = '条记录'; Grid: string = 'ComGrid'): string;// 请参考《用自己的代码实现表格翻页控件》这一节

function GetSpace(Count: Integer): string;//得到插入 Count个空格的 html代码 function pictureString(IPath, ISize: string): string;//得到在网页中显示图片的 html代码。IPath为

图片文件例如：/files/temp.jpg ISize为图片的小，中，大选项：small，med，larg function GetLinkString(Row, ID: string; Link: string; title: string = ''; Cof: string = ''; GridName:

string = 'ComGrid'): string; //请参考《让超级链接变成可向服务器传递参数的按钮》这一节 procedure SetPage(Grid: TIWDBGrid; AValue: string; RecNumble: Integer); // 请参考《用自己的

代码实现表格翻页控件》这一节 function PlayRM(Iflie: string): string;//得到播放 RM文件：Iflie的 html代码 function PlayAvi(Iflie: string): string; //得到播放 Avi文件：Iflie的 html代码 function CopyDirectory(const Source, Dest: string): Boolean; //复制文件夹(Source为被拷贝的文

件夹名，Dest新文件夹名) function DelDirectory(const Source: string): Boolean; //删除文件夹 function RenDirectory(const OldName, NewName: string): Boolean; // 更改文件夹名称 function gethzPy(const AHzStr: string): string; //得到汉字着字母 function RenString(Istring: string): string; //将字符中的/替换成\ function IIF(str, num: string): string; //如果 str为空，则函数值为 num，如果不为空，则函数值为

str function GetHourStr: string; //得到一天的时间段称呼 function GetpicString(picurl: string; width: string = '500'; alt: string = '在新窗口中查看该图片'):

string; //alt为鼠标上去后的提示文字



第 296页/共 301页

function ReplaceStrs(str, SearchStr, ReplaceStr: string): string;//用 ReplaceStr替换 str中所有的SearchStr字符串

2、UserSessionUnit. pas单元中的完整代码如下： unit UserSessionUnit; interface uses IWUserSessionBase, SysUtils, Classes, //新加入的 : IWApplication, DB, ADODB; type TIWUserSession = class(TIWUserSessionBase) List: TADOQuery; ListSource: TDataSource; Querytemp: TADOQuery; cn: TADOConnection; Querytemp1: TADOQuery; procedure IWUserSessionBaseCreate(Sender: TObject); private { Private declarations } public { Public declarations } Skin: string; //所使用的皮肤 RecNumble: Integer; //记录集的当前记录号 procedure CloseSession;//关闭退出程序，可以在其它任意窗口中调用 end; implementation uses ServerController, IWInit; {$R *.dfm} procedure TIWUserSession.IWUserSessionBaseCreate(Sender: TObject); var i: Integer; begin //设定全局数据连接并打开，不要把它写在 IWServerController单元内，用 IIS发布时有问题 cn.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +

IWServerController.AppPath + 'database\data.mdb;Persist Security Info=False'; cn.Open; for i := 0 to self.ComponentCount - 1 do begin//给所有的 TADOQuery控件指定数据库连接为

cn if (self.Components[i] is TADOQuery) then begin (self.Components[i] as TADOQuery).Connection := cn; end; end; end;

第 297页/共 301页

procedure TIWUserSession.CloseSession;//关闭退出程序，可以在其它任意窗口中调用 begin //可以添加退出时要处理的代码，例如记录上网用时，下网时间等等 WebApplication.Terminate;//结束当前会话（sessoion） end; end. 3、UFormBase.pas单元中的完整代码如下：设计时窗口内的控件布局如图 5-3 所示。IWTemplateProcessorHTML1 是用来指定窗口的 html

模板的。ComGrid0是为了响应页面上的某些超级链接的。退出按钮用来结束程序。

图 5-3 UFormBase单元对应窗口的控件布局

unit UFormBase; {页面进入和退出的特效进入页面<meta http-equiv="Page-Enter" content="revealTrans(duration=x, transition=y)"> 推出页面<meta http-equiv="Page-Exit" content="revealTrans(duration=x, transition=y)"> 这个是页面被载入和调出时的一些特效。duration 表示特效的持续时间，以秒为单位。transition

表示使用哪种特效，取值为 1-23: 0 矩形缩小 1 矩形扩大 2 圆形缩小 3 圆形扩大 4 下到上刷新 5 上到下刷新 6 左到右刷新 7 右到左刷新 8 竖百叶窗 9 横百叶窗 10 错位横百叶窗 11 错位竖百叶窗 12 点扩散 13 左右到中间刷新 14 中间到左右刷新 15 中间到上下 16 上下到中间 17 右下到左上 18 右上到左下 19 左上到右下 20 左下到右上 21 横条 22 竖条 23 以上 22种随机选择一种} interface uses Classes, SysUtils, IWAppForm, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompButton, IWCompLabel, Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWGrids, IWDBGrids; type TIWFormBase = class(TIWAppForm) IWTemplateProcessorHTML1: TIWTemplateProcessorHTML; ComGrid0: TIWDBGrid; IWLabel1: TIWLabel;

第 298页/共 301页

IWButton1: TIWButton; procedure IWAppFormRender(Sender: TObject); procedure ComGrid0Columns0Click(ASender: TObject; const AValue: string); procedure IWButton1Click(Sender: TObject); public end; implementation uses ServerController, UserSessionUnit; {$R *.dfm} procedure TIWFormBase.IWAppFormRender(Sender: TObject); var VLIst: TStringList; closestr: string; begin closestr := '<script FOR=window EVENT=onunload>if (window.event.clientY <0) ' + '{SubmitClickConfirm(''ComGrid0'',''0_close'', true, '''');window.alert('' 欢迎下次再来！

'');}</script>';//让 IE响应关闭事件（点击刷新也会执行） //ExtraHeader.Text :=closestr+ ExtraHeader.Text;//如果要 IE关闭时自动关闭 session，则请去

掉此句的注释 VLIst := TStringList.Create; VLIst.LoadFromFile(WebApplication.ApplicationPath + 'files\System.ini'); //读取系统设置信息 //StyleSheet.Filename := WebApplication.ApplicationPath + 'Files\Skin\' + UserSession.Skin +

'\style.css'; IWTemplateProcessorHTML1.Templates.Default := UserSession.Skin + '\' +

WebApplication.ActiveForm.Name + '.Html'; //设定所有继承它的窗口的 html模板文件名 if StrToBoolDef(VLIst.ValueFromIndex[1], true) then //如果支持页面特效 ExtraHeader.Text := ' <meta HTTP-EQUIV="Page-Enter"

CONTENT="revealtrans(duration=0.5, transition=23)"> ' + ExtraHeader.Text; VLIst.Free; //登录成功的话改变页面显示：＝＝＝＝＝＝＝＝＝ //登录成功的话改变页面显示。＝＝＝＝＝＝＝＝＝ end; procedure TIWFormBase.ComGrid0Columns0Click(ASender: TObject;const AValue: string); //响

应 IE的关闭事件，关闭所有窗口 begin UserSession.CloseSession;//关闭退出程序 end; procedure TIWFormBase.IWButton1Click(Sender: TObject); begin



第 299页/共 301页

self.WebApplication.Terminate('您主动退出了！'); //或者用下一句 //UserSession.CloseSession;//关闭退出程序 end; end. 4、Umain.pas单元中的完整代码如下： unit Umain; interface uses Windows, Messages, UFormBase, IWVCLComponent, IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout, IWTemplateProcessorHTML, IWCompButton, IWCompLabel, Classes, Controls, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWGrids, IWDBGrids; type TIWFormmain = class(TIWFormBase) ComGrid: TIWDBGrid; IWLabel2: TIWLabel; private { Private declarations } public { Public declarations } end; var IWFormmain: TIWFormmain; implementation uses ServerController, UserSessionUnit;//最好每个窗口都加上这两个单元 {$R *.dfm} initialization TIWFormmain.SetAsMainForm; RegisterClass(TIWFormmain);//请在每个窗口最后一个 end 前加上这一句，如果没有

initialization，也请加上 initialization end. 5、GY.pas单元中有如下函数可被调用（当然你可以无限增加）： function GetMACAddress(Num: Byte = 0): string; overload; //获取第 num块网卡卡号，如果只有

一块网卡的话，直接调用 GetMACAddress(0)即可返回网卡卡号字符串（当有网络连接时才能返回正确值）

function GetIDEDiskSerialNumber: string;//得到硬盘物理号 function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte = 1): string;//取得 C盘等分区盘的序列号 function GetCPUInfo(InfoID: Byte = 1): string;//得到 CPU的信息，1为序列号，2为频率，3为厂

家 function Encrypt_text(text,mima:string):string; //用密码mima对 text字串进行加密，函数返回加

密后的字串 function DeEncrypt_text(text,mima:string):string; //用密码mima对 text字串进行解密，函数返回

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 5．4 使用框架的注意事项作者：高勇


第 300页/共 301页

解密后的字串，当然加密是用的上一个函数 Encrypt_text(text,mima:string) function Encrypt(file1,tofile2,mima:string):boolean; //用密码mima对 file1文件加密生成为 tofile2

文件，加密成功函数返回 true，否则返回 false function DeEncrypt(file1,tofile2,mima:string):boolean; //用密码 mima 对 file1 文件解密生成为

tofile2文件，解密成功函数返回 true，否则返回 false function CopyDirectory(const Source, Dest: string): Boolean; //拷贝一目录到另一个目录 function DelDirectory(const Source: string): Boolean; // 删除一个目录 function RenDirectory(const OldName, NewName: string): Boolean; // 给一个目录改名 function MoveDirectory(const OldName, NewName: string): Boolean; // 移动一个目录名 function gethzPy(const AHzStr: string): string; //得到汉字首字母 function ReplaceText(const S, ReplacePiece, ReplaceWith: string): string; //用 ReplaceWith字串

替换 S中的所有 ReplacePiece字串 function GetLocalIP: string; //得到本机 IP地址（只有当有网络连接时），单机时返回字串：127.0.0.1

5．4 使用框架的注意事项

1、在新开始一个项目时，请将通用框架文件夹全部拷贝到一个合适的位置并改名为该项目名称，该项目的所有相关文件都放在该文件夹中，其中源代码文件放在根目录下，database存放数据库文件，templates存放模板文件，files存放程序要用到的所有资源文件，doc存放项目编程所有技术文档。发布程序时只要 database，templates，files三个文件夹和两个文件：dll.dll，exe.exe（两种发布方式）。

2、敏感数据请加密后保存（应用 Encrypt_text(text,mima)函数），程序要调用时可以先解密（调用 DeEncrypt_text(text,mima)函数）。防止被下载后看到。

3、用 IIS发布时，如果程序发布时该硬盘分区为 NTFS文件系统的话（如果是 Fat32格式，则不用进行如下操作），还要设置权限，否则程序可能运行不正常，如不能更新数据库，写入硬盘临时文件

等等。进行如下两步操作即可：（1）第一步：打开工具菜单下的文件夹选项，如图 5-4所示：不要选择“使用简单文件共享（推

荐）”这一项。

图 5-4 文件夹选项对话框

《Delphi 下用 IntraWeb 开发WEB程序应用实战》 5．4 使用框架的注意事项作者：高勇


第 301页/共 301页

（2）第二步：右击要发布的文件夹，选择属性，如图 5-5所示。在安全选项卡中添加 Internet来宾帐户，给其权限为图中所示。

图 5-5 属性对话框

如果没有进行以上设置，如果程序访问修改数据库的话，则可能会出现如图 5-6所示出错提示：


如果程序要更改某个文件的话，则可能出现如图 5-7所示出错提示：


以上请参考《Windows下 IntraWeb开发后的发布》这一节。

Delphi(7 和2006 2007) 下用开发 WEB...

Documents

Transcript of Delphi(7 和2006 2007) 下用开发 WEB...

Delphi(7 和2006 2007) 下 用 开发 WEB...

Documents

Transcript of Delphi(7 和2006 2007) 下 用 开发 WEB...

Delphi(7 和2006 2007) 下用开发 WEB...

Transcript of Delphi(7 和2006 2007) 下用开发 WEB...