一个ASP创建动态对象的工厂类（类似PHP的stdClass）
最近整理ASP/VBScript代码，发现过去的一个ASP实现的MVC框架，可惜是个半成品，效率也成问题，不过发现里面有些我写的代码，感觉还稍稍可以拿出来见人，于是今天作此文以记之。
说是ASP，其实和VBScript也脱不了干系，VBScript语言传承于Visual Basic，VB的语法灵活度已经不尽如人意了，VBS作为其子集可想而知。神马反射、自省等先进的技术，微软在.NET中才引入。作为被抛弃的技术，也不奢望微软能够提供支持，于是顽固守旧的程序员只有绞尽脑汁的去模仿实现一些类似的功能。
好吧，我承认很长一段时间我就是顽固守旧派中的一员，今天介绍的就是其中的一项功能，动态创建一个属性对象，属性对象姑且这么称呼，也就是说动态创建的对象只包含属性(Properties)。
下面贴出实现代码供大家参考：
'
' ASP/VBScript Dynamic Object Generator
' Author: WangYe
' For more information please visit
'
' This code is distributed under the BSD license
'
Const PROPERTY_ACCESS_READONLY = 1
Const PROPERTY_ACCESS_WRITEONLY = -1
Const PROPERTY_ACCESS_ALL = 0
Class DynamicObject
Private m_objProperties
Private m_strName
Private Sub Class_Initialize()
Set m_objProperties = CreateObject("Scripting.Dictionary")
m_strName = "AnonymousObject"
End Sub
Private Sub Class_Terminate()
If Not IsObject(m_objProperties) Then
m_objProperties.RemoveAll
End If
Set m_objProperties = Nothing
End Sub
Public Sub setClassName(strName)
m_strName = strName
End Sub
Public Sub add(key, value, access)
m_objProperties.Add key, Array(value, access)
End Sub
Public Sub setValue(key, value, access)
If m_objProperties.Exists(key) Then
m_objProperties.Item(key)(0) = value
m_objProperties.Item(key)(1) = access
Else
add key,value,access
End If
End Sub
Private Function getReadOnlyCode(strKey)
Dim strPrivateName, strPublicGetName
strPrivateName = "m_var" & strKey
strPublicGetName = "get" & strKey
getReadOnlyCode = _
"Public Function " & strPublicGetName & "() :" & _
strPublicGetName & "=" & strPrivateName & " : " & _
"End Function : Public Property Get " & strKey & _
" : " & strKey & "=" & strPrivateName & " : End Property : "
End Function
Private Function getWriteOnlyCode(strKey)
Dim pstr
Dim strPrivateName, strPublicSetName, strParamName
strPrivateName = "m_var" & strKey
strPublicSetName = "set" & strKey
strParamName = "param" & strKey
getWriteOnlyCode = _
"Public Sub " & strPublicSetName & "(" & strParamName & ") :" & _
strPrivateName & "=" & strParamName & " : " & _
"End Sub : Public Property Let " & strKey & "(" & strParamName & ")" & _
" : " & strPrivateName & "=" & strParamName & " : End Property : "
End Function
Private Function parse()
Dim i, Keys, Items
Keys = m_objProperties.Keys
Items = m_objProperties.Items
Dim init, pstr
init = ""
pstr = ""
parse = "Class " & m_strName & " :" & _
"Private Sub Class_Initialize() : "
Dim strPrivateName
For i = 0 To m_objProperties.Count - 1
strPrivateName = "m_var" & Keys(i)
init = init & strPrivateName & "=""" & _
Replace(CStr(Items(i)(0)), """", """""") & """:"
pstr = pstr & "Private " & strPrivateName & " : "
If CInt(Items(i)(1)) > 0 Then ' ReadOnly
pstr = pstr & getReadOnlyCode(Keys(i))
ElseIf CInt(Items(i)(1)) < 0 Then ' WriteOnly
pstr = pstr & getWriteOnlyCode(Keys(i))
Else ' AccessAll
pstr = pstr & getReadOnlyCode(Keys(i)) & _
getWriteOnlyCode(Keys(i))
End If
Next
parse = parse & init & "End Sub : " & pstr & "End Class"
End Function
Public Function getObject()
Call Execute(parse)
Set getObject = Eval("New " & m_strName)
End Function
Public Sub invokeObject(ByRef obj)
Call Execute(parse)
Set obj = Eval("New " & m_strName)
End Sub
End Class
对于属性对象分别提供了Property直接访问模式和set或者get函数访问模式，当然我还提供了三种权限控制，在add方法中使用，分别是PROPERTY_ACCESS_READONLY（属性只读）、PROPERTY_ACCESS_WRITEONLY（属性只写）和PROPERTY_ACCESS_ALL（属性读写），你可以像下面这样使用（一个例子）：
Dim DynObj
Set DynObj = New DynamicObject
DynObj.add "Name", "WangYe", PROPERTY_ACCESS_READONLY
DynObj.add "HomePage", "http://jb51.net", PROPERTY_ACCESS_READONLY
DynObj.add "Job", "Programmer", PROPERTY_ACCESS_ALL
'
' 如果没有setClassName，
' 新创建的对象将会自动命名为AnonymousObject
' 但是如果创建多个对象，就必须指定名称
' 否则就可能引起对象名重复的异常
DynObj.setClassName "User"
Dim User
Set User = DynObj.GetObject()
' 或者 DynObj.invokeObject User
Response.Write User.Name
' Response.Write User.getName()
Response.Write User.HomePage
' Response.Write User.getHomePage()
Response.Write User.Job
' Response.Write User.getJob()
' 改变属性值
User.Job = "Engineer"
' User.setJob "Engineer"
Response.Write User.getJob()
Set User = Nothing
Set DynObj = Nothing
以上是 一个ASP创建动态对象的工厂类（类似PHP的stdClass） 的全部内容， 来源链接： utcz.com/z/330620.html
