一个ASP创建动态对象的工厂类（类似PHP的stdClass）

2024-10-03 09:52:52

最近整理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

其原理很简单，就是通过给定的Key-Value动态生成VBS Class脚本代码，然后调用Execute执行以便于将这段代码加入到代码上下文流中，最后再通过Eval新建这个对象。

好了，就介绍到这里，今后我可能还会陆续公开一些Classic ASP的相关技巧代码。

2012年11月7日更新

修复从旧项目移植过来导致的BUG。

修复了一些Bug增加了一些特性，我先把最新的代码贴出来供大家参考：

代码如下:

'
' ASP/VBScript Dynamic Object Generator
' Author: WangYe
' For more information please visit
'
' This code is distributed under the BSD license
'
' UPDATE:
'   2012/11/7
'       1. Add variable key validator.
'       2. Add hasattr_ property for determine
'          if the property exists.
'       3. Add getattr_ property for get property
'          value safety.
'       4. Class name can be accessed by ClassName_ property.
'       5. Fixed some issues.
'
Const PROPERTY_ACCESS_READONLY = 1
Const PROPERTY_ACCESS_WRITEONLY = -1
Const PROPERTY_ACCESS_ALL = 0

Class DynamicObject
    Private m_objProperties
    Private m_strName
    Private m_objRegExp

Private Sub Class_Initialize()
        Set m_objProperties = CreateObject("Scripting.Dictionary")
        Set m_objRegExp = New RegExp
            m_objRegExp.IgnoreCase = True
            m_objRegExp.Global = False
            m_objRegExp.Pattern = "^[a-z][a-z0-9]*$"
        m_strName = "AnonymousObject"
        m_objProperties.Add "ClassName_", _
            Array(m_strName, PROPERTY_ACCESS_READONLY)
    End Sub

Private Sub Class_Terminate()
        Set m_objRegExp = Nothing
        If IsObject(m_objProperties) Then
            m_objProperties.RemoveAll
        End If
        Set m_objProperties = Nothing
    End Sub

Public Sub setClassName(strName)
        If Not m_objRegExp.Test(strName) Then
            ' Skipped Invalid Class Name
            ' Raise
            Exit Sub
        End If
        m_strName = strName
        m_objProperties("ClassName_") = _
            Array(m_strName, PROPERTY_ACCESS_READONLY)
    End Sub

Public Sub add(key, value, access)
        If Not m_objRegExp.Test(key) Then
            ' Skipped Invalid key
            ' Raise
            Exit Sub
        End If
        If key = "hasattr_" Then key = "hasattr__"
        If key = "ClassName_" Then key = "ClassName__"
        'Response.Write key
        m_objProperties.Add key, Array(value, access)
    End Sub

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, strAvailableKeys

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 & " : "
            strAvailableKeys = strAvailableKeys & Keys(i) & ","
            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

init = init & "m_strAvailableKeys = Replace(""," & _
                strAvailableKeys & """, "" "", """") : "
        Dim hasstmt
        hasstmt = "Private m_strAvailableKeys : " & _
                  "Public Function hasattr_(ByVal key) : " & _
                  "hasattr_ = CBool(InStr(m_strAvailableKeys," & _
                  " "","" & key & "","") > 0) : " & _
                  "End Function : " & _
                  "Public Function getattr_(ByVal key, ByVal defaultValue) : " & _
                  "If hasattr_(key) Then : getattr_ = Eval(key) : " & _
                  "Else : getattr_ = defaultValue : End If : " & _
                  "End Function : "

parse = parse & init & "End Sub : " & _
hasstmt & pstr & "End Class"
End Function

Public Function getObject()
        'Response.Write parse
        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

需要注意的几个新特性：

1. 增加了类名和属性名验证措施，防止畸形的类名或者属性名导致动态生成的代码出现语法错误。不过处理的方式是直接忽略，本来想Raise异常的，但考虑到VBS对异常处理不是很好的，所以采取忽略策略：

' 有效的类名或属性名必须以字母开头

代码如下:

Dim DynObj
Set DynObj = New DynamicObject
    DynObj.setClassName "1User" ' 此句将被忽略，因为类名不能以数字开始
    ' 下面这句也会被忽略，因为属性名不能以特殊符号开始
    DynObj.add "%Name", "WangYe", PROPERTY_ACCESS_READONLY
Set DynObj = Nothing

2. 对于动态对象增加了hasattr_方法，该属性用于检测此对象是否支持相应的属性，可以在访问一个属性前先确定该对象是否支持此属性：

代码如下:

Dim DynObj
Set DynObj = New DynamicObject
DynObj.add "Name", "WangYe", PROPERTY_ACCESS_READONLY

Response.Write DynObj.hasattr_("Name") ' True
Response.Write DynObj.hasattr_("Favor") ' False

Set DynObj = Nothing

3. 对于动态对象增加了getattr_方法，此方法可以安全的获取指定的属性值，避免因为对象不存在属性值导致出错。方法原型为getattr_(ByVal propertyName, ByVal defaultValue)，参数propertyName指定属性的名字，defaultValue是当指定属性不存在是可以返回的默认值，比如下面代码：

代码如下:

Dim DynObj
Set DynObj = New DynamicObject
DynObj.add "Name", "WangYe", PROPERTY_ACCESS_READONLY

Response.Write DynObj.getattr_("Name", "N/A") ' WangYe
Response.Write DynObj.getattr_("Favor", "N/A") ' N/A

Set DynObj = Nothing

4. 动态对象的类名可以通过ClassName_属性或者getClassName_()方法获取。

2012年11月12日更新

修复双引号导致构造类错误或导致执行任意代码的Bug。

php运行时动态创建函数的方法

本文实例讲述了php运行时动态创建函数的方法.分享给大家供大家参考.具体分析如下: 一般的语言函数必须定义了在运行,而php支持在运行时动态创建函数,下面是一个简单的范例,在运动时根据不同的条件创建函数$a <?php if (count($_POST) > 0) { $prepped = create_function('$a', 'return trim($_POST[$a]);'); } elseif (count($_GET) > 0) { $prepped = create_f
如何使用动态共享对象的模式来安装PHP

PHP 通常被安装在 Linux/Unix 操作系统上,并且搭配 Apache 服务器一起使用.在将 PHP 与 Apache 服务器一起安装的时候,你有三种不同的安装方式可以选择:静态模块,动态共享对象(Dynamic Shared Object, DSO)以及 CGI 程序执行文件. 在这里我建议大家使用动态共享对象的模式来安装 PHP,这是因为这种安装方式为日后的维护与升级提供了极大的便利.假设你一开始安装 PHP 的时候,只加入了PHP 的数据库相关模块.几天以后你决定再加装 PHP 的
PHP使用GIFEncoder类生成的GIF动态图片验证码

相信很多人都想过如何用PHP生成GIF动画来实现动态图片验证码,以下是实现过程. ImageCode函数通过GIFEncoder类实现的GIF动画的PHP源代码,有兴趣的朋友可以研究一下. 效果如图: 复制代码代码如下: /** * ImageCode 生成GIF图片验证 * @param $string 字符串 * @param $width 宽度 * @param $height 高度 * */ function ImageCode($string = '', $w
PHP使用GIFEncoder类生成gif动态滚动字幕

今天在公司,经理让做一个滚动字幕.但是,不许生成gif图片.所以上网找了GIFEncoder这个类库.确实很好用,但是,应用过程中也出现了一些问题,现在写在这里,以供后来人参考,少走弯路. 文字滚动分为两种情况.第一种为水平滚动: 复制代码代码如下: <?php require_once("GIFEncoder.class.php"); $count=0; //设置默认计数器 while(true){ $str = $_REQUEST['str'] ? $_REQU
PHP动态地创建属性和方法, 对象的复制, 对象的比较,加载指定的文件,自动加载类文件,命名空间

PHP前言: •动态地创建属性和方法 •对象的复制 •对象的比较 •加载指定的文件 •自动加载类文件 •命名空间示例 1.类的相关知识点 3(动态地创建属性和方法) class/class3.php <?php /** * 类的相关知识点 3(动态地创建属性和方法) */ // 用于演示如何动态地创建属性(这就是 php 中所谓的重载) class Class1 { // __set 魔术方法,当设置的属性不存在或者不可访问(private)时就会调用此函数 public function _
PHP使用方法重载实现动态创建属性的get和set方法

在PHP中,我们不能够直接通过方法名相同,签名不同的方法来实现方法重载,因为PHP是弱数据类型,不能很好的区分签名.但是,可以在PHP的类中运用__call()方法来实现方法重载.当调用一个类中并不存在的方法时,会自动调用__call()方法,其形式为__call($name,$arguments) 其中$name是方法的名称,$arguments是一个数组类型的参数. 下面的例子是使用PHP的方法重载来动态创建get和set方法.(在面向对象编程中,一个类中的属性会使用get和set来赋值,但
PHP动态创建Web站点的方法

PHP有4个用于使用外部函数的函数:include().include_once().require()和require_once(). 为了使用它们,PHP脚本中将包括如下代码行: include_once('arr.php'); require('/path/to/filename.html'); 两种使用外部函数的区别: 使用起来完全一样,只是在出错时会有所不同:include()函数不工作,就会向Web浏览器打印一个讲稿,但是脚本会继续运行,如果require()失败,就会打印一个错误,
PHP通过反射动态加载第三方类和获得类源码的实例

使用反射动态加载第三方类用反射加载第三方类用处在于: 使用XML或其他配文件配置要加载的类,从而和系统源代码分离. 对加载的类进行类检查,是加载的类符合自己定义的结构. <?php abstract class Module { #核心Module类库 function baseFunc() { echo "I am baseFunc"; } abstract function execute(); } class ModuleRunner { private $configD
PHP 动态随机生成验证码类代码

下面是效果图,这个效果图是没有开启干扰码的效果图下面是类代码复制代码代码如下: <?php /************************************************ //FILE:ImageCode //DONE:生成动态验证码类 //DATE"2010-3-31 //Author:www.5dkx.com 5D开心博客 *********************************************************************
用PHP动态创建Flash动画

Macromedia 公司出品的 Flash 动画软件现已经成为Web页面上非常流行的表现工具,网站开发者利用它引起浏览者的兴趣.然而不幸的是,仅仅使用ActionScript创建动画受到很大的限制,Macromedia已经宣布,打算放弃Flash Generator产品,转而采用支持Flash MX的Cold Fusion,我们的网站将向何处去呢?现在,我们可以利用Ming PHP库来轻松地动态创建Flash动画,并且和我们的代码无缝集成.我们可以根据数据库里的数据创建出各种不同效果的动画.
php使用变量动态创建类的对象用法示例

本文实例讲述了php使用变量动态创建类的对象.分享给大家供大家参考,具体如下: 这是一个能用变量动态创建类的对象的用法,就是根据$pay_code变量值来创建对象. 例如下例就是创建类T的一个对象$payment.然后就可以使用了.咋一看像是个新的知识点,其实不然,只不过是编程中的一个技巧而已. $pay_code='T'; $payment = new $pay_code(); echo $payment; echo $payment->ep(); class T{ function ep()
php 动态执行带有参数的类方法

官方手册给出了以下范例: 复制代码代码如下: <?php // 使用了NameSpace的例子 namespace Foobar; class Foo { static public function test() { print "Hello world!\n"; } } call_user_func(__NAMESPACE__ .'\Foo::test'); // As of PHP 5.3.0 // Hello world! call_user_func(array(__

一个ASP创建动态对象的工厂类（类似PHP的stdClass）

相关推荐

随机推荐