当前位置: 开发笔记 > 后端 > 正文

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

作者：XIE绍雄 | 来源：互联网 | 2022-08-20 04:27

这篇文章主要介绍了一个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

其原理很简单，就是通过给定的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

    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, 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
Android中高级面试必知必会，积累总结

本文介绍了Android中高级面试的必知必会内容，并总结了相关经验。文章指出，如今的Android市场对开发人员的要求更高，需要更专业的人才。同时，文章还给出了针对Android岗位的职责和要求，并提供了简历突出的建议。 ... [详细]

蜡笔小新 2023-12-14 14:53:02
api
云服务器API接口的入门使用及功能解析

本文详细介绍了云服务器API接口的概念和作用，以及如何使用API接口管理云上资源和开发应用程序。通过创建实例API、调整实例配置API、关闭实例API和退还实例API等功能，可以实现云服务器的创建、配置修改和销毁等操作。对于想要学习云服务器API接口的人来说，本文提供了详细的入门指南和使用方法。如果想进一步了解相关知识或阅读更多相关文章，请关注编程笔记行业资讯频道。 ... [详细]

蜡笔小新 2023-12-14 12:43:39
session
t-io 2.0.0发布-法网天眼第一版的回顾和更新说明

本文回顾了t-io 1.x版本的工程结构和性能数据，并介绍了t-io在码云上的成绩和用户反馈。同时，还提到了@openSeLi同学发布的t-io 30W长连接并发压力测试报告。最后，详细介绍了t-io 2.0.0版本的更新内容，包括更简洁的使用方式和内置的httpsession功能。 ... [详细]

蜡笔小新 2023-12-14 10:17:48
session
2019年上半年内蒙古计算机软考考试报名通知及考试时间

本文介绍了2019年上半年内蒙古计算机软考考试的报名通知和考试时间。考试报名时间为3月1日至3月23日，考试时间为2019年5月25日。考试分为高级、中级和初级三个级别，涵盖了多个专业资格。报名采取网上报名和网上缴费的方式进行，报考人员可登录内蒙古人事考试信息网进行报名。详细内容请点击查看。 ... [详细]

蜡笔小新 2023-12-13 16:22:51
session
AJAX操作授权过期的全局处理方式

本文介绍了一种处理AJAX操作授权过期的全局方式，以解决Asp.net MVC中Session过期异常的问题。同时还介绍了基于WebImage的图片上传工具类。详细内容请参考链接：https://www.cnblogs.com/starluck/p/8284949.html ... [详细]

蜡笔小新 2023-12-11 19:17:35
php
如何提高PHP编程技能及推荐高级教程

本文介绍了如何提高PHP编程技能的方法，推荐了一些高级教程。学习任何一种编程语言都需要长期的坚持和不懈的努力，本文提醒读者要有足够的耐心和时间投入。通过实践操作学习，可以更好地理解和掌握PHP语言的特异性，特别是单引号和双引号的用法。同时，本文也指出了只走马观花看整体而不深入学习的学习方式无法真正掌握这门语言，建议读者要从整体来考虑局部，培养大局观。最后，本文提醒读者完成一个像模像样的网站需要付出更多的努力和实践。 ... [详细]

蜡笔小新 2023-12-11 18:38:37
php
从高级程序员到CTO的4次能力跃迁！如何选择适合的技术负责人？

本文讲解了从高级程序员到CTO的4次能力跃迁，以及如何选择适合的技术负责人。在初创期、发展期、成熟期的每个阶段，创业公司需要不同级别的技术负责人来实现复杂功能、解决技术难题、提高交付效率和质量。高级程序员的职责是实现复杂功能、编写核心代码、处理线上bug、解决技术难题。而技术经理则需要提高交付效率和质量。 ... [详细]

蜡笔小新 2023-12-11 13:41:06
mysql
MySQL中的MVVC多版本并发控制机制的应用及实现

本文介绍了MySQL中MVCC的应用及实现机制。MVCC是一种提高并发性能的技术，通过对事务内读取的内存进行处理，避免写操作堵塞读操作的并发问题。与其他数据库系统的MVCC实现机制不尽相同，MySQL的MVCC是在undolog中实现的。通过undolog可以找回数据的历史版本，提供给用户读取或在回滚时覆盖数据页上的数据。MySQL的大多数事务型存储引擎都实现了MVCC，但各自的实现机制有所不同。 ... [详细]

蜡笔小新 2023-12-11 13:09:19
mysql
GPT-3发布，动动手指就能自动生成代码的神器来了！

近日，OpenAI发布了最新的NLP模型GPT-3，该模型在GitHub趋势榜上名列前茅。GPT-3使用的数据集容量达到45TB，参数个数高达1750亿，训练好的模型需要700G的硬盘空间来存储。一位开发者根据GPT-3模型上线了一个名为debuid的网站，用户只需用英语描述需求，前端代码就能自动生成。这个神奇的功能让许多程序员感到惊讶。去年，OpenAI在与世界冠军OG战队的表演赛中展示了他们的强化学习模型，在限定条件下以2:0完胜人类冠军。 ... [详细]

蜡笔小新 2023-12-11 11:04:43
mysql
svnWebUI：一款现代化的svn服务端管理软件

svnWebUI是一款图形化管理服务端Subversion的配置工具，适用于非程序员使用。它解决了svn用户和权限配置繁琐且不便的问题，提供了现代化的web界面，让svn服务端管理变得轻松。演示地址：http://svn.nginxwebui.cn:6060。 ... [详细]

蜡笔小新 2023-12-11 11:01:10
分布式
SpringBoot整合SpringSecurity+JWT实现单点登录

SpringBoot整合SpringSecurity+JWT实现单点登录,Go语言社区,Golang程序员人脉社 ... [详细]

蜡笔小新 2023-12-11 08:21:41
php
javascript和java的关系,JavaScript和java的关系

Java和JavaScript是什么关系？java跟javaScript都是编程语言，只是java跟javaScript没有什么太大关系，一个是脚本语言（前端语言），一个是面向对象 ... [详细]

蜡笔小新 2023-12-11 04:03:31
php
程序员最美情人节礼物：用JS渲染的3D玫瑰

本文介绍了程序员最美的情人节礼物，即使用JS渲染的3D玫瑰，通过在QQ空间和人人网上分享这个特殊的礼物，可以给情人带来惊喜和喜悦。 ... [详细]

蜡笔小新 2023-12-12 16:25:24
php
海马s5近光灯能否直接更换为H7？

本文主要介绍了海马s5车型的近光灯是否可以直接更换为H7灯泡，并提供了完整的教程下载地址。此外，还详细讲解了DSP功能函数中的数据拷贝、数据填充和浮点数转换为定点数的相关内容。 ... [详细]

蜡笔小新 2023-12-12 11:39:00
爬虫
2022年的风口：你看不起的行业，真的很挣钱！

本文介绍了2022年的风口，探讨了一份稳定的副业收入对于普通人增加收入的重要性，以及如何抓住风口来实现赚钱的目标。文章指出，拼命工作并不一定能让人有钱，而是需要顺应时代的方向。 ... [详细]

蜡笔小新 2023-12-11 18:31:31

XIE绍雄

这个家伙很懒，什么也没留下！

Tags | 热门标签

RankList | 热门文章