在详细分析HTTP500内部错误产生的原因之前，先对IWAM账号进行一下简要的介绍：IWAM账号是安装IIS5时系统自动建立的一个内置账号，主要用于启动进程之外的应用程序的I nternet信息服务。IWAM账号的名字会根据每台计算机NETBIOS名字的不同而有所不同，通用的格式是IWAM_MACHINE，即由“IWAM”前缀、连接线“_ ”加上计算机的NETBIOS名字组成。我的计算机的NETBIOS名字是MYSERVER，因此我的计算机上IWAM账号的名字就是IWAM_MYSERVER，这一点与I IS匿名账号ISUR_MACHINE的命名方式非常相似。

IWAM账号建立后被Active Directory、IIS metabase数据库和COM+应用程序三方共同使用，账号密码被三方分别保存，并由操作系统负责这三方保存的IWAM密码的同步工作。按常理说，由操作系统负责的工作我们大可放心，不必担心出错，但不知是B UG还是其它什么原因，系统的对IWAM账号的密码同步工作有时会失败，使三方IWAM账号所用密码不统一。当IIS或COM+应用程序使用错误I WAM的密码登录系统，启动IIS Out-Of-Process Pooled Applications时，系统会因密码错误而拒绝这一请求，导致IIS Out-Of-Process Pooled Applications启动失败，也就是我们在ID10004错误事件中看到的“不能运行服务器{3D14228D-FBE1-11D0-995D-00C04FD919C1} ”（这里{3D14228D-FBE1-11D0-995D-00C04FD919C1} 是IIS Out-Of-Process Pooled Applications的KEY），不能转入IIS5应用程序，HTTP 500内部错误就这样产生了。

知道了导致HTTP 500内部错误的原因，解决起来就比较简单了，那就是人工同步IWAM账号在Active Directory、IIS metabase数据库和COM+应用程序中的密码。

具体操作分三步,均需要以管理员身份登录计算机以提供足够的操作权限（IWAM账号以IWAM_MYSERVER为例）。

（一）更改Active Directory中IWAM_MYSERVER账号的密码

因IWAM账号的密码由系统控制，随机产生，我们并不知道是什么，为完成下面两步的密码同步工作，我们必须将IWAM账号的密码设置为一个我们知道的值。

1、选择“开始”->“程序”->“管理工具”->"Active Directory用户和计算机"，启动“Active Directory用户和计算机”管理单元。

2、单击“user”，选中右面的“IWAM_MYSERVER”，右击选择“重设密码(T)...”，在跳出的重设密码对方框中给IWAM_MYSERVER设置新的密码，这儿我们设置成“A boutnt2001”（没有引号的），确定，等待密码修改成功。

（二）同步IIS metabase中IWAM_MYSERVER账号的密码

可能因为这项改动太敏感和重要，微软并没有为我们修改IIS metabase中IWAM_MYSERVER账号密码提供一个显式的用户接口，只随IIS5提供了一个管理脚本adsutil.vbs，这个脚本位于C:\inetpub\adm inscripts子目录下（位置可能会因你安装IIS5时设置的不同而有所变动）。

adsutil.vbs脚本功能强大，参数非常多且用法复杂，这里只提供使用这个脚本修改IWAM_MYSERVER账号密码的方法:

adsutil SET w3svc/WAMUserPass Password

"Password"参数就是要设置的IWAM账号的新的密码。因此我们将IIS metabase中IWAM_MYSERVER账号的密码修改为“Aboutnt2001”的命令就是：

c:\Inetpub\AdminScripts>adsutil SET w3svc/WAMUserPass "Aboutnt2001"

修改成功后，系统会有如下提示：

WAMUserPass: (String) "Aboutnt2001"

（三）同步COM+应用程序所用的IWAM_MYSERVER的密码

同步COM+应用程序所用的IWAM_MYSERVER的密码，我们有两种方式可以选择:一种是使用组件服务MMC管理单元，另一种是使用IWAM账号同步脚本s ynciwam.vbs。

1、使用组件服务MMC管理单元

（1）启动组件服务管理单元：选择“开始”->“运行”->“MMC”，启动管理控制台,打开“添加/删除管理单元”对话框,将“组件服务”管理单元添加上。

（2）找到“组件服务”->“计算机”->“我的电脑”->“COM+应用程序”->“Out-Of-Process Pooled Applications”，右击“Out-Of-Process Pooled Applications”->“属性”。

（3）切换到“Out-Of-Process Pooled Applications”属性对话框的“标志”选项卡。“此应用程序在下列账户下运行”选择中“此用户”会被选中，用户名是“IWAM_MYSERVE R”。这些都是缺省的，不必改动。在下面的“密码”和“确认密码”文本框内输入正确的密码“Aboutnt2001”，确定退出。

（4）系统如果提示“应用程序被一个以上的外部产品创建。你确定要被这些产品支持吗？”时确定即可。

（5）如果我们在IIS中将其它一些Web的“应用程序保护”设置为“高（独立的）”,那么这个WEB所使用的COM+应用程序的IWAM账号密码也需要同步。重复（1 ）-（4）步，同步其它相应Out of process application的IWAM账号密码。

2、使用IWAM账号同步脚本synciwam.vbs

实际上微软已经发现IWAM账号在密码同步方面存在问题，因此在IIS5的管理脚本中单独为IWAM账号密码同步编写了一个脚本synciwam.vbs ，这个脚本位于C:\inetpub\adminscripts子目录下（位置可能会因你安装IIS5时设置的不同而有所变动）。

synciwam.vbs脚本用法比较简单：

cscript synciwam.vbs [-v|-h]

“-v”参数表示详细显示脚本执行的整个过程(建议使用)，“-h”参数用于显示简单的帮助信息。

我们要同步IWAM_MYSERVER账号在COM+应用程序中的密码，只需要执行“cscript synciwam.vbs -v”即可，如下：

cscript c:\inetpub\adminscripts\synciwam.vbs -v

Microsoft (R) Windows Script Host Version 5.6

版权所有(C) Microsoft Corporation 1996-2000。保留所有权利。

WamUserName:IWAM_MYSERVER

WamUserPass:Aboutnt2001

IIS Applications Defined:

Name, AppIsolated, Package ID

w3svc, 0, {3D14228C-FBE1-11d0-995D-00C04FD919C1}

Root, 2,

IISHelp, 2,

IISAdmin, 2,

IISSamples, 2,

MSADC, 2,

ROOT, 2,

IISAdmin, 2,

IISHelp, 2,

Root, 2,

Root, 2,

Out of process applications defined:

Count: 1

{3D14228D-FBE1-11d0-995D-00C04FD919C1}

Updating Applications:

Name: IIS Out-Of-Process Pooled Applications Key: {3D14228D-FBE1-11D0-995D-00C04FD919C1}

从上面脚本的执行情况可以看出，使用synciwam.vbs脚本要比使用组件服务的方法更全面和快捷。它首先从IIS的metabase数据库找到IWA M账号"IWAM_MYSERVER"并取出对应的密码“Aboutnt2001”，然后查找所有已定义的IIS Applications和Out of process applications，并逐一同步每一个Out of process applications应用程序的IWAM账号密码。

使用synciwam.vbs脚本时，要注意一个问题，那就是在你运行synciwam.vbs之前，必须保证IIS metabase数据库与Active Directory中的IWAM密码已经一致。因为synciwam.vbs脚本是从IIS metabase数据库而不是从Active Directory取得IWAM账号的密码，如果IIS metabase中的密码不正确，那synciwam.vbs取得的密码也会不正确，同步操作执行到“Updating Applications”系统就会报80110414错误，即“找不到应用程序{3D14228D-FBE1-11D0-995D-00C04FD919C1}”。

好了，到现在为止，IWAM账号在Active Directory、IIS metabase数据库和COM+应用程序三处的密码已经同步成功，你的ASP程序又可以运行了！

虽然是问题解决了,但是纳闷的是我从来没有更改过服务器上的帐号密码,怎么会出现这样的错误呢?难道IIS或WIN2K会自动定期修改密码?

基于互联网的广域网现代应用中的一个重要环节是数据库远程监控。首先简单回顾一下互联网上的数据库远程管理技术的发展过程和方式：
早期通过编写CGI-BIN程序模块进行数据库远程管理。但CGI-BIN的运行速度慢，维护很不方便，现在已经基本被弃用。
这几年使用组件对象模型(Component Object Model, COM)的应用非常多，效果也很好。但如果使用的是第三方服务器(笔者的网站就是建立在第三方的虚拟主机上)，服务器方往往因为保密或其它商业原因不允许用户注册自己的组件。

近年来由微软公司推出的.NET平台和SUN公司的J2EE平台都是非常高档的数据库远程管理与服务平台。都能提供优质的多层(n-Tier)应用服务。
其中，.NET的简单对象访问协议(Simple Object Access Protocol, SOAP)使用超文本传输协议(Hypertext Transfer Protocol, HTTP)和扩展标记语言(Extensible Markup Language, XML)技术实现跨系统(例如Windows - Linux)的通讯服务方式已经广为开发商接受和使用。许多大型应用，例如企业资源计划(Enterprise resource planning, ERP)等都建立在这样的大型平台之上。
但对于中小型应用，比如一个网站的建设和维护，这种大型应用平台就显得有些尾大不掉，开销也过于庞大。

曾经在互联网技术和Java技术方面一度落后的微软公司在XML应用开发则走在了前头。她的XML解析器(MSXML)中的XMLHTTP协议是一个非常方便实用的客户/服务通讯管道。综合运用XMLHTTP以及ActiveX数据对象(ActiveX Data Objects, ADO/ADOX)可以简单方便地实现数据库远程管理。

本文介绍如何综合运用XMLHTTP和ADO/ADOX进行远程数据库管理。

二、数据库远程管理体系

数据库远程管理的任务流程是：
1、客户端向服务端发出数据库结构和数据的查询或修改指令。
2、服务端接受并执行有关指令并向客户端返回结果。
3、客户端接受并显示服务端返回的指令执行结果。

实现数据库远程管理的二个主要关键环节是：
1、客户端与服务端之间的指令上传和结果下传的数据通道，由XMLHTTP协议实现。
2、服务端前沿与数据库之间的指令传送和结果返回，由起着中间层作用的ADO/ADOX接口完成。
三、XMLHTTP的使用

顾名思义，XMLHTTP是个传送XML格式数据的超文本传输协议。

实际上，XMLHTTP的数据传输过程更为灵活一些：
它上传的指令可以是XML格式数据，也可以是字符串，流，或者一个无符号整数数组。还可以是URL的参数。
它下达的结果可以是XML格式数据，也可以是字符串，流，或者一个无符号整数数组。
详情可参阅文末链接。

客户端调用XMLHTTP的过程很简单，只有5个步骤：
1、创建XMLHTTP对象
2、打开与服务端的连接，同时定义指令发送方式，服务网页(URL)和请求权限等。
    客户端通过Open命令打开与服务端的服务网页的连接。与普通HTTP指令传送一样，可以用"GET"方法或"POST"方法指向服务端的服务网页。
3、发送指令。
4、等待并接收服务端返回的处理结果。
5、释放XMLHTTP对象

XMLHTTP方法：
Open bstrMethod, bstrUrl, varAsync, bstrUser, bstrPassword
    bstrMethod：数据传送方式，即GET或POST。
    bstrUrl：服务网页的URL。
    varAsync：是否同步执行。缺省为True，即同步执行，但只能在DOM中实施同步执行。
     应用中一般将其置为False，即异步执行。
    bstrUser：用户名，可省略。
    bstrPassword：用户口令，可省略。

Send varBody
    varBody：指令集。可以是XML格式数据，也可以是字符串，流，或者一个无符号整数数组。也可以省略，让指令通过Open方法的URL参数代入。
    
setRequestHeader bstrHeader, bstrValue
    bstrHeader：HTTP 头(header)
    bstrValue：HTTP 头(header)的值
    如果Open方法定义为POST，可以定义表单方式上传：
    xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
XMLHTTP属性：
onreadystatechange：在同步执行方式下获得返回结果的事件句柄。只能在DOM中调用。
responseBody：结果返回为无符号整数数组。
responseStream：结果返回为IStream流。
responseText ：结果返回为字符串。
responseXML：结果返回为XML格式数据。
    

下面是本文附件源程序中的一个应用示例：
Function GetResult(urlStr)
    Dim xmlHttp
    Dim retStr
    
    Set xmlHttp = CreateObject("Msxml2.XMLHTTP")    '创建对象
    On Error Resume Next                    '出错处理
    xmlHttp.Open "POST", urlStr, False        '用POST方式打开连接，异步执行。
    xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" '上传表单
    xmlHttp.Send                            '发送指令

    If Err.Number = 0 Then                    '如果连接正确
        retStr = xmlHttp.responseText        '等待并获得服务端返回的结果字符串
    Else
        retStr = "Url not found"                '否则返回出错信息
    End If
    Set xmlHttp = nothing                    '释放对象    GetResult = retStr                        '返回结果
End Function

GetResult()函数带入一个服务网页的URL参数，把上传的指令安放在URL后面的参数上，如：
    urlStr = "server.asp?cmd=" & cmd & "&db=" & db & "table=" & table
    cmd：执行方式，例如查询，修改，删除等等。
    db：服务端数据库名
    table：服务端表名
    
然后提交指令，等待并接收返回的处理结果。结果以字符串方式返回。

-------------------------------------------------------------------

XMLHTTP对象及其方法

MSXML中提供了Microsoft.XMLHTTP对象，能够完成从数据包到Request对象的转换以及发送任务。
创建XMLHTTP对象的语句如下：
Set objXML = CreateObject("Msxml2.XMLHTTP") 或
Set objXML = CreateObject(“Microsoft.XMLHTTP”)
' Or, for version 3.0 of XMLHTTP, use:
' Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
对象创建后调用Open方法对Request对象进行初始化，语法格式为：
poster.open http-method, url, async, userID, password
Open方法中包含了5个参数，前三个是必要的，后两个是可选的(在服务器需要进行身份验证时提供)。参数的含义如下所示：
http-method： HTTP的通信方式，比如GET或是 POST
url： 接收XML数据的服务器的URL地址。通常在URL中要指明 ASP或CGI程序
async： 一个布尔标识，说明请求是否为异步的。如果是异步通信方式(true)，客户机就不等待服务器的响应；如果是同步方式(false)，客户机就要等到服务器返回消息后才去执行其他操作
userID 用户ID，用于服务器身份验证
password 用户密码，用于服务器身份验证
XMLHTTP对象的Send方法
用Open方法对Request对象进行初始化后，调用Send方法发送XML数据：
poster.send XML-data
Send方法的参数类型是Variant，可以是字符串、DOM树或任意数据流。发送数据的方式分为同步和异步两种。在异步方式下，数据包一旦发送完毕，就结束Send进程，客户机执行其他的操作；而在同步方式下，客户机要等到服务器返回确认消息后才结束Send进程。
XMLHTTP对象中的readyState属性能够反映出服务器在处理请求时的进展状况。客户机的程序可以根据这个状态信息设置相应的事件处理方法。属性值及其含义如下表所示：
值 说明
0 Response对象已经创建，但XML文档上载过程尚未结束
1 XML文档已经装载完毕
2 XML文档已经装载完毕，正在处理中
3 部分XML文档已经解析
4 文档已经解析完毕，客户端可以接受返回消息
客户机处理响应信息
客户机接收到返回消息后，进行简单的处理，基本上就完成了C/S之间的一个交互周期。客户机接收响应是通过XMLHTTP对象的属性实现的：
● responseTxt：将返回消息作为文本字符串；
● responseXML：将返回消息视为XML文档，在服务器响应消息中含有XML数据时使用；
● responseStream：将返回消息视为Stream对象。

下面的xml文件是动态生成的最后用xmlHTTP传送出去，这是一个在客户端JavaScript脚本里的内容，当然你也可以写在服务器，但是要相应的改一些东西：（仅供大家参考，了解它的用法）
var xmlDoc=new ActiveXObject("MSXML2.DOMDocument");
flag=xmlDoc.loadXML("");

newNode =xmlDoc.createElement("编码")
MarkNode=xmlDoc.documentElement.appendChild(newNode);
newNode =xmlDoc.createElement("StartMark")
newNode.text=StartMark;
MarkNode.appendChild(newNode)
newNode =xmlDoc.createElement("EndMark")
newNode.text=EndMark;
MarkNode.appendChild(newNode)

newNode =xmlDoc.createElement("日期")
DateNode=xmlDoc.documentElement.appendChild(newNode);
newNode =xmlDoc.createElement("StartDate");
newNode.text=StartDate;
DateNode.appendChild(newNode)
newNode =xmlDoc.createElement("EndDate")
newNode.text=EndDate;
DateNode.appendChild(newNode);

newNode =xmlDoc.createElement("数量")
SLNode =xmlDoc.documentElement.appendChild(newNode);
newNode =xmlDoc.createElement("StartSL")
newNode.text=StartShuL
SLNode.appendChild(newNode)
newNode =xmlDoc.createElement("EndSL");
newNode.text=EndShuL
SLNode.appendChild(newNode);

newNode =xmlDoc.createElement("单价")
DJNode =xmlDoc.documentElement.appendChild(newNode)
newNode =xmlDoc.createElement("StartDJ")
newNode.text=StartDanJ;
DJNode.appendChild(newNode);
newNode =xmlDoc.createElement("EndDJ")
newNode.text=EndDanJ;
DJNode.appendChild(newNode);

newNode =xmlDoc.createElement("金额")
JENode =xmlDoc.documentElement.appendChild(newNode)
newNode =xmlDoc.createElement("StartJE")
newNode.text=StartJinE
JENode.appendChild(newNode)
newNode =xmlDoc.createElement("EndJE")
newNode.text=EndJinE
JENode.appendChild(newNode)

newNode =xmlDoc.createElement("仓库代码")
newNode.text=CK;
xmlDoc.documentElement.appendChild(newNode)

newNode =xmlDoc.createElement("票号")
newNode.text=RKPH;
xmlDoc.documentElement.appendChild(newNode)

newNode =xmlDoc.createElement("单位代码")
newNode.text=CorpName;
xmlDoc.documentElement.appendChild(newNode)

newNode =xmlDoc.createElement("BiaoShi")
newNode.text=Biaoshi
xmlDoc.documentElement.appendChild(newNode)

newNode =xmlDoc.createElement("FindCate")
newNode.text=FindCate
xmlDoc.documentElement.appendChild(newNode)

var xh =new ActiveXObject("MSXML2.XMLHTTP")
xh.open("POST","Find.asp",false)
xh.setRequestHeader("Content-Type","text/xml")
xh.setRequestHeader("Content-Type","gb2312")
xh.send(xmlDoc);
我的每一个newNode的text值是一个变量，也就是我客户端form 中input的值

-------------------------------------------------------------------

ASP小偷程序如何利用XMLHTTP实现表单的提交
利用XMLHTTP来制作小偷的具体细节落伍很多人都发过和讨论过了，但是在制作ASP小偷的过程中，很多人就发现ASP小偷不如PHP小偷的那么强

大了。确实，如果在原网站如果存在表单提交或cookies的验证，对于ASP来说，不使用基于SOCKET的组件就难以完成，其实，XMLHTTP的另外两

个方法被我们忽略了，而这正是问题的关键。
下面首先来说说这个方法
1。.send()
由于流行的小偷是使用的GET而不是POST来传送数据，所以很多人忽略了这个方法，而使用SEND发送数据也很简单，就是SEND("内容")，可是，

发送表单就不是这么简单，因为你发送的表单如果是中文的话，就要牵扯到编码的问题了。
首先，你在OPEN 时要确定是用POST 即 .open("POST",地址,是否异步)
然后，在SEND里面加上你表单的内容，比如说，你要提交的表单有3个表单域，分别是A，B，C，对应的值分别是1，2，3，那么，你在SEND里这

样写就可以提交表单了，.send("A=1&B=2&C=3"),怎么样，很简单吧，是不是没想到呢？但是别高兴的太早了，我前面说到了，如果表单的值是

中文的话，数据传输的就会出错了。这里我们借助一个函数escape(),熟悉JAVASCRIPT的朋友都应该知道这个函数的作用了，现在VBSCRIPT同样支持这个函数。.send("A=escape('值1')&B=escape('值2')&C=escape('值3')")
2。.setRequestHeader()
接着上面的所说，你的数据send出去了，对方却不会接收到，为什么了，其实，那是因为你的HTTP头少了一个东西，然后用这个函数把加上去就可以了，具体就是.setRequestHeader("CONTENT-TYPE","application/x-www-form-urlencoded"), 告诉对方你是提交了一个urlencode编码的表单。

好的，说完了表单的提交来说怎么传送cookies和session

其实传送cookies也很简单了，同样利用这个函数在HTTP头里添加东西，比如，我当前在落伍的cookies是
cdb_sid=ybBiK0; cdb_cookietime=315360000; cdb_oldtopics=D869008D; cdb_visitedfid=1D45; cdb_auth=AQYHXVFDGERdsggVQA1VYUgxQDwFVV1dUAlwFAFRXVwU%2FbAIJB1lUCg; cdb_fid45=1113370145
现在我要发送这个cookies就直接是.setRequestHeader("Cookie","cdb_sid=ybBiK0; cdb_cookietime=315360000; cdb_oldtopics=D869008D; cdb_visitedfid=1D45; cdb_auth=AQYHXVFDGERdsggVQA1VYUgxQDwFVV1dUAlwFAFRXVwU%2FbAIJB1lUCg; cdb_fid45=1113370145")
当然，有些网站页面有页面判断功能，这个也不难，就是.setRequestHeader("Referer","来路的绝对地址")
这里还有个重要问题，就是这个方法由于是写HTTP头的，所以不能更改现有的HTTP头，对于怎么用asp获取对方页面的cookies或session并且发出去.

1、模板类的设计
　　实现代码封装成为模板类，即是为了与PHPLIB兼容，也使得代码方便管理与扩展。
　　模板类要实现的目标为：从模板文件中读入显示的HTML代码，将这些显示代码中需要动态数据的地方替换为ASP程序运算所得出的数据，然后按照一定的顺序输出。其中，替换的部分可以自由的设定。因此它必须完成如下任务：
    ·从模板文件中读取显示用的HTML代码。
    ·将模板文件和实际生成的数据结合，生成输出的结果。
    ·允许同时处理多个模板。
    ·允许模板的嵌套。
    ·允许对模板中的某个单独的部分进行处理。

实现方法：
    采用FSO读取模板文件
    采用正则替换实现模板文件和数据的结合
    处理多个模板用数组存储来实现。
    模板的嵌套的实现主要的想法是：将模板和输出（任何中间的分析结果）一视同仁，都可拿来做替换，即可实现。
    单独部分的处理的通过在模板文件中设定标注，然后在正则替换中结合标注来控制，实现部分替换。

2、模板类的实现
　　给出具体代码之前，先把主要函数列出，用过PHPLIB的朋友应该对此很熟悉了：
　　1）Public Sub set_root(ByVal Value)　设定模板默认目录
　　2）Public Sub set_file(ByVal handle,ByVal  filename)　读取文件
　　3）Public Sub set_var(ByVal Name, ByVal Value, ByVal Append)　设置映射数据-替换变量
　　4）Public Sub unset_var(ByVal Name)　取消数据映射
　　5）Public Sub set_block(ByVal Parent, ByVal BlockTag, ByVal Name)　设置数据块
　　6）Public Sub set_unknowns(ByVal unknowns)　设定未指定映射的标记处理方式
　　7）Public Sub parse(ByVal Name, ByVal BlockTag, ByVal Append)　执行模板文件与数据的结合
　　8）Public Sub p(ByVal Name)　输出处理结果

实现代码：
<%
'================================================================
' CLASS NAME:  kktTemplate ASP页面模板对象
' DESIGN BY :     彭国辉
' DATE:                 2004-07-05
' WEBSITE:          http://kacarton.yeah.net/
' BLOG:                http://blog.csdn.net/nhconch
' EMAIL:              kacarton@sohu.com
'
' 本对象中使用了set_var、set_block等命名方法是为了兼容phplib
'文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！
'================================================================

Class kktTemplate
   
    Private m_FileName, m_Root, m_Unknowns, m_LastError, m_HaltOnErr
    Private m_ValueList, m_BlockList
    Private m_RegExp   
    ' 构造函数
    Private Sub Class_Initialize
        Set m_ValueList     = CreateObject("Scripting.Dictionary")
        Set m_BlockList     = CreateObject("Scripting.Dictionary")
        set m_RegExp        = New RegExp
        m_RegExp.IgnoreCase = True
        m_RegExp.Global     = True
        m_FileName          = ""
        m_Root              = ""
        m_Unknowns          = "remove"
        m_LastError         = ""
        m_HaltOnErr         = true
    End Sub
   
    ' 析构函数
    Private Sub Class_Terminate
        Set m_RegExp       = Nothing
        Set m_BlockMatches = Nothing
        Set m_ValueMatches = nothing
    End Sub
   
    Public Property Get ClassName()
        ClassName = "kktTemplate"
    End Property
   
    Public Property Get Version()
        Version = "1.0"
    End Property
   
    Public Sub About()
        Response.Write("kktTemplate ASP页面模板类<br>" & vbCrLf &_
                       "程序设计：彭国辉 2004-07-05<br>" & vbCrLf &_
                       "个人网站：<a href='http://kacarton.yeah.net'>http://kacarton.yeah.net</a><br>" & vbCrLf &_
                       "电子邮件：<a href='mailto:kacarton@sohu.com'>kacarton@sohu.com</a><br>")
    End Sub
   
    '检查目录是否存在
    Public Function FolderExist(ByVal path)
        Dim fso
        Set fso = CreateObject("Scripting.FileSystemObject")
        FolderExist = fso.FolderExists(Server.MapPath(path))
        Set fso = Nothing
    End Function
    '读取文件内容
    Private Function LoadFile()
        Dim Filename, fso, hndFile
        Filename = m_Root
        If Right(Filename, 1)<>"/" And Right(Filename, 1)<>"\" Then Filename = Filename & "/"
        Filename = Server.MapPath(Filename & m_FileName)
        Set fso = CreateObject("Scripting.FileSystemObject")
        If Not fso.FileExists(Filename) Then ShowError("模板文件" & m_FileName & "不存在!")
        set hndFile = fso.OpenTextFile(Filename)
        LoadFile = hndFile.ReadAll
        Set hndFile = Nothing
        Set fso = Nothing
        If LoadFile = "" Then ShowError("不能读取模板文件" & m_FileName & "或文件为空!")
    End Function
   
    '处理错误信息
    Private Sub ShowError(ByVal msg)
        m_LastError = msg
        Response.Write "<font color=red style='font-size;14px'><b>模板错误：" & msg & "</b></font><br>"
        If m_HaltOnErr Then Response.End
    End Sub
   
    '设置模板文件默认目录
    'Ex: kktTemplate.set_root("/tmplate")
    '    kktTemplate.Root = "/tmplate"
    '    root = kktTemplate.get_root()
    '    root = kktTemplate.Root
    '使用类似set_root这样的命名方法是为了兼容phplib，以下将不再重复说明
    Public Sub set_root(ByVal Value)
        If Not FolderExist(Value) Then ShowError(Value & "不是有效目录或目录不存在!")
        m_Root = Value
    End Sub
    Public Function get_root()
        get_root = m_Root
    End Function
    Public Property Let Root(ByVal Value)
        set_root(Value)
    End Property
    Public Property Get Root()
        Root = m_Root
    End Property
   
    '设置模板文件
    'Ex: kktTemplate.set_file("hndTpl", "index.htm")
    '本类不支持多模板文件，handle为兼容phplib而保留
    Public Sub set_file(ByVal handle,ByVal  filename)
        m_FileName = filename
        m_BlockList.Add Handle, LoadFile()
    End Sub
    Public Function get_file()
        get_file = m_FileName
    End Function
'     Public Property Let File(handle, filename)
'         set_file handle, filename
'     End Property
'     Public Property Get File()
'         File = m_FileName
'     End Property
   
    '设置对未指定的标记的处理方式，有keep、remove、comment三种
    Public Sub set_unknowns(ByVal unknowns)
        m_Unknowns = unknowns
    End Sub
    Public Function get_unknowns()
        get_unknowns = m_Unknowns
    End Function
    Public Property Let Unknowns(ByVal unknown)
        m_Unknowns = unknown
    End Property
    Public Property Get Unknowns()
        Unknowns = m_Unknowns
    End Property
   
    Public Sub set_block(ByVal Parent, ByVal BlockTag, ByVal Name)
        Dim Matches
        m_RegExp.Pattern = "<!--\s+BEGIN " & BlockTag & "\s+-->([\s\S.]*)<!--\s+END " & BlockTag & "\s+-->"
        If Not m_BlockList.Exists(Parent) Then ShowError("未指定的块标记" & Parent)
        set Matches = m_RegExp.Execute(m_BlockList.Item(Parent))
        For Each Match In Matches
            m_BlockList.Add BlockTag, Match.SubMatches(0)
            m_BlockList.Item(Parent) = Replace(m_BlockList.Item(Parent), Match.Value, "{" & Name & "}")
        Next
        set Matches = nothing
    End Sub
   
    Public Sub set_var(ByVal Name, ByVal Value, ByVal Append)
        Dim Val
        If IsNull(Value) Then Val = "" Else Val = Value
        If m_ValueList.Exists(Name) Then
            If Append Then m_ValueList.Item(Name) = m_ValueList.Item(Name) & Val _
            Else m_ValueList.Item(Name) = Val
        Else
            m_ValueList.Add Name, Value
        End If
    End Sub
   
    Public Sub unset_var(ByVal Name)
        If m_ValueList.Exists(Name) Then m_ValueList.Remove(Name)
    End Sub
   
    Private Function InstanceValue(ByVal BlockTag)
        Dim keys, i
        InstanceValue = m_BlockList.Item(BlockTag)
        keys = m_ValueList.Keys
        For i=0 To m_ValueList.Count-1
            InstanceValue = Replace(InstanceValue, "{" & keys(i) & "}", m_ValueList.Item(keys(i)))
        Next
    End Function
   
    Public Sub parse(ByVal Name, ByVal BlockTag, ByVal Append)
        If Not m_BlockList.Exists(BlockTag) Then ShowError("未指定的 块标记" & Parent)
        If m_ValueList.Exists(Name) Then
            If Append Then m_ValueList.Item(Name) = m_ValueList.Item(Name) & InstanceValue(BlockTag) _
            Else m_ValueList.Item(Name) = InstanceValue(BlockTag)
        Else
            m_ValueList.Add Name, InstanceValue(BlockTag)
        End If
    End Sub
   
    Private Function finish(ByVal content)
        Select Case m_Unknowns
            Case "keep" finish = content
            Case "remove"
                m_RegExp.Pattern = "\{[^ \t\r\n}]+\}"
                finish = m_RegExp.Replace(content, "")
            Case "comment"
                m_RegExp.Pattern = "\{([^ \t\r\n}]+)\}"
                finish = m_RegExp.Replace(content, "<!-- Template Variable $1 undefined -->")
            Case Else finish = content
        End Select
    End Function
   
    Public Sub p(ByVal Name)
        If Not m_ValueList.Exists(Name) Then ShowError("不存在的标记" & Name)
        Response.Write(finish(m_ValueList.Item(Name)))
    End Sub
End Class
%>

3、使用例子
　　下面举三个例子进行说明。
1)简单的值替换
模板文件为myTemple.tpl，内容：
<html><title>ASP模板简单替换</title><body>
祝贺！你赢了一辆{some_color}法拉利！
</body>

下面是ASP代码（kktTemplate.inc.asp就是上面给出的模板类）：
<!--#INCLUDE VIRTUAL="kktTemplate.inc.asp"-->
<%
dim my_color, kkt
my_color = "红色的"
set kkt = new kktTemplate                 '创建模板对象
kkt.set_file "hndKktTemp", "myTemple.tpl" '设置并读取模板文件myTemple.tpl
kkt.set_var "some_color", my_color, false '设置模板变量 some_color = my_color的值
kkt.parse "out", "hndKktTemp", false      '模板变量 out = 处理后的文件
kkt.p "out"                               '输出out的内容
set kkt = nothing                         '销毁模板对象
%>

执行后输出为：
<html><title>ASP模板简单替换</title><body>
祝贺！你赢了一辆红色的法拉利！
</body>

2)循环块演示例子
模板文件myTemple2.tpl：
<html><title>ASP模板－块的演示</title><body>
<table cellspacing="2" border="1"><tr><td>下面的动物您喜欢哪一种</td></tr>
<!-- BEGIN AnimalList -->
<tr><td><input type="radio" name="chk">{animal}</td></tr>
<!-- END AnimalList -->
</table>
</body>

ASP代码：
<!--#INCLUDE VIRTUAL="kktTemplate.inc.asp"-->
<%
dim animal, kkt, i
animal = Array("小猪","小狗","小强")
set kkt = new kktTemplate
kkt.set_file "hndKktTemp", "myTemple2.tpl"
kkt.set_block "hndKktTemp", "AnimalList", "list"
for i=0 to UBound(animal)
    kkt.set_var "animal", animal(i), false
    kkt.parse "list", "AnimalList", true
next
kkt.parse "out", "hndKktTemp", false
kkt.p "out"
set kkt = nothing
%>
 
执行结果：
<html><title>ASP模板－块的演示</title><body>
<table cellspacing="2" border="1"><tr><td>下面的动物您喜欢哪一种</td></tr>
<tr><td><input type="radio" name="chk">小猪</td></tr>
<tr><td><input type="radio" name="chk">小狗</td></tr>
<tr><td><input type="radio" name="chk">小强</td></tr>
</table>
</body>
                                       

3)嵌套块演示
模板文件myTemple3.tpl：
<html><title>ASP模板－嵌套块演示</title>
<body><table width="400" border="1" bordercolor="#000000">
  <tr><td><div align="center">{myname}测试</div></td></tr>
  <tr><td>我的动植物园：</td> </tr>
<!-- BEGIN animalList -->
  <tr><td>{animal}</td></tr>
  <!-- BEGIN plantList -->
    <tr><td>&nbsp;&nbsp;{plant}</td></tr>
  <!-- END plantList -->
<!-- END animalList -->
</table>
</body>
</html>

ASP代码：
<!--#INCLUDE VIRTUAL="kktTemplate.inc.asp"-->
<%
dim my_color, kkt, myname, animal, plant
set kkt = new kktTemplate
myname = "kktTemplate block test..."
animal = array("动物", "植物")
plant  = array(array("小猪","小白","小强"), array("玫瑰","向日葵"))

kkt.set_file "hndKktTemp", "myTemple3.tpl"
kkt.set_var "myname", myname, false
kkt.set_block "hndKktTemp", "animalList", "a"
kkt.set_block "animalList", "plantList", "p"

for i=0 to UBound(animal)
   kkt.set_var "animal", animal(i), False
   kkt.unset_var "p" 
   'kkt.set_var "p", "", false
   for j=0 to UBound(plant(i))
        kkt.set_var "plant", plant(i)(j), false
        kkt.parse "p", "plantList", true
   next
   kkt.parse "a", "animalList", true
next
kkt.parse "out", "hndKktTemp", false
kkt.p "out"
%>

执行结果：
<html><title>ASP模板－嵌套块演示</title>
<body><table width="400" border="1" bordercolor="#000000">
  <tr><td><div align="center">kktTemplate block test...测试</div></td></tr>
  <tr><td>我的动植物园：</td> </tr>
  <tr><td>动物</td></tr>
    <tr><td>&nbsp;&nbsp;小猪</td></tr>
    <tr><td>&nbsp;&nbsp;小白</td></tr>
    <tr><td>&nbsp;&nbsp;小强</td></tr>
  <tr><td>植物</td></tr>
    <tr><td>&nbsp;&nbsp;玫瑰</td></tr>
    <tr><td>&nbsp;&nbsp;向日葵</td></tr>
</table>
</body>
</html>

4、小结
　　本文主要介绍了基于ASP利用模板类实现代码与页面分离的方法，当然还有其它更好的解决方案。本文旨在抛砖引玉各位读者、WEB开发参与进来，多提宝贵意见，多作交流，共同进步！

 '//获取汉字的首字母
function getpychar(char)
dim tmpp:tmpp=65536+asc(char)
 if(tmpp>=45217 and tmpp<=45252) then
 getpychar= "A"
elseif(tmpp>=45253 and tmpp<=45760) then
 getpychar= "B"
elseif(tmpp>=45761 and tmpp<=46317) then
 getpychar= "C"
elseif(tmpp>=46318 and tmpp<=46825) then
 getpychar= "D"
elseif(tmpp>=46826 and tmpp<=47009) then
 getpychar= "E"
elseif(tmpp>=47010 and tmpp<=47296) then
 getpychar= "F"
elseif(tmpp>=47297 and tmpp<=47613) then
 getpychar= "G"
elseif(tmpp>=47614 and tmpp<=48118) then
 getpychar= "H"
elseif(tmpp>=48119 and tmpp<=49061) then
 getpychar= "J"
elseif(tmpp>=49062 and tmpp<=49323) then
 getpychar= "K"
elseif(tmpp>=49324 and tmpp<=49895) then
 getpychar= "L"
elseif(tmpp>=49896 and tmpp<=50370) then
 getpychar= "M"
elseif(tmpp>=50371 and tmpp<=50613) then
 getpychar= "N"
elseif(tmpp>=50614 and tmpp<=50621) then
 getpychar= "O"
elseif(tmpp>=50622 and tmpp<=50905) then
 getpychar= "P"
elseif(tmpp>=50906 and tmpp<=51386) then
 getpychar= "Q"
elseif(tmpp>=51387 and tmpp<=51445) then
 getpychar= "R"
elseif(tmpp>=51446 and tmpp<=52217) then
 getpychar= "S"
elseif(tmpp>=52218 and tmpp<=52697) then
 getpychar= "T"
elseif(tmpp>=52698 and tmpp<=52979) then
 getpychar= "W"
elseif(tmpp>=52980 and tmpp<=53640) then
 getpychar= "X"
elseif(tmpp>=53689 and tmpp<=54480) then
 getpychar= "Y"
elseif(tmpp>=54481 and tmpp<=62289) then
 getpychar= "Z"
else '如果不是中文，则不处理
 getpychar=char
end if
end function
'//生成汉字串首字母串
function getpy(str)
for i=1 to len(str)
 getpy=getpy & getpychar(mid(str,i,1))
next
end function

　　举一个例子如下：

　　假设有一个有这样一个串　

　　strNor=";northsnow:塞北的雪;csdn:中国最大的开发者网络;crc:长春轨道客车股份有限公司;"

　　串中包含了很多子串，子串是用;(分号)分割开的，每个子串也分两个部分，前一部分为标识或英文名，后一个部分为中文名或说明。根据给定的标识查找后面的说明怎么做呢？这就是我们这个例子将要解决的问题：

　　代码如下：

dim oStr oStr=";northsnow:塞北的雪;csdn:中国最大的开发者网络;crc:长春轨道客车股份有限公司;" function getName(ooID)      dim objRegExp ,reMatchCol,reMatch,reSubMatch      dim rValue      Set objRegExp=new RegExp      objRegExp.Pattern=";(" & ooID & "):([^;]*)"      objRegExp.IgnoreCase=true      objRegExp.Global=true      set reMatchCol= objRegExp.execute(oStr)  '执行查询，并返回匹配到一个匹配集合中      if reMatchCol.count>0 then           Set reMatch = reMatchCol(0)                '将第一匹配串放到一个匹配对象中           Set reSubMatch = reMatch.SubMatches        '返回子匹配集合           if reSubMatch(0)=ooID then                                  rValue=reSubMatch(1)           else                rValue=""           end if      else          rValue=""      end if      getName=rValue end function response.Write getName("northsnow")

''''  塞北的雪  分页利器(sql server)  不用存储过程   -------------------------

'其中注释中有 ###的需要用户设置
'其中注释中有 参数传递 ** 的 说明要通过参数 传递。

'定义变量
dim tOption                  '查询条件
dim tOrder                   '排序字符串     
dim tOrderField              '排序字段        可通过参数获得：order_field
dim tOrderDirection          '排序方向        可通过参数获得：order_direction

dim tPageSize                '页大小
dim tTotalCount              '总记录数        可通过参数获得：t_count
dim tPageCount               '页数
dim tCurPage                 '当前页号        可通过参数获得：page

dim tTableName               '表或者视图名
dim tFieldAlias              '行号的别名
dim tFieldList               '查询的字段列表
dim tPageField               '用于分页的字段

dim r_count                  '查得的记录数

set rs=server.createobject("adodb.recordset")        '记录集对象

'排序处理
tOrderField=Request("order_field")                   '获得排序字段（参数传递 **）
tOrderDirection=Request("order_dir")                 '获得排序方向（参数传递 **）

if(tOrderField="") then tOrderField="item_code"       ' ### 设置默认排序字段
if(tOrderDirection="") then tOrderDirection="asc"     ' ### 设置默认排序方向

tOrder=" order by " & tOrderField & " " & tOrderDirection & " "   '生成排序字符串

'定义参数
tPageSize=find_rs_count        ' ### 设置页大小
tTableName="view_select1"      ' ### 设置与查询的表格或视图
tFieldList=" * "               ' ### 欲查询的字段列表
tPageField="item_code"         ' ### 设置一个主键或唯一索引的字段 ，用于分页计算

'页数处理
tCurPage=Request("page")             '获得当前页（参数传递 **）
tTotalCount=Request("t_count")       '获得总页数（参数传递 **）

if(tCurPage="") then tCurPage=1
if(cint(tCurPage)=0) then tCurPage=1
if(tPageCount="") then tPageCount =1
if(cint(tPageCount)=0) then tPageCount=1

' 构造查询条件，根据具体的程序，肯定不一样。但是最后的条件必须是“ where ??? ”
tOption=" issue_flag='Y'"                      ' ### 设置条件
if f_c<>"" then tOPtion= tOPtion & f_c         ' ### 设置条件

if trim(tOption)="" then
     tOption = " where 1=1 "   '如果没有条件，就自己加一个。
else
     tOption= " where " & tOPtion
end if

   
  
     '构造查询字符串，这个分页程序的核心，此查询串是我们只下载当前页所需的记录
 if(tCurPage>1) then
  conStr="select top " & tPageSize & " " & tFieldList & "  from  " & tTableName &  tOption
  conStr =conStr & " and " & tPageField & " not in(select top " & tPageSize*(tCurPage-1) & " " & tPageField & "  from " & tTableName &  tOption & " " & tOrder & ") " & tOrder
 else
  conStr="select top " & tPageSize & " " & tFieldList & " from " & tTableName & tOption & " " & tOrder
 end if 
 
 
 '执行主查询，获得相应记录集 
 Call ConnDataBase()                     '  ### 建立数据库连接
    rs.cursorlocation=3
    rs.open conStr,conn,3,1                 '执行查询
    r_count= rs.recordcount

   '当还没有查询过总记录数时 并且 总的记录数超过了页大小时 ，查询当前条件下的总的记录数
   if(r_count>=tPageSize or tCurPage>1) and tTotalCount=0 then
      set rr=conn.execute("select count(*) from " & tTableName & " " & tOption)
      tTotalCount=rr(0)
      rr.close()
      set rr=nothing
   end if   
   if(cint(tTotalCount)=0) then tTotalCount=r_count '如果总记录为0，将当前差得的记录集的记录数设置为总记录数，说明当前的总记录数小于页大小
  
   '利用页大小和总记录数 计算页数
   if(cint(tTotalCount)>cint(tPageSize)) then
  tPageCount=cint((cint(tTotalCount) \ cint(tPageSize)))
  if(cint(tTotalCount) mod cint(tPageSize))>0 then
      tPageCount =tPageCount +1
  end if
   end if
 
   tCurPage=cint(tCurPage)
   tPageCount=cint(tPageCount)

'  ---------------------------------------------------------------------

        这就是全部代码，感兴趣的朋友，可以研究一下，或者将他封装起来，加上分页导航等方法。总之，希望此代码能对大家有用。