Recently, I sorted out the ASP/VBScript code and found that an ASP implemented MVC framework in the past was a semi-finished product, and efficiency was also a problem. However, I found that there were some codes I wrote in it, and I felt that I could take it out to meet people, so I wrote this article today to record it.
It is said to be ASP, but it has nothing to do with VBScript. The VBScript language is inherited from Visual Basic. The syntax flexibility of VB is no longer satisfactory. As a subset, VBS can be imagined. Microsoft has introduced advanced technologies such as Shenma Reflection and Introspection in .NET. As an abandoned technology, there is no expectation that Microsoft can provide support, so the stubborn and conservative programmers can only rack their brains to imitate and implement some similar functions.
Well, I admit that for a long time I have been one of the stubborn and conservative schools. Today I am introducing one of the functions, dynamically creating a property object, and the attribute object is called this, that is, the objects created dynamically only contain properties (Properties).
The implementation code is posted below for your reference:
'
' 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("")
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
For property objects, we provide property direct access mode and set or get function access mode respectively. Of course, I also provide three permission controls, which are used in the add method, namely PROPERTY_ACCESS_READONLY (property read-only), PROPERTY_ACCESS_WRITEONLY (property write-only) and PROPERTY_ACCESS_ALL (property read-only). You can use it like the following (an example):
Dim DynObj
Set DynObj = New DynamicObject
"Name", "WangYe", PROPERTY_ACCESS_READONLY
"HomePage", "", PROPERTY_ACCESS_READONLY
"Job", "Programmer", PROPERTY_ACCESS_ALL
'
'If there is no setClassName,
' The newly created object will be automatically named AnonymousObject
' But if multiple objects are created, you must specify a name
' Otherwise, it may cause an exception to duplicate object name
"User"
Dim User
Set User = ()
' Or User
' ()
' ()
' ()
' Change the attribute value
= "Engineer"
' "Engineer"
()
Set User = Nothing
Set DynObj = Nothing
The principle is very simple, which is to dynamically generate VBS Class script code through the given Key-Value, then call Execute to facilitate adding this code to the code context stream, and finally create this object through Eval.
Okay, that's all for this. In the future, I may also disclose some relevant Classic ASP skills codes one after another.
Updated on November 7, 2012
Fixed bugs caused by porting from old projects.
Fixed some bugs and added some features. I will post the latest code for your reference first:
' 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("")
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__"
' 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()
' 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. Added class name and attribute name verification measures to prevent abnormal class names or attribute names from causing syntax errors in dynamically generated code. However, the processing method is to ignore it directly. I originally wanted to Raise exceptions, but considering that VBS does not handle exceptions very well, I adopt the ignorance strategy:
' Valid class or attribute name must start with a letter
Set DynObj = New DynamicObject
"1User" ' This sentence will be ignored because the class name cannot start with a number
' The following sentence will also be ignored because the attribute name cannot start with a special symbol
"%Name", "WangYe", PROPERTY_ACCESS_READONLY
Set DynObj = Nothing
2. Added hasattr_ method for dynamic objects, which is used to detect whether the object supports the corresponding attribute. You can determine whether the object supports this attribute before accessing a property:
Dim DynObj
Set DynObj = New DynamicObject
"Name", "WangYe", PROPERTY_ACCESS_READONLY
DynObj.hasattr_("Name") ' True
DynObj.hasattr_("Favor") ' False
Set DynObj = Nothing
3. Added the getattr_ method for dynamic objects. This method can safely obtain the specified attribute value to avoid errors because the object does not have attribute value. The method prototype is getattr_(ByVal propertyName, ByVal defaultValue), the parameter propertyName specifies the name of the property. defaultValue is the default value that can be returned when the specified property does not exist, such as the following code:
Dim DynObj
Set DynObj = New DynamicObject
"Name", "WangYe", PROPERTY_ACCESS_READONLY
DynObj.getattr_("Name", "N/A") ' WangYe
DynObj.getattr_("Favor", "N/A") ' N/A
Set DynObj = Nothing
4. The class name of the dynamic object can be obtained through the ClassName_ attribute or getClassName_() method.
Updated on November 12, 2012
Fixed bugs that caused construction class errors or caused arbitrary code execution.