'*************************************************** ' 说明:Person类 ' 作者:gwd 2002-11-06 ' 引用:pub/constpub.asp '*************************************************** Class Cls_Person Private m_intId ' Id,对应Person节点在Persons集合中的位置 Private m_strName ' 姓名 Private m_strNick ' 英文名 Private m_strMobile ' 手机 Private m_strTel ' 电话 Private m_strEmail ' 电子邮件 Private m_strQQ ' QQ号 Private m_strCompany ' 所在公司 Private m_strError ' 出错信息 ' 类初始化 Private Sub Class_Initialize() m_strError = "" m_intId = -1 End Sub ' 类释放 Private Sub Class_Terminate() m_strError = "" End Sub '-----读写各个属性--------------------------- Public Property Get Id Id = m_intId End Property Public Property Let Id(intId) m_intId = intId End Property Public Property Get Name Name = m_strName End Property Public Property Let Name(strName) m_strName = strName End Property Public Property Get Nick Nick = m_strNick End Property Public Property Let Nick(strNick) m_strNick = strNick End Property Public Property Get Mobile Mobile = m_strMobile End Property Public Property Let Mobile(strMobile) m_strMobile = strMobile End Property Public Property Get Tel Tel = m_strTel End Property Public Property Let Tel(strTel) m_strTel = strTel End Property Public Property Get Email Email = m_strEmail End Property Public Property Let Email(strEmail) m_strEmail = strEmail End Property Public Property Get QQ QQ = m_strQQ End Property Public Property Let QQ(strQQ) m_strQQ = strQQ End Property Public Property Get Company Company = m_strCompany End Property Public Property Let Company(strCompany) m_strCompany = strCompany End Property '----------------------------------------------- ' 获取错误信息 Public Function GetLastError() GetLastError = m_strError End Function ' 私有方法,添加错误信息 Private Sub AddErr(strEcho) m_strError = m_strError + "<Div CLASS=""alert"">" & strEcho & "</Div>" End Sub ' 清除错误信息 Public Function ClearError() m_strError = "" End Function ' 从Xml中读取指定节点的数据,并填充各个属性 ' 需要首先设置Id Public Function GetInfoFromXml(objXmlDoc) Dim objNodeList Dim I ClearError If objXmlDoc Is Nothing Then GetInfoFromXml = False AddErr "Dom对象为空值" Exit Function End If If CStr(m_intId) = "-1" Then GetInfoFromXml = False AddErr "未正确设置联系人对象的ID属性" Exit Function Else I = m_intId - 1 ' 要读取得节点位置 End If ' 选择并读取节点信息,赋予各个属性 Set objNodeList = objXmlDoc.getElementsByTagName("Person") If objNodeList.length - m_intId >= 0 Then On Error Resume Next m_strName = objNodeList(I).selectSingleNode("Name").Text m_strNick = objNodeList(I).selectSingleNode("Nick").Text m_strMobile = objNodeList(I).selectSingleNode("Mobile").Text m_strTel = objNodeList(I).selectSingleNode("Tel").Text m_strEmail = objNodeList(I).selectSingleNode("Email").Text m_strQQ = objNodeList(I).selectSingleNode("QQ").Text m_strCompany = objNodeList(I).selectSingleNode("Company").Text GetInfoFromXml = True Else GetInfoFromXml = False AddErr "获取联系信息发生错误" Set objNodeList = Nothing Exit Function End If Set objNodeList = Nothing End Function ' 添加信息到XML文件中 ' 需要首先设置好要填充的属性 Public Function AddToXml(objXmlDoc) Dim objPerson, objNode ClearError If objXmlDoc Is Nothing Then AddToXml = False AddErr "Dom对象为空值" Exit Function End If ' 创建Person节点 Set objPerson = objXmlDoc.createElement("Person") objXmlDoc.documentElement.appendChild objPerson ' 创建各个子节点 '----------------------------------------------------- Set objNode = objXmlDoc.createElement("Name") objNode.Text = m_strName objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Nick") objNode.Text = m_strNick objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Mobile") objNode.Text = m_strMobile objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Tel") objNode.Text = m_strTel objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Email") objNode.Text = m_strEmail objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("QQ") objNode.Text = m_strQQ objPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Company") objNode.Text = m_strCompany objPerson.appendChild objNode '----------------------------------------------------- Set objNode = Nothing Set objPerson = Nothing On Error Resume Next objXmlDoc.save Server.MapPath(C_XMLFILE) '保存XML文件 If Err.Number = 0 Then AddToXml = True Else AddToXml = False AddErr Err.Description End If End Function ' 从XML文件中删除数据 ' 需要首先设置Id Public Function DeleteFromXml(objXmlDoc) Dim objNodeList, objNode ClearError If objXmlDoc Is Nothing Then DeleteFromXml = False AddErr "Dom对象为空值" Exit Function End If If CStr(m_intId) = "-1" Then DeleteFromXml = False AddErr "未正确设置联系人对象的ID属性" Exit Function End If Set objNodeList = objXmlDoc.getElementsByTagName("Person") If objNodeList.length - m_intId < 0 Then DeleteFromXml = False AddErr "未找到相应的联系人" Set objNodeList = Nothing Exit Function End If On Error Resume Next Set objNode = objXmlDoc.documentElement.removeChild(objNodeList(intId-1)) If objNode Is Nothing Then DeleteFromXml = False AddErr "删除联系人失败" Set objNodeList = Nothing Exit Function Else objXmlDoc.save Server.MapPath(C_XMLFILE) End If Set objNode = Nothing Set objNodeList = Nothing If Err.Number = 0 Then DeleteFromXml = True Else DeleteFromXml = False AddErr Err.Description End If End Function ' 修改XML文件中的数据 ' 需要首先设置好Id Public Function EditToXml(objXmlDoc) Dim objPersonList, objOldPerson, objNewPerson, objNode ClearError If objXmlDoc Is Nothing Then EditToXml = False AddErr "Dom对象为空值" Exit Function End If If CStr(m_intId) = "-1" Then EditToXml = False AddErr "未正确设置联系人对象的ID属性" Exit Function End If Set objPersonList = objXmlDoc.getElementsByTagName("Person") If objPersonList.length - m_intId < 0 Then DeleteFromXml = False AddErr "未找到相应的联系人" Set objPersonList = Nothing Exit Function End If Set objOldPerson = objPersonList(m_intId-1) ' 要修改的旧节点 Set objNewPerson = objXmlDoc.createElement("Person") ' 用来替换旧节点的新节点 Set objNode = objXmlDoc.createElement("Name") objNode.Text = m_strName objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Nick") objNode.Text = m_strNick objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Mobile") objNode.Text = m_strMobile objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Tel") objNode.Text = m_strTel objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Email") objNode.Text = m_strEmail objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("QQ") objNode.Text = m_strQQ objNewPerson.appendChild objNode Set objNode = objXmlDoc.createElement("Company") objNode.Text = m_strCompany objNewPerson.appendChild objNode On Error Resume Next ' 进行替换 Set objNode = objXmlDoc.documentElement.replaceChild(objNewPerson, objOldPerson) If objNode Is Nothing Then EditToXml = False AddErr "修改联系人失败" Set objOldPerosn = Nothing Set objNewPerson = Nothing Set objPersonList = Nothing Exit Function Else objXmlDoc.save Server.MapPath(C_XMLFILE) End If Set objOldPerson = Nothing Set objNewPerson = Nothing Set objPersonList = Nothing If Err.Number = 0 Then EditToXml = True Else EditToXml = False AddErr Err.Description End If End Function End Class 五、程序首页(default.asp)
调用相应的包含文件和公共函数,格式化XML文件,并进行显示。可以看到,页面Title是可定制的,公共的头部和尾部都做成了相应的包含文件。C_TITLE、C_XMLFILE和C_XSLFILE为公共常量,在constpub.asp文件中定义,至于它们的意义,相信读者可以很容易地明白。这里调用了上面定义的FormatXml函数。
<% Option Explicit '*********************************************** ' 说明:通讯录 ' 作者:gwd 2002-11-05 '*********************************************** %> <!--#include file="pub/funcxml.asp"--> <!--#include file="pub/constpub.asp"--> <HTML> <HEAD> <TITLE><% = C_TITLE %></TITLE> <META HTTP-EQUIV="content-type" CONTENT="text/html;charset=GB2312"/> <link rel="stylesheet" href="contact.css" type="text/css"> </HEAD> <BODY> <!--#include file="pub/header.asp"--> <% = FormatXml(C_XMLFILE, C_XSLFILE) %> <br> <!--#include file="pub/footer.asp"--> </BODY> </HTML> |
六、添加、修改和删除XML中的信息
我们知道,在Cls_Person中已经定义了相应的方法,因此,在各个文件中,只需要调用对应的方法即可。添加信息的文件为add.asp,修改信息的文件为edit.asp,删除信息的文件为delete.asp,我们仅以add.asp文件为例进行说明。其中的CheckStrInput和CheckStrOutput函数,用来格式化用户的输入和输出字符串。
<% Option Explicit '*********************************************** ' 说明:37080308通讯录 ' 作者:gwd 2002-11-05 '*********************************************** %> <!--#include file="pub/funcxml.asp"--> <!--#include file="pub/constpub.asp"--> <!--#include file="pub/funcpub.asp"--> <!--#include file="pub/class/clsPerson.asp"--> <% Dim objXml, objPerson Dim strErr Set objXml = Server.CreateObject("MSXML2.DOMDocument") Set objPerson = New Cls_Person ' 生成Cls_Person对象 If Request.Form("btnOk") <> "" Then If LoadXmlDoc(objXml, C_XMLFILE, False, strErr) Then ' 装载XML文件 ' 给相应的属性赋值 objPerson.Name = CheckStrInput(Request.Form("txtName")) objPerson.Nick = CheckStrInput(Request.Form("txtNick")) objPerson.Mobile = CheckStrInput(Request.Form("txtMobile")) objPerson.Tel = CheckStrInput(Request.Form("txtTel")) objPerson.Email = CheckStrInput(Request.Form("txtEmail")) objPerson.QQ = CheckStrInput(Request.Form("txtQQ")) objPerson.Company = CheckStrInput(Request.Form("txtCompany")) If Not objPerson.AddToXml(objXml) Then ' 调用Cls_Person类的AddToXml方法,添加数据 AddErr strErr, objPerson.GetLastError Else AddErr strErr, "添加成功" Response.Write "<script language=""javascript"">opener.location.reload();</script>" End If End If End If Set objXml = Nothing %> <HTML> <HEAD> <TITLE><% = C_TITLE %></TITLE> <META HTTP-EQUIV="content-type" CONTENT="text/html;charset=GB2312"/> <link rel="stylesheet" href="contact.css" type="text/css"> <script language="javascript"> <!-- function CheckForm() { return true; } //--> </script> </HEAD> <BODY> <% = strErr %> <div class="title">添加联系信息</div> <form name="form1" method="post" action="add.asp" οnsubmit="return CheckForm()"> <table align="center" width="100%" cellspacing="1" cellpadding="2" border="0" bgcolor="#666600"> <tr bgcolor="#ffffff"> <td width="25%" bgcolor="#e5e5e5" align="right"><b>姓名:</b></td> <td width="75%"><input type="text" name="txtName" size="25" class="input" value="<%=CheckStrOutput(objPerson.Name)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>英文名:</b></td> <td><input type="text" name="txtNick" size="25" class="input" value="<%=CheckStrOutput(objPerson.Nick)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>手机:</b></td> <td><input type="text" name="txtMobile" size="25" class="input" value="<%=CheckStrOutput(objPerson.Mobile)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>电话:</b></td> <td><input type="text" name="txtTel" size="25" class="input" value="<%=CheckStrOutput(objPerson.Tel)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>Email:</b></td> <td><input type="text" name="txtEmail" size="25" class="input" value="<%=CheckStrOutput(objPerson.Email)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>QQ:</b></td> <td><input type="text" name="txtQQ" size="25" class="input" value="<%=CheckStrOutput(objPerson.QQ)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>所在公司:</b></td> <td><input type="text" name="txtCompany" size="25" class="input" value="<%=CheckStrOutput(objPerson.Company)%>"></td> </tr> </table> <br> <div align="center"> <input type="submit" name="btnOk" value="提交"> <input type="button" name="btnClose" value="关闭" οnclick="javascript:return window.close();"> </div> </form> </BODY> </HTML> <% Set objPerson = Nothing %> |
七、总结
到此,我们的联系信息管理程序就大功告成了。怎么样,感觉如何,应该来说还是相当简单的吧。当然了,这个例程还有许多可以改进的地方,我这里也只不过是抛砖引玉,希望读者在掌握了XML编程之后,自行修改完善吧。
此例程已经在我本机(Windows Server 2000、IIS5.0和IE6.0)和网上进行了测试,都能够正常运行。
<% Option Explicit '*********************************************** ' 说明:通讯录 ' 作者:gwd 2002-11-05 '*********************************************** %> <!--#include file="pub/funcxml.asp"--> <!--#include file="pub/constpub.asp"--> <HTML> <HEAD> <TITLE><% = C_TITLE %></TITLE> <META HTTP-EQUIV="content-type" CONTENT="text/html;charset=GB2312"/> <link rel="stylesheet" href="contact.css" type="text/css"> </HEAD> <BODY> <!--#include file="pub/header.asp"--> <% = FormatXml(C_XMLFILE, C_XSLFILE) %> <br> <!--#include file="pub/footer.asp"--> </BODY> </HTML> |
六、添加、修改和删除XML中的信息
我们知道,在Cls_Person中已经定义了相应的方法,因此,在各个文件中,只需要调用对应的方法即可。添加信息的文件为add.asp,修改信息的文件为edit.asp,删除信息的文件为delete.asp,我们仅以add.asp文件为例进行说明。其中的CheckStrInput和CheckStrOutput函数,用来格式化用户的输入和输出字符串。
<% Option Explicit '*********************************************** ' 说明:37080308通讯录 ' 作者:gwd 2002-11-05 '*********************************************** %> <!--#include file="pub/funcxml.asp"--> <!--#include file="pub/constpub.asp"--> <!--#include file="pub/funcpub.asp"--> <!--#include file="pub/class/clsPerson.asp"--> <% Dim objXml, objPerson Dim strErr Set objXml = Server.CreateObject("MSXML2.DOMDocument") Set objPerson = New Cls_Person ' 生成Cls_Person对象 If Request.Form("btnOk") <> "" Then If LoadXmlDoc(objXml, C_XMLFILE, False, strErr) Then ' 装载XML文件 ' 给相应的属性赋值 objPerson.Name = CheckStrInput(Request.Form("txtName")) objPerson.Nick = CheckStrInput(Request.Form("txtNick")) objPerson.Mobile = CheckStrInput(Request.Form("txtMobile")) objPerson.Tel = CheckStrInput(Request.Form("txtTel")) objPerson.Email = CheckStrInput(Request.Form("txtEmail")) objPerson.QQ = CheckStrInput(Request.Form("txtQQ")) objPerson.Company = CheckStrInput(Request.Form("txtCompany")) If Not objPerson.AddToXml(objXml) Then ' 调用Cls_Person类的AddToXml方法,添加数据 AddErr strErr, objPerson.GetLastError Else AddErr strErr, "添加成功" Response.Write "<script language=""javascript"">opener.location.reload();</script>" End If End If End If Set objXml = Nothing %> <HTML> <HEAD> <TITLE><% = C_TITLE %></TITLE> <META HTTP-EQUIV="content-type" CONTENT="text/html;charset=GB2312"/> <link rel="stylesheet" href="contact.css" type="text/css"> <script language="javascript"> <!-- function CheckForm() { return true; } //--> </script> </HEAD> <BODY> <% = strErr %> <div class="title">添加联系信息</div> <form name="form1" method="post" action="add.asp" οnsubmit="return CheckForm()"> <table align="center" width="100%" cellspacing="1" cellpadding="2" border="0" bgcolor="#666600"> <tr bgcolor="#ffffff"> <td width="25%" bgcolor="#e5e5e5" align="right"><b>姓名:</b></td> <td width="75%"><input type="text" name="txtName" size="25" class="input" value="<%=CheckStrOutput(objPerson.Name)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>英文名:</b></td> <td><input type="text" name="txtNick" size="25" class="input" value="<%=CheckStrOutput(objPerson.Nick)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>手机:</b></td> <td><input type="text" name="txtMobile" size="25" class="input" value="<%=CheckStrOutput(objPerson.Mobile)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>电话:</b></td> <td><input type="text" name="txtTel" size="25" class="input" value="<%=CheckStrOutput(objPerson.Tel)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>Email:</b></td> <td><input type="text" name="txtEmail" size="25" class="input" value="<%=CheckStrOutput(objPerson.Email)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>QQ:</b></td> <td><input type="text" name="txtQQ" size="25" class="input" value="<%=CheckStrOutput(objPerson.QQ)%>"></td> </tr> <tr bgcolor="#ffffff"> <td bgcolor="#e5e5e5" align="right"><b>所在公司:</b></td> <td><input type="text" name="txtCompany" size="25" class="input" value="<%=CheckStrOutput(objPerson.Company)%>"></td> </tr> </table> <br> <div align="center"> <input type="submit" name="btnOk" value="提交"> <input type="button" name="btnClose" value="关闭" οnclick="javascript:return window.close();"> </div> </form> </BODY> </HTML> <% Set objPerson = Nothing %> |
七、总结
到此,我们的联系信息管理程序就大功告成了。怎么样,感觉如何,应该来说还是相当简单的吧。当然了,这个例程还有许多可以改进的地方,我这里也只不过是抛砖引玉,希望读者在掌握了XML编程之后,自行修改完善吧。
此例程已经在我本机(Windows Server 2000、IIS5.0和IE6.0)和网上进行了测试,都能够正常运行。
|