‘’------------------------------------------------------------------------------------
‘’类名：RegistryObject 网页信息注册表类
‘’作者：张少棠 (Tonton)
‘’邮箱：[email protected]
‘’时间：2004年8月1日
‘’说明：模仿WINDOWS中注册表的方式，结合XML与ASP技术，给网站添加一个专用的“注册表”类。
‘’网址：http://blog.csdn.net/tonton/archive/2004/08/01/58198.aspx
‘’版权：读者可以把本程序使用于任何用途，如要刊登、转载，请保留以上版权信息！
‘’------------------------------------------------------------------------------------
Const NODE_ELEMENT = 1
Const NODE_TEXT = 3
Class RegistryObject
Private mDom
Public Path ‘’注册表路径
Public Encoding ‘’注册表编码
Public DefaultValue ‘’在读取键值时，如果子键不存在而返回的默认值
Private Sub Class_Initialize()
DefaultValue = Empty
Encoding = "gb2312"
Set mDom = Nothing
End Sub
Private Sub Class_Terminate()
Set mDom = Nothing
End Sub
Public Function NewDom()
Set NewDom = Server.CreateObject("Microsoft.XMLDOM")
End Function
Private Property Get Dom()
Dim Nde
If mDom Is Nothing Then
Set mDom = NewDom()
mDom.async = False
mDom.Load Path
If mDom.parseError.errorCode = &H800C0006 Then ‘’文件未找到
Initial
ElseIf mDom.parseError <> 0 Then
Exit Property
End If
End If
Set Dom = mDom
End Property
Public Function Initial()
Dim Nde
Set mDom = NewDom()
With mDom
Set Nde = .createProcessingInstruction("xml", "version=‘’1.0‘’ encoding=‘’" & Encoding & "‘’")
.appendChild (Nde)
Set Nde = .createElement("Registry")
.appendChild (Nde)
End With
mDom.Save Path
End Function
Public Function CreateChannel(Channel)
With Dom
Set CreateChannel = .selectSingleNode("//" & Channel)
If CreateChannel Is Nothing Then
Set CreateChannel = .createNode(NODE_ELEMENT, Channel, "")
.documentElement.appendChild (CreateChannel)
.Save Path
End If
End With
End Function
Public Function GetAllChannels()
Dim Result
Dim Nde, i
With Dom
With .documentElement.childNodes
If .length = 0 Then
Result = Split("", 0)
Else
ReDim Result(.length - 1)
For i = 0 To .length - 1
Result(i) = .Item(i).nodeName
Next
End If
End With
End With
GetAllChannels = Result
End Function
Public Function DeleteChannel(Channel)
Dim Selection
With Dom
Set Selection = .selectNodes("//" & Channel)
Selection.RemoveAll
.Save Path
End With
End Function
Public Function CreateSection(Channel, Section)
Dim Nde
With Dom
Set Nde = .selectSingleNode("//" & Channel & "/" & Section)
If Nde Is Nothing Then
Set Nde = .selectSingleNode("//" & Channel)
If Nde Is Nothing Then
Set Nde = .createNode(NODE_ELEMENT, Channel, "")
.documentElement.appendChild (Nde)
End If
Set CreateSection = .createNode(NODE_ELEMENT, Section, "")
Nde.appendChild (CreateSection)
.Save Path
End If
End With
End Function
Public Function GetAllSections(Channel)
Dim Result
Dim Nde, i
With Dom
Set Nde = .selectSingleNode("//" & Channel)
If Not Nde Is Nothing Then
With Nde.childNodes
If .length = 0 Then
Result = Split("", 0)
Else
ReDim Result(.length - 1)
For i = 0 To .length - 1
Result(i) = .Item(i).nodeName
Next
End If
End With
Else
Result = Split("", 0)
End If
End With
GetAllSections = Result
End Function
Public Function ClearAllSections(Channel)
Dim Selection
With Dom
Set Selection = .selectNodes("//" & Channel)
Selection.RemoveAll
.Save Path
End With
End Function
Public Function DeleteSection(Channel, Section)
Dim Selection
With Dom
Set Selection = .selectNodes("//" & Channel & "/" & Section)
Selection.RemoveAll
.Save Path
End With
End Function
Public Function GetAllKeys(Channel, Section)
Dim Result
Dim Nde, i
With Dom
Set Nde = .selectSingleNode("//" & Channel & "/" & Section)
If Not Nde Is Nothing Then
With Nde.childNodes
If .length = 0 Then
Result = Split("", 0)
Else
ReDim Result(.length - 1)
For i = 0 To .length - 1
Result(i) = .Item(i).nodeName
Next
End If
End With
Else
Result=Split("", 0)
End If
End With
GetAllKeys = Result
End Function
Public Sub SaveValue(Channel, Section, Key, Value)
Dim Nde, Nde2, ItemNode
With Dom
Set ItemNode = .selectSingleNode("//" & Channel & "/" & Section & "/" & Key)
If ItemNode Is Nothing Then
Set Nde = .selectSingleNode("//" & Channel)
If Nde Is Nothing Then
Set Nde = .createNode(NODE_ELEMENT, Channel, "")
.documentElement.appendChild (Nde)
End If
Set Nde2 = Nde.selectSingleNode("//" & Section)
If Nde2 Is Nothing Then
Set Nde2 = .createNode(NODE_ELEMENT, Section, "")
Nde.appendChild (Nde2)
End If
Set ItemNode = .createNode(NODE_ELEMENT, Key, "")
Nde2.appendChild (ItemNode)
End If
ItemNode.Text = Value
.Save Path
End With
End Sub
Public Function ReadValue(Channel, Section, Key)
Dim Nde
With Dom
Set Nde = .selectSingleNode("//" & Channel & "/" & Section & "/" & Key)
If Nde Is Nothing Then
ReadValue = DefaultValue
Else
ReadValue = Nde.Text
End If
End With
End Function
Public Function GetAllValues(Channel, Section)
Dim Result
Dim Nde, i
With Dom
Set Nde = .selectSingleNode("//" & Channel & "/" & Section)
If Not Nde Is Nothing Then
With Nde.childNodes
If .length = 0 Then
Result = Split("", 0)
Else
ReDim Result(.length - 1)
For i = 0 To .length - 1
Set Result(i)=New RegistryKey
Result(i).Name=.Item(i).nodeName
Result(i).Value=.Item(i).Text
Next
End If
End With
Else
Result = Split("", 0)
End If
End With
GetAllValues = Result
End Function
End Class
Class RegistryKey
Public Name
Public Value
End Class
%>
文章来源于领测软件测试网 https://www.ltesting.net/
