ASP将XML模拟为RS的类
XML是个很好的东西，ASP本身很弱，但配合上一些强大的服务器对象，几乎可以无所不能。就比如我之前遇到的问题，ASP base64编码和解码，原生函数出来的结果总是有误差，但使用XML对象上的功能，就完美地解决问题了。
还有二进制内容的生成，ASP本身也是无法实现的(只能读取)。XML的很多优势，用在ASP中给ASP的效率和优美度都增添了光彩。
但这一次，我却想把XML模拟成ASP中另外的一个强大的对象 Recordset
对了，ASP缺了ADODB组件，基本上就瘫痪了。ADODB中的connection,recordset,stream都是ASP离不开的对象。深入查看下手册，会发现很多有用的东西。
下面这个，我就想把XML的读取，写入，筛选机制模拟成Recordset来操作。虽然功能上不是很理想，但基本操作流程都走通了。
这个XML用来作数据缓存很不错
本代码同步发表在开源中国:将XML数据模拟成Recordset对象的类
测试截图：
先帖测试代码(里面假定打开了一个数据库连接,conn，并有一个分类表news_class)：
Dim Rs, tmp, i
Set Rs=New xmlRs
'Set tmp=Server.Create0bject("MSXML.DOMDocument")
'tmp.async=False
'tmp.load(Server.MapPath("/cache/News/newsclass.xml"))
'从DOMList打开
'Rs.Open tmp.documentElement.childNodes,True
'从记录集打开
'如果要直接保存xml文件，必须先指定路径
Rs.Path="a.xml"
Rs.Open conn.Ｅxecute("SELECT * FROM news_class"),True
'从文件打开
'Rs.Open "class.xml",True
Rs.Find "id>0"
Response.Write "本次查询到的记录数:"
Response.Write rs.Count&"<br />"
'注意.xpath中不可使用 <> 表示不等于,只能用 !=
'xPath运算符:http://www.w3school.com.cn/xpath/xpath_operators.asp
Dim startTime
startTime = Timer
For i = 0 To 100
Rs.Ｅxec "SELECT * FROM table WHERE Id>0 AND className!='22' And lang='cn'"
Next
Response.Write "100次查询所耗时间："& CCur(Timer - startTime)&" s<br />"
startTime = Timer
For i = 0 To 100
Rs.Ｅxec "SELECT * FROM table WHERE Id>0 AND className!='22' And lang='cn' Order by classname asc, ID DESC"
Next
Response.Write "100次查询排序所耗时间："& CCur(Timer - startTime)&" s<br />"
Response.Write "本次查询到的记录数:"
Response.Write rs.Count&"<br />"
'删除该行
'Rs.Delete
'Rs.Update
'call FindTest( rs)
'call OrderTest( rs)
call ReadTest( rs)
'call WriteTest( rs)
'call UpdateTest( rs)
'call ReadTest( rs)
'//=======测试函数==================//
Sub FindTest( rs)
Rs.Find "id>=2"
End Sub
Sub OrderTest( rs)
Rs.Order "id desc,classname desc"
End Sub
Sub ReadTest( rs)
rs.MoveFirst
Do Until Rs.EOF
Response.Write Rs("id")&";"
Response.Write Rs("classname")&";"
Response.Write Rs("enname")
Response.Write "<br />"
Rs.MoveNext
Loop
End Sub
Sub WriteTest( rs)
Dim i
i=0
Response.Write Rs.RecordCount &"<br />"
rs.MoveFirst
Do Until Rs.EOF
i = i + 1
Response.Write "原值："
Response.Write Rs("id")&";"
Response.Write Rs("classname")&";"
Response.Write Rs("enname")
Response.Write "<br />"
Rs("id") = i
Rs("classname") = Rs("classname") & i
Rs("enname") = Rs("enname") &i
Response.Write "新值："
Response.Write Rs("id")&";"
Response.Write Rs("classname")&";"
Response.Write Rs("enname")
Response.Write "<br />"
Rs.MoveNext
Loop
Rs.Update
End Sub
Sub UpdateTest( rs)
Rs.Ｅxec "UPDATE [TABLE] SET [id]=1 , [classname]=222,[enname]='<我是 , 一个兵>'"
End Sub
Sub InsertTest( rs)
Rs.Ｅxec "INSERT INTO [TABLE] ([id],[classname],[enname]) VALUES(1,'as''dddd','asd<>asdn')"
End Sub
'//=======测试函数 END==============//
下面是类原码(友情提示：代码中部分字符作了替换，使用时需要替换回原英文字符，原因是服务器有特殊字符过滤)
'====================================
' 类名: xmlRs
' 用途: 将XML数据模拟成Rs数据操作
' 作者: shirne
' 网址: http://www.shirne.com
' 说明: 操作完成调用update才可以更新到文件
' 1.字段筛选的功能暂未实现
' 2.排序效率不太好，一般不要用
' 3.更新或插入语句中只支持简单赋值
' 更新: 2012/12/20
'====================================
Class xmlRs
Private DOM 'XML文档对象
Private DOMList '数据列表
Private pPosition '指针位置
Private pCount '记录数
Private pBOF '是否超出开始
Private pEOF '是否超出结尾
Private pState '状态
Private pPath '对应的文件路径
Private xPath '查询条件的xPath格式
Public IDStr '创建的DOM类型,默认为MSXML2.DOMDocument,可以设定为其它类型
Public DBName '根节点的名称
Public TblName '行节点的名称
Public Charset '编码
Public currentNode '当前节点,如果调用了AddNew,则是新创建的节点
Private Field '字段(一个XML节点对象)
Private ph '字符串占位符
Public SQLMode 'SQL语句解析模式(True 严格解析)
Private Sub Class_Initialize
pCount = 0
pBOF = True
pEOF = True
pState = 0
pPosition= 0
DBName = "data"
TblName = "table"
Charset = "utf-8"
ph = Chr(0)
SQLMode= True
xPath = ""
'MSXML3.DOMDocument
'MSXML2.FreeThreadedDOMDocument
IDStr = "MSXML2.DOMDocument"
End Sub
Private Sub Class_Terminate
Set DOM=Nothing
Set currentNode=Nothing
If IsArray(DOMList) Then Erase DOMList
End Sub
'xml对象或路径,是否创建文件
Public Function Open(xml, create)
Set DOM = Server.Create0bject(IDStr)
DOM.async = False
Select Case TypeName(xml)
Case "String"
If InStr(xml,"<")>0 Then
If Not DOM.LoadXML(xml) Then
ErrRaise 5,"xmlRs.Open:错误的XML代码"
End If
Else
Path = xml
If Not DOM.Load(pPath) Then
If create Then
DOM.LoadXML("<?xml version=""1.0"" encoding="""& Charset &"""?><"& DBName &" />")
Else
ErrRaise 5,"xmlRs.Open:错误的文件路径"
End If
Else
create=False '从文件打开的,不用再次保存
End If
End If
Call setList
Case "DOMDocument"
Set DOM = xml
Call setList
Case "IXMLDOMElement"
DOM.LoadXML("<?xml version=""1.0"" encoding="""& Charset &"""?><"& DBName &" />")
DOM.documentElement.appendChild(xml)
Call setList
Case "IXMLDOMNodeList"
DOM.LoadXML("<?xml version=""1.0"" encoding="""& Charset &"""?><"& DBName &" />")
DOM.documentElement.appendChild(xml)
Call setList
Case "Recordset"
DOM.LoadXML("<?xml version=""1.0"" encoding="""& Charset &"""?><"& DBName &" />")
Call DataToXML(xml)
Case Else
ErrRaise 5,"xmlRs.Open:不支持的初始化数据类型:"& TypeName(xml)
End Select
If create Then
Call Update
End If
Call setProp
pState = 1
If pCount>0 Then TblName = currentNode.nodeName
End Function
'//获取和设置字段值,一律转换为小写
Public Default Property Get Item(key)
If pBOF Or pEOF Then Exit Property
Set Field=currentNode.selectSingleNode(LCase(key))
If Field Is Nothing Then
Item = Empty
Else
Item = Field.Text
End If
End Property
Public Property Let Item(key, val)
If pBOF Or pEOF Then Exit Property
Set Field=currentNode.selectSingleNode(LCase(key))
If Field Is Nothing Then
Set Field = DOM.createElement(LCase(key))
currentNode.appendChild(Field)
End If
If Not IsNull(val) Then
Field.Text = CStr(val)
End If
End Property
'//是否到达头部或尾部
Public Property Get BOF
BOF = pBOF
End Property
Public Property Get EOF
EOF = pEOF
End Property
'//获取和设定路径
Public Property Get Path
Path = pPath
End Property
Public Property Let Path(val)
If InStr(val,":")<1 Then
val = Server.MapPath(val)
End If
pPath = val
End Property
'//状态
Public Property Get State
State = pState
End Property
'//获取记录数
Public Property Get Count
Count = pCount
End Property
'//别名
Public Property Get RecordCount
RecordCount = pCount
End Property
'//获取记录集位置
Public Property Get Position
Position = pPosition
End Property
'//别名
Public Property Get AbsolutePosition
AbsolutePosition = pPosition
End Property
'//设置记录集位置
Public Property Let Position(val)
If val>0 And val<=pCount Then
pPosition = val
Set currentNode=DOMList(pPosition-1)
If pEOF Then
pEOF = False
End If
If pBOF Then
pBOF = False
End If
Else
ErrRaise 9,"xmlRs.Position:超出记录集"
End If
End Property
'//别名
Public Property Let AbsolutePosition(val)
Position = val
End Property
'//移动指定的行数
Public Sub Move( iNum)
If pBOF And iNum<0 Then
ErrRaise 5,"xmlRs.Move:指针已经超出记录头"
End If
If pEOF And iNum>0 Then
ErrRaise 5,"xmlRs.Move:指针已经超出记录尾"
End If
If iNum=0 Then Exit Sub
pPosition = pPosition+iNum
Call ChkProp
End Sub
'//移动到第一条记录
Public Sub MoveFirst
If pCount>0 Then pPosition = 1
Call ChkProp
End Sub
'//移动到最后一条记录
Public Sub MoveLast
pPosition = pCount
Call ChkProp
End Sub
'//移动到前一条记录
Public Sub MovePrevious
If pBOF=False Then
pPosition = pPosition-1
End If
Call ChkProp
End Sub
'//移动到下一条记录
Public Sub MoveNext
If pEOF=False Then
pPosition = pPosition+1
End If
Call ChkProp
End Sub
'//添加一条新的记录
Public Sub AddNew
Set currentNode = DOM.createElement(TblName)
DOM.documentElement.appendChild(currentNode)
pCount = pCount + 1
pPosition = pCount
pBOF = False
pEOF = False
End Sub
'//保存,对于已经指定路径的xml文件
Public Sub Update
If pPath = "" Then ErrRaise 5,"xmlRs.Update:路径设定不正确"
DOM.Save pPath
End Sub
'//可以指定路径保存
Public Sub Save( savePath)
If savePath<>"" Then Path = savePath
Call Update
End Sub
Public Function DataToXML( rs)
If rs.State<>1 Then ErrRaise 5,"xmlRs.DataToXML:记录集尚未打开"
Dim f
Do Until rs.EOF
AddNew
For Each f In rs.Fields
Item(f.Name) = f.Value
Next
rs.MoveNext
Loop
pPosition = 1
Call setList
End Function
'//执行sql
Public Function Ｅxec( sql)
Dim objSQL, j
Set objSQL = SplitSQL(sql, SQLMode)
If objSQL("table")<>"" Then TblName = objSQL("table")
'测试分解后的sql
' Dim Fld,j
' For Each Fld In objSQL
' If IsArray(objSQL(Fld)) Then
' Response.Write Fld&":"
' For j=0 To UBound(objSQL(Fld))
' Response.Write objSQL(Fld)(j)&";"
' Next
' Response.Write "<br />"
' Else
' Response.Write Fld&":"& objSQL(Fld)&"<br />"
' End If
' Next
Select Case LCase(objSQL("type"))
Case "select"
Find objSQL("where")
Order objSQL("order")
Case "update"
Find objSQL("where")
Do Until pEOF
For j=0 To UBound(objSQL("field"))
Item(objSQL("field")(j))=objSQL("value")(j)
Next
MoveNext
Loop
Update
Case "insert"
AddNew
For j=0 To UBound(objSQL("field"))
Item(objSQL("field")(j))=objSQL("value")(j)
Next
Update
Case "delete"
Find objSQL("where")
Do Until pEOF
Call Delete
MoveNext
Loop
Case Else
ErrRaise 5,"xmlRs.Exec:SQL语句类型不正确"
End Select
End Function
'//查找,使用xPath原生方法查找,所以where语句仅支持xPath语法
Public Sub Find( wre)
If wre<>"" Then
xPath = "/"& DBName &"/"& TblName &"["& wre &"]"
Else
xPath = ""
End If
Call setList
Call setProp
End Sub
'//对结果进行排序,支持多个字段
Public Sub Order( odr)
If pCount<2 Then Exit Sub
If odr = "" Then Exit Sub
Dim prevVal, arrSort, i
If InStr(odr,"[")>0 Then
odr = Replace(Replace(odr,"[",""),"]","")
End If
arrSort = Split(odr,",")
'开始排序
'主排序
Dim sField, subField, objA, objB, a,b,j,k
sField = Split(Trim(arrSort(0))," ")
If UBound(sField)<1 Then
ReDim Preserve sField(1)
sField(1) = "ASC"
Else
sField(1) = UCase(sField(1))
End If
'字段名转换为小写
sField(0) = LCase(sField(0))
For j=0 To pCount-1
For k=j+1 To pCount-1
Set objA = DOMList(j).selectSingleNode(sField(0))
Set objB = DOMList(k).selectSingleNode(sField(0))
If objA Is Nothing Then
a = "0"
Else
a = objA.Text
End If
If objB Is Nothing Then
b = "0"
Else
b = objB.Text
End If
Select Case Compare(a,b)
Case 1
If sField(1) = "ASC" Then
Call Swap(j,k)
End If
Case -1
If sField(1) = "DESC" Then
Call Swap(j,k)
End If
Case 0
'主排序相等时启动副排序
For i=1 To UBound(arrSort)
If IsArray(arrSort(i))=False Then
subField = Split(arrSort(i)," ")
If UBound(subField)<1 Then
ReDim Preserve subField(1)
subField(1) = "ASC"
Else
subField(1) = UCase(subField(1))
End If
'字段名转换为小写
subField(0) = LCase(subField(0))
arrSort(i) = subField
End If
subField = arrSort(i)
Set objA = DOMList(j).selectSingleNode(subField(0))
Set objB = DOMList(k).selectSingleNode(subField(0))
If objA Is Nothing Then
a = "0"
Else
a = objA.Text
End If
If objB Is Nothing Then
b = "0"
Else
b = objB.Text
End If
'副排序有结果则退出，无则进行下一轮副排序
Select Case Compare(a,b)
Case 1
If subField(1) = "ASC" Then
Call Swap(j,k)
End If
Exit For
Case -1
If subField(1) = "DESC" Then
Call Swap(j,k)
End If
Exit For
End Select
Next
End Select
Next
Next
'重设属性
Call setProp
End Sub
Public Sub Delete
If pBOF Or pEOF Then Exit Sub
DOM.documentElement.removeChild(currentNode)
Call setList
Call setProp
End Sub
'解析SQL语句
'Param:sql 要解析的sql语句
'Param:sMode 是否执行严格解析,暂未支持
'允许有字符串的位置: 更新的值中
Public Function SplitSQL( oSql, sMode)
Dim L, i, ii, iA, iB, Rst, sql
oSql = Trim(oSql)
'清除与占位符冲突的字符,这里使用了两种占位符
If InStr(oSql,ph) Then oSql = Replace(oSql,ph,"")
If InStr(oSql,Chr(1)) Then oSql = Replace(oSql,Chr(1),"")
L = Len(oSql)
sql = oSql
If L < 6 Then ErrRaise 5,"xmlRs.SplitSQL:SQL语句错误"
Set Rst = Server.Create0bject("Scripting.Dictionary")
Rst.CompareMode = 1
'严格模式下将字符串替换为占位符
If sMode Then
For i=1 To L
i = InStr(i,sql,"'")
If i>0 Then
ii = InStr(i+1,sql,"'")
Do Until Mid(sql,ii+1,1)<>"'"
ii = InStr(ii+2,sql,"'")
If ii<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误:"& Mid(oSql,i,20)
End If
Loop
sql = Left(sql, i) & String(ii-i-1,ph) & Mid(sql, ii)
i = ii
Else
Exit For
End If
Next
End If
'//规范化sql 去除多余空格，去除,两边的空格
'//严格模式下不会影响字符串中的内容
Call ClearSQL(sql, oSql)
L = Len(sql)
Rst.Add "type",Left(oSql,InStr(oSql," ")-1)
'查找各关键字的位置
Dim iTop, iWhere, iOrder, iSet, iValue, iTmp, iEnd, iFrom, iInto
'//前面加一个空格防止字段名有相同的(字段名是关键字就用[top])
iTop = InStr(1,sql," top",1)
iSet = InStr(1,sql," set",1)
iValue=InStr(1,sql," values",1)
iWhere=InStr(1,sql," where",1)
iOrder=InStr(1,sql," order by",1)
iFrom =InStr(1,sql," from",1)
iInto = InStr(1,sql," into",1)
Dim strFld, strVal, arrVal, iVal
Select Case LCase(Rst("type"))
Case "select"
If iTop>0 Then
iTmp = InStr(sql,iTop+4," ")
iEnd = InStr(iTmp+1,sql," ")
If iTmp<1 Or iEnd<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iTop,40) &" 附近有语法错误"
End If
Rst.Add "top",Mid(oSql,iTop+4,iTmp-iTop-4)
Rst.Add "field",Mid(oSql,iTmp,iEnd-iTmp)
Else
iTmp = InStr(sql," ")+1
iEnd = InStr(iTmp+1,sql," ")
Rst.Add "field",Mid(oSql,iTmp,iEnd-iTmp)
End If
Rst.Add "table",Mid(oSql,iFrom+6,InStr(iFrom+6,sql," ")-iFrom-6)
Case "update"
Rst.Add "table",Mid(oSql,8,InStr(8,sql," ")-8)
If iSet<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,1,30) &" 缺少 SET"
End If
'取出字段及值
If iWhere>0 Then
arrVal = Split(Mid(sql, iSet+5,iWhere-iSet-5),",")
strVal = Mid(oSql, iSet+5,iWhere-iSet-5)
Else
arrVal = Split(Mid(sql, iSet+5),",")
strVal = Mid(oSql, iSet+5)
End If
Dim iEqal
iTmp = 1
For iVal=0 To UBound(arrVal)
iEnd = Len(arrVal(iVal))
arrVal(iVal)=Mid(strVal,iTmp,iEnd)
iTmp = iTmp + iEnd + 1
iEqal = InStr(arrVal(iVal),"=")
If iEqal<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(arrVal(iVal),1,30) &" 缺少 ="
End If
strFld = strFld& Mid(arrVal(iVal), 1, iEqal-1) & ","
arrVal(iVal)=Mid(arrVal(iVal),iEqal+1)
If InStr(arrVal(iVal),"'")=1 Then
arrVal(iVal)=Mid(arrVal(iVal),2,Len(arrVal(iVal))-2)
If InStr(arrVal(iVal),"''")>0 Then
arrVal(iVal) = Replace(arrVal(iVal),"''","'")
End If
End If
Next
strFld = Left(strFld,Len(strFld)-1)
If InStr(strFld,"[")>0 Then strFld=Replace(Replace(strFld,"[",""),"]","")
Rst.Add "field",Split(strFld,",")
Rst.Add "value",arrVal
Case "insert"
'取出表名
If iInto<1 Then ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,1,30) &" 缺少 INTO"
iTmp = InStr(iInto+6,sql,"(")
If iTmp<1 Then ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iInto,30) &" 缺少 “(“ "
Rst.Add "table",Mid(oSql,iInto+6,iTmp-iInto-6)
'取出字段列表
iEnd = InStr(iTmp+2, sql, ")")
If iEnd<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iInto+6,30) &" 缺少 “)”"
End If
strFld = Mid(sql,iTmp+1,iEnd-iTmp-1)
If InStr(strFld,"[")>0 Then strFld=Replace(Replace(strFld,"[",""),"]","")
Rst.Add "field",Split(strFld,",")
'取出值列表
If iValue<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iEnd,30) &" 缺少 “VALUES”"
End If
iTmp = InStr(iValue, sql, "(")
iEnd = InStr(iTmp, sql, ")")
If iTmp<1 Or iEnd<1 Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iValue,30) &" 缺少 “(” 或 “)”"
End If
strVal = Mid(oSql, iTmp+1, iEnd-iTmp-1)
arrVal = Split(Mid(sql, iTmp+1, iEnd-iTmp-1),",")
If UBound(arrVal)<>UBound(Rst("field")) Then
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iTmp,30) &" 字段与值不对应"
End If
iTmp = 1
For iVal=0 To UBound(arrVal)
iEnd = Len(arrVal(iVal))
arrVal(iVal)=Mid(strVal,iTmp,iEnd)
iTmp = iTmp + iEnd + 1
If InStr(arrVal(iVal),"'")=1 Then
arrVal(iVal)=Mid(arrVal(iVal),2,Len(arrVal(iVal))-2)
If InStr(arrVal(iVal),"''")>0 Then
arrVal(iVal) = Replace(arrVal(iVal),"''","'")
End If
End If
Next
Rst.Add "value",arrVal
Case "delete"
If iFrom<1 Then ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,1,30) &" 缺少 FROM"
iTmp = InStr(iFrom+6,sql," ")
If iTmp<1 Then ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,"& Mid(oSql,iFrom,30) &" 附近有语法错误"
Rst.Add "table",Mid(oSql,iFrom+6,iTmp-iFrom-6)
Case Else
ErrRaise 5,"xmlRs.SplitSQL:SQL语句语法错误,错误的操作类型:"& Rst("type")
End Select
If InStr(Rst("table"),"[")=1 Then
Rst("table") = Mid(Rst("table"),2,Len(Rst("table"))-2)
End If
If iWhere>0 Then
If iOrder>0 Then
strFld = Mid(sql, iWhere + 7, iOrder - iWhere - 7)
strVal = Mid(oSql, iWhere + 7, iOrder - iWhere - 7)
Else
strFld = Mid(sql, iWhere + 7)
strVal = Mid(oSql, iWhere + 7)
End If
'兼容sql中的不等号
If InStr(strFld,"<>")>0 Then strFld = Replace(strFld,"<>","!=")
'主要是将字段名转换为小写
strFld = LCase(strFld)
iTmp = InStr(strFld,ph)
If iTmp>0 Then
Do Until iTmp<1
iEnd = InStr(iTmp,strFld,"'")
iVal = Mid(strVal,iTmp,iEnd-iTmp)
strFld = Left(strFld,iTmp-1) & Replace(strFld,Mid(strFld,iTmp,iEnd-iTmp),iVal,iTmp,1,0)
iTmp = InStr(iEnd,strFld,ph)
Loop
End If
Rst.Add "where",strFld
End If
If iOrder>0 Then
'排序的规则化将在排序功能内实现,这里只作取出
Rst.Add "order",Mid(sql, iOrder + 9)
End If
Set SplitSQL = Rst
End Function
Private Sub ClearSQL(sql, osql)
Dim Re, mth, m, l, v, i
Set Re = New RegExp
Re.Global = True
'清除多余空格
Re.Pattern = "\s+"
Set mth = Re.Ｅxecute(sql)
For Each m In mth
v = m.Value
i = m.FirstIndex
l = m.Length
If v<>" " Then
sql = Left(sql,i-1) & Replace(sql,v,String(l,Chr(1)),i,1,0)
osql = Left(osql,i-1) & Replace(oSql,v,String(l,Chr(1)),i,1,0)
End If
Next
Re.Pattern = "[\x01]+"
sql = Re.Replace(sql," ")
osql = Re.Replace(osql," ")
'清除逗号两边的空格
Re.Pattern = "\s*,\s*"
Set mth = Re.Ｅxecute(sql)
For Each m In mth
v = m.Value
i = m.FirstIndex
l = m.Length
If v<>" " Then
sql = Left(sql,i-1) & Replace(sql,v,String(l,Chr(1)),i,1,0)
osql = Left(osql,i-1) & Replace(oSql,v,String(l,Chr(1)),i,1,0)
End If
Next
Re.Pattern = "[\x01]+"
sql = Re.Replace(sql,",")
osql = Re.Replace(osql,",")
End Sub
'重新设定属性值
Private Sub setProp
If pCount>0 Then
pEOF = False
pBOF = False
If pPosition<1 Then
pPosition=1
ElseIf pPosition>pCount Then
pPosition=pCount
End If
Set currentNode=DOMList(pPosition-1)
Else
pEOF = True
pBOF = True
pPosition=0
Set currentNode=Nothing
End If
End Sub
'检查属性
Private Sub ChkProp
If pPosition<1 Then
pBOF = True
ElseIf pPosition>pCount Then
pEOF = True
Else
pBOF = False
pEOF = False
Set currentNode=DOMList(pPosition-1)
End If
End Sub
Private Sub setList
Dim DL, i
If xPath<>"" Then
Set DL = DOM.documentElement.selectNodes(xPath)
Else
Set DL = DOM.documentElement.childNodes
End If
pCount = DL.length
ReDim DOMList(pCount-1)
For i=0 To DL.length-1
Set DOMList(i) = DL(i)
Next
End Sub
'交换,用于排序
Private Sub Swap(a, b)
Dim tmp
Set tmp = DOMList(a)
Set DOMList(a) = DOMList(b)
Set DOMList(b) = tmp
End Sub
'比较,用于排序
Private Function Compare(a, b)
Compare = 0
If IsNumeric(a) And IsNumeric(b) Then
If CDbl(a)>CDbl(b) Then
Compare = 1
ElseIf CDbl(a)<CDbl(b) Then
Compare = -1
End If
ElseIf IsBool(a) And IsBool(b) Then
If a And Not b Then
Compare = 1
ElseIf b And Not a Then
Compare = -1
End If
Else
Compare = StrComp(a,b,1)
End If
End Function
'判断是否布尔值,并进行转换
Private Function IsBool(v)
IsBool = False
If StrComp(v,"true",1)=0 Then
v = True
IsBool = True
ElseIf StrComp(v,"false",1)=0 Then
v = False
IsBool = True
End If
End Function
Private Sub ErrRaise(code, Desc)
Err.Raise code, Desc
'Response.End()
End Sub
End Class 
豫公网安备 41112102000155号