主頁 > 知識庫 > 一個ASP創(chuàng)建動態(tài)對象的工廠類(類似PHP的stdClass)

一個ASP創(chuàng)建動態(tài)對象的工廠類(類似PHP的stdClass)

熱門標簽:鄭州語音電銷機器人官網 重慶外呼電銷系統費用 地圖標注不完整被罰款 電銷機器人一個多少錢 不封卡外呼系統一般多少錢 微信地圖標注有什么用 地圖標注中心多少錢注冊 濰坊呼叫中心外呼系統供應商 北京大興區(qū)地圖標注

最近整理ASP/VBScript代碼,發(fā)現過去的一個ASP實現的MVC框架,可惜是個半成品,效率也成問題,不過發(fā)現里面有些我寫的代碼,感覺還稍稍可以拿出來見人,于是今天作此文以記之。

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

好吧,我承認很長一段時間我就是頑固守舊派中的一員,今天介紹的就是其中的一項功能,動態(tài)創(chuàng)建一個屬性對象,屬性對象姑且這么稱呼,也就是說動態(tài)創(chuàng)建的對象只包含屬性(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,
    ' 新創(chuàng)建的對象將會自動命名為AnonymousObject
    ' 但是如果創(chuàng)建多個對象,就必須指定名稱
    ' 否則就可能引起對象名重復的異常
    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動態(tài)生成VBS Class腳本代碼,然后調用Execute執(zhí)行以便于將這段代碼加入到代碼上下文流中,最后再通過Eval新建這個對象。

好了,就介紹到這里,今后我可能還會陸續(xù)公開一些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. 增加了類名和屬性名驗證措施,防止畸形的類名或者屬性名導致動態(tài)生成的代碼出現語法錯誤。不過處理的方式是直接忽略,本來想Raise異常的,但考慮到VBS對異常處理不是很好的,所以采取忽略策略:

' 有效的類名或屬性名必須以字母開頭

復制代碼 代碼如下:
Dim DynObj
Set DynObj = New DynamicObject
    DynObj.setClassName "1User" ' 此句將被忽略,因為類名不能以數字開始
    ' 下面這句也會被忽略,因為屬性名不能以特殊符號開始
    DynObj.add "%Name", "WangYe", PROPERTY_ACCESS_READONLY
Set DynObj = Nothing

2. 對于動態(tài)對象增加了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. 對于動態(tài)對象增加了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. 動態(tài)對象的類名可以通過ClassName_屬性或者getClassName_()方法獲取。

2012年11月12日更新

修復雙引號導致構造類錯誤或導致執(zhí)行任意代碼的Bug。

您可能感興趣的文章:
  • ASP中類Class相關內容的整理資料
  • ASP類Class入門 推薦
  • ASP 類 Class入門
  • ASPJPEG綜合操作的CLASS類
  • CJJ專用ASP類庫中的某個class

標簽:攀枝花 鶴崗 海南 唐山 揭陽 撫州 汕頭 佛山

巨人網絡通訊聲明:本文標題《一個ASP創(chuàng)建動態(tài)對象的工廠類(類似PHP的stdClass)》,本文關鍵詞  一個,ASP,創(chuàng)建,動態(tài),對象,;如發(fā)現本文內容存在版權問題,煩請?zhí)峁┫嚓P信息告之我們,我們將及時溝通與處理。本站內容系統采集于網絡,涉及言論、版權與本站無關。
  • 相關文章
  • 下面列出與本文章《一個ASP創(chuàng)建動態(tài)對象的工廠類(類似PHP的stdClass)》相關的同類信息!
  • 本頁收集關于一個ASP創(chuàng)建動態(tài)對象的工廠類(類似PHP的stdClass)的相關信息資訊供網民參考!
  • 推薦文章