Recently collated Asp/vbscript code, found in the past an ASP implementation of the MVC framework, unfortunately is a semi-finished product, efficiency is also a problem, but found that some of the code I wrote, feel still slightly can be brought out to see people, so today to write this article to remember.
Said is ASP, in fact, and VBScript also take off, VBScript language inherited from visual Basic,vb grammatical flexibility is not satisfactory, the VBS as a subset can be imagined. God horse reflection, introspection and other advanced technology, Microsoft in. NET. As abandoned technology, also do not expect Microsoft to provide support, so stubborn old-fashioned programmers only racked their brains to imitate the implementation of some similar functions.
Well, I admit that for a long time I was one of the stubborn old school, and today is one of the features that dynamically create a Property object, which is called a Property object, which means that the dynamically created object contains only attributes (properties).
Below the implementation code for everyone to refer to:
Copy Code code as follows:
'
' 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" & 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" & 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
The Property object provides both the properties direct access mode and the set or Get function access mode, and of course I also provide three kinds of permission controls, which are used in the Add method, namely Property_access_readonly (property Read only), Property_ Access_writeonly (attribute write only) and Property_access_all (attribute read-write), you can use it like this (an example):
Copy Code code as follows:
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
'
' If there is no setclassname,
' The newly created object will be automatically named Anonymousobject
' But if you create multiple objects, you must specify a name
' Otherwise, the exception that might cause the object name to duplicate
Dynobj.setclassname "User"
Dim User
Set User = Dynobj.getobject ()
' Or 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 ()
' Change the value of the property
User.job = "Engineer"
' User.setjob ' Engineer '
Response.Write User.getjob ()
Set User = Nothing
Set dynobj = Nothing
The simple principle is to dynamically generate the VBS class script code through a given key-value, and then invoke execute execution to make it easier to add this code to the code context stream, and then create this object again through Eval.
Well, to introduce here, in the future, I will probably also open some of the classic ASP code related skills.
Updated November 7, 2012
Fix bugs that are caused by porting from old projects.
Fixing some bugs adds some features, so I'll post the latest code for your reference:
Copy Code code as follows:
'
' 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
' Value safety.
' 4. Class name can 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" & 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" & 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
Several new features to note:
1. The addition of class name and attribute name verification measures to prevent malformed class names or attribute names from causing a syntax error in dynamically generated code. However, the way to deal with it is directly ignored, would have wanted to raise the exception, but given that the VBS is not good for exception handling, so take the ignore policy:
' Valid class name or property name must begin with a letter
Copy Code code as follows:
Dim Dynobj
Set dynobj = New dynamicobject
Dynobj.setclassname "1User" is ignored because the class name cannot start with a number
' The following sentence will also be ignored because the property name cannot start with a special symbol
Dynobj.add "%name", "Wangye", property_access_readonly
Set dynobj = Nothing
2. The Hasattr_ method for dynamic objects is used to detect whether this object supports the corresponding property, and it is possible to determine whether the object supports this property before accessing a property:
Copy Code code as follows:
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. Adding a Getattr_ method for dynamic objects, this method can safely get the specified property value and avoid an error because the object does not have a property value. The method prototype is Getattr_ (ByVal PropertyName, ByVal defaultvalue), parameter propertyname The name of the specified property, and DefaultValue is the default value that can be returned when the specified property does not exist. For example, the following code:
Copy Code code as follows:
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. The class name of a dynamic object can be obtained by either the Classname_ property or the Getclassname_ () method.
Updated November 12, 2012
Fixing double quotes results in the construction of class errors or bugs that cause arbitrary code execution.
