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

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

这篇文章主要介绍了一个ASP创建动态对象的工厂类,可以动态创建对象,和无限制的增加类的属性,和PHP中的stdClass功能类似,需要的朋友可以参考下

最近整理ASP/Vbscript代码,发现过去的一个ASP实现的MVC框架,可惜是个半成品,效率也成问题,不过发现里面有些我写的代码,感觉还稍稍可以拿出来见人,于是今天作此文以记之。

说是ASP,其实和Vbscript也脱不了干系,Vbscript语言传承于Visual Basic,VB的语法灵活度已经不尽如人意了,VBS作为其子集可想而知。神马反射、自省等先进的技术,微软在.NET中才引入。作为被抛弃的技术,也不奢望微软能够提供支持,于是顽固守旧的程序员只有绞尽脑汁的去模仿实现一些类似的功能。

好吧,我承认很长一段时间我就是顽固守旧派中的一员,今天介绍的就是其中的一项功能,动态创建一个属性对象,属性对象姑且这么称呼,也就是说动态创建的对象只包含属性(Properties)。

>>

下面贴出实现代码供大家参考:

>
复制代码 代码如下:

>
'
' ASP/Vbscript Dynamic Object Generator
' Author: WangY
e
' 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 I

f
        Next
        parse = parse & init & "End Sub : " &  pstr & "End Class

"
    End Function
>
    Public Function getObject()
        Call Execute(parse

)
        Set getObject = Eval("New " & m_strName)
    End Functio


n

    Public Sub invokeObject(ByRef obj)
        Call Execute(parse

)
        Set obj = Eval("New " & m_strName)
    End Su

b
End Class>
>

对于属性对象分别提供了Property直接访问模式和set或者get函数访问模式,当然我还提供了三种权限控制,在add方法中使用,分别是PROPERTY_ACCESS_READONLY(属性只读)、PROPERTY_ACCESS_WRITEONLY(属性只写)和PROPERTY_ACCESS_ALL(属性读写),你可以像下面这样使用(一个例子):>

复制代码 代码如下:
>
Dim DynObj
Set DynObj = New DynamicObjec

t
    DynObj.add "Name", "WangYe", PROPERTY_ACCESS_READONLY
    DynObj.add "HomePage", "http://jb51.net", PROPERTY_ACCESS_READONL

Y
    DynObj.add "Job", "Programmer", PROPERTY_ACCESS_ALL
   
'
    ' 如果没有setClassName,
    ' 新创建的对象将会自动命名为AnonymousObjec
t
    ' 但是如果创建多个对象,就必须指定名称
    ' 否则就可能引起对象名重复的异

    DynObj.setClassName "User"

    Dim User
    Set User = DynObj.GetObject()
    ' 或者 DynObj.invokeObject User
        Response.Write User.Nam

e
        ' Response.Write User.getName()
 Response.Write User.HomePage
        ' Response.Write User.getHomePage()
 Response.Write User.Jo

b
        ' 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 Generato
r
' Author: WangYe
' For more information please visi
t
'    
' This code is distributed under the BSD licens

e
'
' 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_strNam

e
    Private m_objRegExp
>
    Private Sub Class_Initialize()
        Set m_objProperties = CreateObject("Scripting.Dictionary"
)
        Set m_objRegExp = New RegExp
            m_objRegExp.IgnoreCase = Tru

e
            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 Su
>
b

    Private Sub Class_Terminate()
        Set m_objRegExp = Nothin

g
        If IsObject(m_objProperties) Then
            m_objProperties.RemoveAl

l
        End If
        Set m_objProperties = Nothin

g
    End Su

b

    Public Sub setClassName(strName)
        If Not m_objRegExp.Test(strName) The

n
            ' Skipped Invalid Class Name
            ' Raise
            Exit Sub
        End I

f
        m_strName = strName
        m_objProperties("ClassName_") =
_
            Array(m_strName, PROPERTY_ACCESS_READONLY)
    End Su
>
b

    Public Sub add(key, value, access)
        If Not m_objRegExp.Test(key) The

n
            ' Skipped Invalid key
            ' Rais
e
            Exit Sub
        End I

f
        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 I

f
        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 Functio>
n

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

j
Set DynObj = New DynamicObject
    DynObj.setClassName "1User" ' 此句将被忽略,因为类名不能以数字开

    ' 下面这句也会被忽略,因为属性名不能以特殊符号开始
    DynObj.add "%Name", "WangYe", PROPERTY_ACCESS_READONL

Y
Set DynObj = Nothin
g

2. 对于动态对象增加了hasattr_方法,该属性用于检测此对象是否支持相应的属性,可以在访问一个属性前先确定该对象是否支持此属性:>
复制代码 代码如下
:

>
Dim DynObj
Set DynObj = New DynamicObjec
t
    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_READONL>
Y

    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。







推荐阅读
  • Vue+Springboot实现接口签名的示例代码
    这篇文章主要介绍了Vue+Springboot实现接口签名的示例代码,文中通过示例代码介绍的非常详细,对大家的学习或者工作具有一定的参考学习价值,需要的朋友们下面随着小编来一起学习学习吧 ... [详细]
  • 这个功能应该是很多网站都需要的,这里仅仅实现了一个基于文件的简易版本,数据库的版本请自行参考实现,我这里实现的功能很不完善,比如未过滤是否为同一访客,是否为同一IP等等,这里仅仅是给大家提供一个参考. ... [详细]
  • ApplicationHost.config(IIS存储配置区文件)介绍
    在IIS的配置文件中ApplicationHost.config的modules元素中注册了很多模块,这些模块供IIS承载的所有应用程序使用,这里就为大家介绍一下,需要的朋友可以参考下 ... [详细]
  • 这篇文章主要介绍了详解Nginx中的重定向功能,Nginx是一款基于事务的无阻塞的高性能服务器,需要的朋友可以参考下 ... [详细]
  • 本文主要介绍ASP.NET有用的工具,这里整理了85个工具及介绍工具的作用,开发ASP.NET的朋友可以参考下 ... [详细]
  • ASP.NET Core3.1 Ocelot认证的实现
    这篇文章主要介绍了ASP.NETCore3.1Ocelot认证的实现,文中通过示例代码介绍的非常详细,对大家的学习或者工作具有一定的参考学习价值,需要的朋友们下面随着小编来一起学习学习吧 ... [详细]
  • 这篇文章主要介绍了详解Nginx中的重定向功能,Nginx是一款基于事务的无阻塞的高性能服务器,需要的朋友可以参考下 ... [详细]
  • ApplicationHost.config(IIS存储配置区文件)介绍
    在IIS的配置文件中ApplicationHost.config的modules元素中注册了很多模块,这些模块供IIS承载的所有应用程序使用,这里就为大家介绍一下,需要的朋友可以参考下 ... [详细]
  • Laravel 4 初级教程之视图、命名空间、路由
    Laravel 4 初级教程之视图、命名空间、路由 ... [详细]
  • BACKBONE.JS 简单入门范例
    Backbone简单、灵活,无论是富JS应用还是企业网站都用得上,相比React针对View和单向数据流的设计,Backbone更能体现MVC的思路,所以针对它写一篇入门范例,需要的朋友可以参考下 ... [详细]
devbox
XIE绍雄
这个家伙很懒,什么也没留下!
PHP1.CN | 中国最专业的PHP中文社区 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved PHP1.CN 第一PHP社区 版权所有 京ICP备19059560号-4