主頁(yè) > 知識(shí)庫(kù) > 一個(gè)ASP創(chuàng)建動(dòng)態(tài)對(duì)象的工廠類(lèi)（類(lèi)似PHP的stdClass）

一個(gè)ASP創(chuàng)建動(dòng)態(tài)對(duì)象的工廠類(lèi)（類(lèi)似PHP的stdClass）

最近整理ASP/VBScript代碼，發(fā)現(xiàn)過(guò)去的一個(gè)ASP實(shí)現(xiàn)的MVC框架，可惜是個(gè)半成品，效率也成問(wèn)題，不過(guò)發(fā)現(xiàn)里面有些我寫(xiě)的代碼，感覺(jué)還稍稍可以拿出來(lái)見(jiàn)人，于是今天作此文以記之。

說(shuō)是ASP，其實(shí)和VBScript也脫不了干系，VBScript語(yǔ)言傳承于Visual Basic，VB的語(yǔ)法靈活度已經(jīng)不盡如人意了，VBS作為其子集可想而知。神馬反射、自省等先進(jìn)的技術(shù)，微軟在.NET中才引入。作為被拋棄的技術(shù)，也不奢望微軟能夠提供支持，于是頑固守舊的程序員只有絞盡腦汁的去模仿實(shí)現(xiàn)一些類(lèi)似的功能。

好吧，我承認(rèn)很長(zhǎng)一段時(shí)間我就是頑固守舊派中的一員，今天介紹的就是其中的一項(xiàng)功能，動(dòng)態(tài)創(chuàng)建一個(gè)屬性對(duì)象，屬性對(duì)象姑且這么稱呼，也就是說(shuō)動(dòng)態(tài)創(chuàng)建的對(duì)象只包含屬性(Properties)。

下面貼出實(shí)現(xiàn)代碼供大家參考：

復(fù)制代碼代碼如下:

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

對(duì)于屬性對(duì)象分別提供了Property直接訪問(wèn)模式和set或者get函數(shù)訪問(wèn)模式，當(dāng)然我還提供了三種權(quán)限控制，在add方法中使用，分別是PROPERTY_ACCESS_READONLY（屬性只讀）、PROPERTY_ACCESS_WRITEONLY（屬性只寫(xiě)）和PROPERTY_ACCESS_ALL（屬性讀寫(xiě)），你可以像下面這樣使用（一個(gè)例子）：

復(fù)制代碼代碼如下:

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
    '
    ' 如果沒(méi)有setClassName，
    ' 新創(chuàng)建的對(duì)象將會(huì)自動(dòng)命名為AnonymousObject
    ' 但是如果創(chuàng)建多個(gè)對(duì)象，就必須指定名稱
    ' 否則就可能引起對(duì)象名重復(fù)的異常
    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

其原理很簡(jiǎn)單，就是通過(guò)給定的Key-Value動(dòng)態(tài)生成VBS Class腳本代碼，然后調(diào)用Execute執(zhí)行以便于將這段代碼加入到代碼上下文流中，最后再通過(guò)Eval新建這個(gè)對(duì)象。

好了，就介紹到這里，今后我可能還會(huì)陸續(xù)公開(kāi)一些Classic ASP的相關(guān)技巧代碼。

2012年11月7日更新

修復(fù)從舊項(xiàng)目移植過(guò)來(lái)導(dǎo)致的BUG。

修復(fù)了一些Bug增加了一些特性，我先把最新的代碼貼出來(lái)供大家參考：

復(fù)制代碼代碼如下:

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

需要注意的幾個(gè)新特性：

1. 增加了類(lèi)名和屬性名驗(yàn)證措施，防止畸形的類(lèi)名或者屬性名導(dǎo)致動(dòng)態(tài)生成的代碼出現(xiàn)語(yǔ)法錯(cuò)誤。不過(guò)處理的方式是直接忽略，本來(lái)想Raise異常的，但考慮到VBS對(duì)異常處理不是很好的，所以采取忽略策略：

' 有效的類(lèi)名或?qū)傩悦仨氁宰帜搁_(kāi)頭

復(fù)制代碼代碼如下:

Dim DynObj
Set DynObj = New DynamicObject
    DynObj.setClassName "1User" ' 此句將被忽略，因?yàn)轭?lèi)名不能以數(shù)字開(kāi)始
    ' 下面這句也會(huì)被忽略，因?yàn)閷傩悦荒芤蕴厥夥?hào)開(kāi)始
    DynObj.add "%Name", "WangYe", PROPERTY_ACCESS_READONLY
Set DynObj = Nothing

2. 對(duì)于動(dòng)態(tài)對(duì)象增加了hasattr_方法，該屬性用于檢測(cè)此對(duì)象是否支持相應(yīng)的屬性，可以在訪問(wèn)一個(gè)屬性前先確定該對(duì)象是否支持此屬性：

復(fù)制代碼代碼如下:

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. 對(duì)于動(dòng)態(tài)對(duì)象增加了getattr_方法，此方法可以安全的獲取指定的屬性值，避免因?yàn)閷?duì)象不存在屬性值導(dǎo)致出錯(cuò)。方法原型為getattr_(ByVal propertyName, ByVal defaultValue)，參數(shù)propertyName指定屬性的名字，defaultValue是當(dāng)指定屬性不存在是可以返回的默認(rèn)值，比如下面代碼：

復(fù)制代碼代碼如下:

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. 動(dòng)態(tài)對(duì)象的類(lèi)名可以通過(guò)ClassName_屬性或者getClassName_()方法獲取。

2012年11月12日更新

修復(fù)雙引號(hào)導(dǎo)致構(gòu)造類(lèi)錯(cuò)誤或?qū)е聢?zhí)行任意代碼的Bug。

您可能感興趣的文章:

ASP中類(lèi)Class相關(guān)內(nèi)容的整理資料
ASP類(lèi)Class入門(mén) 推薦
ASP 類(lèi) Class入門(mén)
ASPJPEG綜合操作的CLASS類(lèi)
CJJ專(zhuān)用ASP類(lèi)庫(kù)中的某個(gè)class

標(biāo)簽：蚌埠衢州棗莊萍鄉(xiāng) 大理衡水廣元江蘇

巨人網(wǎng)絡(luò)通訊聲明：本文標(biāo)題《一個(gè)ASP創(chuàng)建動(dòng)態(tài)對(duì)象的工廠類(lèi)（類(lèi)似PHP的stdClass）》，本文關(guān)鍵詞；如發(fā)現(xiàn)本文內(nèi)容存在版權(quán)問(wèn)題，煩請(qǐng)?zhí)峁┫嚓P(guān)信息告之我們，我們將及時(shí)溝通與處理。本站內(nèi)容系統(tǒng)采集于網(wǎng)絡(luò)，涉及言論、版權(quán)與本站無(wú)關(guān)。