<%
' +----------------------------------------------------------------------
' | POPASP [ ASP MVC ]
' +----------------------------------------------------------------------
' | Copyright (c) 2016 http://popasp.com All rights reserved.
' +----------------------------------------------------------------------
' | Licensed ( http://www.apache.org/licenses/LICENSE-2.0 )
' +----------------------------------------------------------------------
' | Author: popasp <1737025626@qq.com>
' +----------------------------------------------------------------------
Class POPASP_DICTIONARY
Public sortByNumeric,sortByDate
'从数据库中取出的数据为二维Dictionary对象，可以将其转化为Table表格
public Property Get Table( ByRef dict )
Table = P_("POPASP_HTML").Table( dict,"","","" )
End Property
'从数据库中取出的数据为二维Dictionary对象，可以将其转化为Excel表格
'1） 文本(text,t)：vnd.ms-excel.numberformat:@
'2） 日期(date,d)：vnd.ms-excel.numberformat:yyyy/mm/dd hh:mm:ss
'3） 数字(number,n)：vnd.ms-excel.numberformat:#,##0.00
'4） 货币(currency,c,￥,$)：vnd.ms-excel.numberformat:￥#,##0.00
'5） 百分比(percent,p)：vnd.ms-excel.numberformat: #0.00%
'style为数组，分别对应各字段的类型，默认空字符串""为文本类型
public sub Excel( ByRef dict , ByVal style , ByVal filename )
Call C_( Array( "SHOW_PAGE_TRACE" , 0 ) )
filename = POP_MVC.String.rtrim( filename,".xls" )
filename = POP_MVC.String.rtrim( filename,".xlsx" )
'如果要调试，请注释掉下面两行代码
Response.ContentType = "application/excel"
Response.AddHeader "Content-Disposition", "attachment;filename="""& filename &".xls"""
dim html,i,k1,k2,item,j,temp 'i用来计算行数,j计算列数
html = "" & VbCrLf
html = html & "" & VbCrLf
html = html & "" & VbCrLf
html = html & "" & VbCrLf
html = html & "" & VbCrLf
html = html & "" & VbCrLf
html = html & ""
i = 0
for each k1 in dict
j = 0
set item = dict(k1)
if i = 0 then
html = html & VbCrLf & vbTab & ""
html = html & VbCrLf & vbTab & vbTab
for each k2 in item
html = html & "| " & k2 & " | "
next
html = html & VbCrLf & vbTab & "
"
if not isArray(style) then
style = split( style,"," )
end if
for j = 0 to ubound( style )
if style(j) = "" then
style(j) = "number"
end if
next
if item.count > ubound( style ) + 1 then '如果类型数组中的元素个数小于字段个数，则用数字类型代替
temp = style( ubound(style) )
for j = item.count - 1 to ubound( style ) step -1
POP_MVC.Arr.Push style,temp
next
end if
end if
html = html & VbCrLf & vbTab & ""
html = html & VbCrLf & vbTab & vbTab
j = 0
for each k2 in item
select case LCase(style(j))
case "text","t"
html = html & "| " & item(k2) & " | "
case "date","d"
html = html & "" & item(k2) & " | "
case "number","n"
html = html & "" & item(k2) & " | "
case "currency","c","￥"
html = html & "" & item(k2) & " | "
case "currency","c","$"
html = html & "" & item(k2) & " | "
case "percent","p"
html = html & "" & item(k2) & " | "
End Select
j = j + 1
next
html = html & VbCrLf & vbTab & "
"
i = i + 1
next
html = html & VbCrLf & "
"
html = html & VbCrLf & ""
html = html & VbCrLf & ""
set dict = nothing
Response.write html
End sub
Private Sub Class_Initialize
sortByNumeric = True
sortByDate = True
End Sub
'''''''''''''修改函数
'向Dictionary对象尾部添加一个键值对
Sub Push(ByRef dict, ByRef key, ByRef val)
if typename(dict) <> "Dictionary" then set dict = Create()
if dict.Exists(key) then
dict.remove(key)
end if
if key = "" then '如果键名为空，则以当前的个数为键名
dict.add dict.count,val
else
dict.add key,val
end if
End Sub
'向Dictionary对象头部添加一个键值对，如果dict为 var("key") 类型则不能添加
Sub Unshift(ByRef dict,ByVal key,ByRef val)
if typename(dict) <> "Dictionary" then set dict = Create()
dim temp
set temp = Create()
if key = "" then '如果键名为空，则以当前的个数为键名
key = dict.count
end if
temp.add key,val
if typename(dict) <> "Dictionary" then set dict = Create()
set dict = Merge(temp,dict)
end sub
'向Dictionary对象的某个键名前面插入一个键值对
'如果向不存在的键名前面插入键值对，则会追加到对象尾部
Sub InsertBefore( ByRef dict, ByRef beforeKey, ByRef key,ByRef val)
if typename(dict) <> "Dictionary" then set dict = Create()
dim temp,i
if Not dict.Exists( beforeKey ) Then
Push dict,key,val
Exit Sub
end if
if dict.Exists( key ) Then dict.Remove(key)
for each i in dict
if i = beforeKey then
Push temp,key,val
end if
Push temp,i,dict.item(i)
next
set dict = temp
set temp = nothing
End Sub
'向Dictionary对象的某个键名后面插入一个键值对
'如果向不存在的键名前面插入键值对，则会追加到对象尾部
Sub InsertAfter( ByRef dict, ByRef afterKey, ByRef key,ByRef val)
if typename(dict) <> "Dictionary" then set dict = Create()
dim temp,i
if Not dict.Exists( afterKey ) Then
Push dict,key,val
Exit Sub
end if
if dict.Exists( key ) Then dict.Remove(key)
for each i in dict
Push temp,i,dict.item(i)
if i = afterKey then
Push temp,key,val
end if
next
set dict = temp
set temp = nothing
End Sub
'从Dictionary对象中删除最后一个键值对，并以数组形式返回
Function Pop(ByRef dict)
dim key,arr,i,cnt
if typename(dict) <> "Dictionary" then Exit Function
cnt = dict.Count
if cnt = 0 then Exit Function
i = 0
for each key in dict
i = i + 1
if i = cnt then
POP_MVC.Arr.push arr,key
POP_MVC.Arr.push arr,dict(key)
dict.remove(key)
end if
next
Pop = arr
End Function
'从Dictionary对象中删除第一个键值对，并以数组形式返回
Function Shift(ByRef dict)
dim key,arr
for each key in dict
POP_MVC.Arr.push arr,key
POP_MVC.Arr.push arr,dict(key)
dict.remove(key)
exit for
next
shift = arr
End Function
' 将Dictionary对象两个键名对应的值进行交换
Sub vswap( ByRef dict,ByVal key1,ByVal key2 )
dim temp
if Not dict.Exists( key1 ) OR Not dict.Exists( key2 ) Then Exit Sub
if isObject(dict(key1)) then set temp = dict(key1) else temp = dict(key1)
call Edit( dict,key1,dict(key2) )
call Edit( dict,key2,temp )
if isObject(temp) then set temp = nothing
End sub
' 将Dictionary对象两个键名进行交换
Sub kswap( ByRef dict,ByVal key1,ByVal key2 )
dim k1,k2,key
key = "__POPASP_|/YouShouldNotGuess\|__POPASP_"
k1 = key1 : k2 = key2
dict.key(key2) = key : dict.key(key1) = k2 : dict.key(key) = k1
End sub
' 将Dictionary对象的两个键值对进行交换，相当于两个键值对交换了位置
Sub kvswap( ByRef dict,ByVal key1,ByVal key2 )
call kswap( dict,key1,key2 )
call vswap( dict,key1,key2 )
End Sub
' 修改一对键值对，如果存在则修改，否则向尾部添加
Sub Edit(ByRef dict,ByVal key, ByRef val)
if typename(dict) <> "Dictionary" then set dict = Create()
if dict.Exists(key) Then
if isObject(val) Then
dim stype : stype = typename( val )
if stype = "Field" then '如果类型为Field字段类型
if typename( val.value ) = "Byte()" then
set dict(key) = val.value
else
dict(key) = val.value
end if
else
set dict(key) = val
end if
Else
dict(key) = val
End If
else
dict.add key,val
end if
End Sub
'判断dict中是否存在某个键值链
'比如POP_MVC.KeyExists( dict, "a.b.c" , "." )
Function KeyExists( ByVal dict, ByVal keys , ByVal sep )
if typename(dict) <> "Dictionary" then
KeyExists = False : Exit Function
end if
dim arr,i,temp,cnt
arr = split( keys , sep )
cnt = ubound( arr )
for i = 0 to cnt
if dict.exists( arr(i) ) then
if i <> cnt then
if typename( dict(arr(i) ) ) = "Dictionary" then
set dict = dict( arr(i) )
else
KeyExists = False : Exit Function
end if
end if
else
KeyExists = False : Exit Function
end if
next
KeyExists = true
End Function
'''''''''''查找函数
' 判断某个值是否存在于数组中，返回True或者False
Function Exists( ByRef dict, ByRef val )
Exists = (Not isEmpty( Search(dict,val) ))
End Function
' 在dict中搜索find，如果存在则返回键名，否则返回Empty
Function Search( ByRef dict, ByRef val )
dim key
for each key in dict
if POP_MVC.isScalar( dict(key) ) AND dict(key) = val Then
Search = key
Exit Function
End If
next
End Function
'''''''''''数组函数
' 将键名联接起来，如果只提供一个参数，则默认分隔符为空字符""
' 如果参数为数组，则第一个参数为Dictionary对象，第二个参数为delimiter
Function KeyJoin( ByRef args )
dim delimiter,dict
delimiter = ""
if isArray(args) then
if ubound( args ) > 0 then
delimiter = CStr(args(1))
end if
if isObject( args(0) ) then
set dict = args(0)
else
dict = args(0)
end if
else
set dict = args
end if
KeyJoin = ""
if Typename( dict ) = "Dictionary" then
KeyJoin = Join( dict.keys , delimiter )
end if
end function
' 创建一个空对象
Function Create()
set Create = D_
End Function
' 克隆一个对象
Function Clone( ByRef Dict )
on error resume next
Dim newDict,key
Set newDict = Create()
For Each key in Dict
if isObject ( Dict(key) ) Then
newDict.Add key, Me.Clone(Dict(key))
Else
newDict.Add key, Dict(key)
End If
Next
newDict.CompareMode = Dict.CompareMode
Set Clone = newDict
set newDict = nothing
Call L_("POPASP_DICTIONARY.Clone")
End Function
' 将值连接起来，如果只提供一个参数，则默认分隔符为空字符""
' 如果参数为数组，则第一个参数为Dictionary对象，第二个参数为delimiter
Function ItemJoin( ByRef args )
dim delimiter,dict
delimiter = ""
if isArray(args) then
if ubound( args ) > 0 then
delimiter = CStr(args(1))
end if
if isObject( args(0) ) then
set dict = args(0)
else
dict = args(0)
end if
else
set dict = args
end if
ItemJoin = ""
if Typename( dict ) = "Dictionary" then
ItemJoin = Join( dict.items , delimiter )
end if
end function
' 合并两个对象
' 类似于PHP中的 array_merge，如果两个对象中同时存在某键，后者覆盖前者
Function Merge( ByRef dict1,ByRef dict2 )
dim key,dict
set dict = Me.Clone(dict1)
For Each key in dict2
Me.Edit dict,key,dict2(key)
Next
set Merge = dict
set dict = nothing
End Function
' 移除dict中重复的值(不能有对象)并将剩余的值返回一个数组（原dict不动）
Function Unique( ByRef dict )
Unique = POP_MVC.Array.Unique( dict.Items )
End Function
'用回调函数迭代地将dict简化为单一的值
Function Reduce( ByRef dict,ByRef func,ByRef initial )
Reduce = POP_MVC.Array.Reduce( dict.items,func,initial )
End Function
'计算dict中所有值的乘积
Function Product( ByRef dict )
Product = POP_MVC.Array.Product( dict.items )
End Function
'''''''''''过滤函数
'用回调函数过滤数组中的单元
Function [Filter]( Byref dict, Byref callback )
dim bool,ret,key
for each key in dict
Execute "bool = " & callback & "( key, dict(key) )"
if bool then
Push ret,key,dict(key)
end if
next
if isObject( ret ) Then
set [Filter] = ret
else
set [Filter] = Create()
end if
End Function
''''''''''''集合函数
' 计算对象的差集
' 类似于PHP中的 array_diff_key，返回一个对象，该对象包括了所有在 dict1 中但是不在 dict2 中键名的值。注意比较的是键名。
Function Diff ( ByRef dict1,ByRef dict2 )
dim key
set dict = Clone(dict1)
for each key in dict2
if dict.Exists( key ) then
dict.remove(key)
end if
next
set Diff = dict
set dict = nothing
End Function
' 计算对象的交集
' 类似于PHP中的 array_intersect_key，返回一个对象，该对象包括了所有在 dict1 中同时存在于 dict2 中键名的值。注意比较的是键名。
Function Intersect ( ByRef dict1,ByRef dict2 )
on error resume next
dim key
set dict = Clone(dict1)
for each key in dict
if Not dict2.Exists( key ) then
dict.remove(key)
end if
next
set Intersect = dict
set dict = nothing
End Function
' 用src_dict中的数据更新dst_dict中也存在的键
Private Function Update ( ByRef dst_dict, ByRef src_dict )
dim key
set dict = Clone(dst_dict)
for each key in dict
if src_dict.Exists(key) Then
Edit dict,key,src_dict(key)
End If
next
Set Update = dict
set dict = nothing
End Function
''''''''''dict排序函数，全部是在dict自身上进行操作''''''''''
' 对dict按照字符串值正向排序
Sub sort( ByRef dict )
call AscSortByFunc( dict , "POP_MVC.String.cmp")
End Sub
' 对dict按照字符串值逆向排序
Sub rsort( ByRef dict )
call DescSortByFunc( dict , "POP_MVC.String.cmp")
End Sub
' 对dict按照键名正向排序
Sub ksort( ByRef dict )
call AscKeySortByFunc( dict , "POP_MVC.String.cmp")
End Sub
' 对dict按照键名逆向排序
Sub krsort( ByRef dict )
call DescKeySortByFunc( dict , "POP_MVC.String.cmp")
End Sub
' 对dict按照字符串值正向排序，并且忽略大小写
Sub casesort( ByRef dict )
call AscSortByFunc( dict , "POP_MVC.String.casecmp")
End Sub
' 对dict按照字符串值逆向排序，并且忽略大小写
Sub casersort( ByRef dict )
call DescSortByFunc( dict , "POP_MVC.String.casecmp")
End Sub
' 对dict按照键名正向排序，并且忽略大小写
Sub caseksort( ByRef dict )
call AscKeySortByFunc( dict , "POP_MVC.String.casecmp")
End Sub
' 对dict按照键名逆向排序，并且忽略大小写
Sub casekrsort( ByRef dict )
call DescKeySortByFunc( dict , "POP_MVC.String.casecmp")
End Sub
' 用“自然排序”算法按照字符串值正向排序
Sub natsort( ByRef dict )
call AscSortByFunc( dict , "POP_MVC.String.natcmp")
End Sub
' 用“自然排序”算法按照字符串值逆向排序
Sub natrsort( ByRef dict )
call DescSortByFunc( dict , "POP_MVC.String.natcmp")
End Sub
' 用“自然排序”算法按照键名正向排序
Sub natksort( ByRef dict )
call AscKeySortByFunc( dict , "POP_MVC.String.natcmp")
End Sub
' 用“自然排序”算法按照键名逆向排序
Sub natkrsort( ByRef dict )
call DescKeySortByFunc( dict , "POP_MVC.String.natcmp")
End Sub
' 用“自然排序”算法按照字符串值正向排序 ，并且忽略大小写
Sub casenatsort( ByRef dict )
call AscSortByFunc( dict , "POP_MVC.String.casenatcmp")
End Sub
' 用“自然排序”算法按照字符串值逆向排序 ，并且忽略大小写
Sub casenatrsort( ByRef dict )
call DescSortByFunc( dict , "POP_MVC.String.casenatcmp")
End Sub
' 用“自然排序”算法按照键名正向排序 ，并且忽略大小写
Sub casenatksort( ByRef dict )
call AscKeySortByFunc( dict , "POP_MVC.String.casenatcmp")
End Sub
' 用“自然排序”算法按照键名逆向排序 ，并且忽略大小写
Sub casenatkrsort( ByRef dict )
call DescKeySortByFunc( dict , "POP_MVC.String.casenatcmp")
End Sub
'按用户自定义的比较函数根据值进行排序
Sub usort( ByRef dict,ByRef funcComp )
dim i,j,cnt,bool,arr
arr = dict.keys
cnt = ubound(arr)
for i = 0 to cnt-1
for j = i+1 to cnt
Execute "bool = " & funcComp & "( dict(arr(i)),dict(arr(j)) )"
if bool > 0 then
call kvswap(dict, arr(i),arr(j) )
call POP_MVC.Array.swap( arr,i,j )
end if
next
next
End Sub
'使用用户自定义的比较函数根据键名进行排序
Sub uksort( ByRef dict,ByRef funcComp )
dim i,j,cnt,bool,arr
arr = dict.keys
cnt = ubound(arr)
for i = 0 to cnt-1
for j = i+1 to cnt
Execute "bool = " & funcComp & "( arr(i),arr(j) )"
if bool > 0 then
call kvswap(dict, arr(i),arr(j) )
call POP_MVC.Array.swap( arr,i,j )
end if
next
next
End Sub
'按自定义函数进行升序排序，
Public Sub AscSortByFunc( ByRef dict , ByRef funcComp )
call sortByFunc( dict , funcComp,false )
End Sub
'按自定义函数进行升序排序，
Public Sub DescSortByFunc( ByRef dict , ByRef funcComp )
call sortByFunc( dict , funcComp,true )
End Sub
'对dict按照键名正向排序
Public Sub AscKeySortByFunc( ByRef dict , ByRef funcComp )
call ksortByFunc( dict , funcComp,false )
End Sub
'对dict按照键名逆向排序
Public Sub DescKeySortByFunc( ByRef dict , ByRef funcComp )
call ksortByFunc( dict , funcComp,true )
End Sub
''''''''''''''其他函数
'返回一个单元顺序相反的对象
Function Reverse ( ByRef dict )
dim key,newDict
set newDict = Create()
for each key in dict
Unshift newDict,key,dict(key)
next
set Reverse = newDict
set newDict = nothing
End Function
' 保留键名将dict打乱
sub shuffle( ByRef dict )
dim keys
keys = dict.keys
call POP_MVC.Array.shuffle( keys )
set keys = POP_MVC.Array.toDict( keys )
set keys = Flip(keys)
set dict = Merge( keys,dict )
set keys = nothing
End Sub
' 交换对象中的键和值
Function Flip( ByRef dict )
set Flip = Combine( dict.items,dict.keys )
End Function
'创建一个新对象，用一个数组的值作为其键名，另一个数组的值作为其值
' 成功返回dict，否则返回Empty
Function Combine( ByRef keys,ByRef items )
dim bk,bv,i,dict
' 有一个不是数组，都退出
if not isArray(keys) or not isArray(items) then Exit Function
bk = ubound(keys) : bv = ubound(items)
' 两者长度不同，也退出
if bk <> bv or bk = 0 or bv = 0 then Exit Function
set dict = Create()
for i = lbound(keys) to bk
dict.add CStr(keys(i)),items(i)
next
set Combine = dict
set dict = nothing
End Function
'将回调函数作用到给定对象的单元上，并返回一个新对象，键名保留不变
Function Map( ByRef dict,ByRef callback )
dim ret,key
for each key in dict
Execute "Me.Push ret,key," & callback & "(dict(key))"
next
set Map = ret
End Function
'按字符串值对dict使用funcComp进行排序
'isR是否为逆向，正向false,逆向true
Private Sub sortByFunc( ByRef dict , ByRef funcComp, ByRef isR )
dim i,j,cnt,bool,arr
arr = dict.keys
cnt = ubound(arr)
for i = 0 to cnt-1
for j = i+1 to cnt
bool = false
if Not is_empty(sortByDate) And isDate( dict( arr(i) ) ) And isDate( dict( arr(j) ) ) Then
bool = ( DateDiff("s",dict(arr(j)),dict( arr(i) )) > 0 )
elseif Not is_empty(sortByNumeric) And isNumeric( dict( arr(i) ) ) And isNumeric( dict( arr(j) ) ) Then
bool = ( dict(arr(i)) > dict(arr(j)) )
else
Execute "bool = ( " & funcComp & "( dict(arr(i)),dict(arr(j)) )>0 )"
end if
if (not isR and bool) OR (isR and not bool) then
call kvswap(dict, arr(i),arr(j) )
call POP_MVC.Array.swap( arr,i,j )
end if
next
next
End Sub
'按键名对dict使用funcComp进行排序
'isR是否为逆向，正向false,逆向true
Private Sub ksortByFunc( ByRef dict , ByRef funcComp, ByRef isR )
dim i,j,cnt,bool,arr
arr = dict.keys
cnt = ubound(arr)
for i = 0 to cnt-1
for j = i+1 to cnt
bool = false
if Not is_empty(sortByDate) And isDate( arr(i) ) And isDate( arr(j) ) Then
bool = ( DateDiff("s",arr(j),arr(i)) > 0 )
elseif Not is_empty(sortByNumeric) And isNumeric( arr(i) ) And isNumeric( arr(j) ) Then
bool = ( arr(i) > arr(j) )
else
Execute "bool = ( " & funcComp & "( arr(i),arr(j) )>0 )"
end if
if (not isR and bool) OR (isR and not bool) then
call kvswap(dict, arr(i),arr(j) )
call POP_MVC.Array.swap( arr,i,j )
end if
next
next
End Sub
End Class
%>