ASP/VBScript Dictionary extractASP/VBScript模拟实现PHP extract()函数将字典集合转换为对象

extract.asp

<%
'
' ASP/VBScript Dictionary extract
' Author: WangYe
' For more information please visit
'     http://wangye.org/blog/archives/734/
' This code is distributed under the BSD license
'
' collection 集合或者字典，可以通过For Each访问的
'            Request.Form 或者 Request.QueryString
' specified  指定必须存在的属性，假如该属性不存在，将自动创建一个
' prefix     每个属性的前缀修饰
' callback   对于集合或者字典的每个元素(key-value)的值进行函数调用
'            函数原型：
'            Function filter(key, value)
'                filter = value
'            End If
'            最终值将以该函数返回的值为准
' 
Function extract(collection, ByVal specified, prefix, callback)
    Dim VarName, VarValue, DynObj, searchKey
    specified = "," & Replace(specified, " ", "") & ","
    ' DynamicObject see https://gist.github.com/3858372
    Set DynObj = New DynamicObject
    For Each key In collection
        searchKey = "," & key & ","
        If InStr(1, specified, searchKey, 1)>0 Then
            specified = Replace(specified, searchKey, "")
            If Left(specified, 1) <> "," Then
                specified = "," & specified
            End If
            If Right(specified, 1) <> "," Then
                specified = specified & ","
            End If
        End If
 
        VarName = prefix & key
 
        VarValue = collection(key)
        If callback<>"" Then
            VarValue = GetRef(callback)(key, VarValue)
        End If
 
        DynObj.add VarName, VarValue, PROPERTY_ACCESS_READONLY
	Next
 
    specified_array = Split(specified, ",")
    Dim i
    For i = LBound(specified_array) To UBound(specified_array)
        If specified_array(i)<>"" Then
            DynObj.add prefix & specified_array(i), "", _
		PROPERTY_ACCESS_READONLY
        End If
    Next
    Set extract = DynObj.GetObject()
End Function

Dim query
Set query = extract(Request.QueryString, "name,id", "", "")
 
    Response.Write query.name
    Response.Write query.id
 
Set query = Nothing


Set query = extract(Request.QueryString, "name,id", "", "")
 
If query.hasattr_("job") Then
    Response.Write "Job : " & query.job
End If
 
Set query = Nothing

Set query = extract(Request.QueryString, "name,id", "", "")
 
    Response.Write "Job : " & query.getattr_("job", "No Job")
 
Set query = Nothing

'
' Function filter(key, value)
'   filter = Trim(value)
' End Function
'

Function filter(key, value)
    On Error Resume Next
 
    Select Case key
        Case "id" ' 判断ID是否是数字
            If Not IsNumeric(value) Then
                Exit Function
            End If
 
            If CLng(value)<1 Then
                Exit Function
            End If
    End Select
 
    ' 最后记得让函数返回值，该值在extract将被置为该返回值
    filter = Trim(value)
 
    If Err.Number<>0 Then
        filter = ""
    End If
End Function

Set query = extract(Request.QueryString, "name,id,job", "", "filter")
 
    Response.Write query.name
    Response.Write query.job
    Response.Write query.id
 
Set query = Nothing
%>