解决在不支持FSO空间中无法使用Scripting.Dictionary对象的方法

前些天装了一个 IT学习者网站访问统计系统 在本机调试一切正常后传到空间却显示服务器内部错误，为弄明白什么错误，我到 IE工具→Internet选项→高级→取消 显示友好HTTP 错误信息，然后刷新后显示了错误原因：

Microsoft VBScript 运行时错误 错误 '800a01ad'

ActiveX 部件不能创建对象: 'Scripting.Dictionary'

/languages.ASP，行 29

languages.asp原程序

<%
Dim SelectedTimeZone,SelectedLanguage

if request.form("timeZone")<>"" then
SelectedTimeZone = request.form("timeZone")
response.cookies("TimeZone") = SelectedTimeZone
else
if request.cookies("TimeZone")="" then
SelectedTimeZone = TimeZone
response.cookies("TimeZone") = TimeZone
else
SelectedTimeZone = request.cookies("TimeZone")
end if
end if

if request.form("Language")<>"" then
SelectedLanguage = request.form("Language")
response.cookies("Language") = SelectedLanguage
else
if request.cookies("Language") = "" then
SelectedLanguage = Language
response.cookies("Language") = SelectedLanguage
else
SelectedLanguage = request.cookies("Language")
end if
end if

Dim Lang
Set Lang = CreateObject("Scripting.Dictionary")
select case SelectedLanguage
case "CHS"
'Chinese Simplified
%>
<!-- #include file="language/CHS.asp"-->
<%
case "CHT"
'Chinese Traditional
%>
<!-- #include file="language/CHT.asp"-->
<%
case "ENG"
'English
%>
<!-- #include file="language/ENG.asp"-->
<%

end select


function clearLanguage()
on error resume next
clearLanguage = Lang.removeAll
set clearLanguage = nothing
end function
%>

我找到languages.asp，行 29 这里的语句是Set Lang = CreateObject("Scripting.Dictionary")，显然CreateObject("Scripting.Dictionary")这个是必需FSO支持的，而我的空间刚好不支持FSO，于是我明白了为什么这个程序不能运行的原因了，但是我非常想使用这个统计系统，不禁抱怨一个小小的统计系统还要FSO支持，真郁闷！根据自己所学，当然也查了些资料，于是便想到Dictionary 对象等价于 PERL 联合数组。项目可以是数据的任何形式，并存储在数组中。每个项目都与一个具有唯一性的键相联。该键用于取得单个项目，并且通常是整数或字符串，但也可以是除数组以外的任何类型。

根据这个"模版类"的功能，我运用我所学分析，应该可以不用FSO支持而用一个“字典类”来同Scripting.Dictionary等价的，于是遍写了下面的一个"字典类"。

此类同Scripting.Dictionary对象的使用没有任何的区别,所以以前是根据Scripting.Dictionary来写的程序,不用怎样的修改就可以使用到此类上.此类并且还比Scripting.Dictionary多了一个Insert方法:Insert(sKey,nKey,nval,nMethod),此方法是将新字典数据插入到存在的以sKey为Key的字典位置.nKey,nVal是新字典数据的Key值和Value值.nMethod则是插入的位置.如果此值为1,"b","black"或空值,则是插入到以sKey为Key的字典数据后面,否则前面.

Class DictionaryClass
Dim ArryObj() '使用该二维数组来做存放数据的字典
Dim MaxIndex 'MaxIndex则是ArryObj开始的最大上标
Dim CurIndex '字典指针,用来指向ArryObj的指针
Dim C_ErrCode '错误代码号

Private Sub Class_Initialize
CurIndex=0 '从下标0开始
C_ErrCode=0 '0表示没有任何错误
MaxIndex=50 '默认的大小
Redim ArryObj(1,MaxIndex) '定义一个二维的数组
End Sub

Private Sub Class_Terminate
Erase ArryObj '清除数组
End Sub

Public Property Get ErrCode '返回错误代码
ErrCode=C_ErrCode
End Property

Public Property Get Count '返回数据的总数,只返回CurIndex当前值-1即可.
Count=CurIndex
End Property

Public Property Get Keys '返回字典数据的全部Keys,返回数组.
Dim KeyCount,ArryKey(),I
KeyCount=CurIndex-1
Redim ArryKey(KeyCount)
For I=0 To KeyCount
ArryKey(I)=ArryObj(0,I)
Next
Keys=ArryKey
Erase ArryKey
End Property

Public Property Get Items '返回字典数据的全部Values,返回数组.
Dim KeyCount,ArryItem(),I
KeyCount=CurIndex-1
Redim ArryItem(KeyCount)
For I=0 To KeyCount
If isObject(ArryObj(1,I)) Then
Set ArryItem(I)=ArryObj(1,I)
Else
ArryItem(I)=ArryObj(1,I)
End If
Next
Items=ArryItem
Erase ArryItem
End Property


Public Property Let Item(sKey,sVal) '取得sKey为Key的字典数据
If sIsEmpty(sKey) Then
Exit Property
End If
Dim i,iType
iType=GetType(sKey)
If iType=1 Then '如果sKey为数值型的则检查范围
If sKey>CurIndex Or sKey<1 Then
C_ErrCode=2
Exit Property
End If
End If
If iType=0 Then
For i=0 to CurIndex-1
If ArryObj(0,i)=sKey Then
If isObject(sVal) Then
Set ArryObj(1,i)=sVal
Else
ArryObj(1,i)=sVal
End If
Exit Property
End If
Next
ElseIf iType=1 Then
sKey=sKey-1
If isObject(sVal) Then
Set ArryObj(1,sKey)=sVal
Else
ArryObj(1,sKey)=sVal
End If
Exit Property
End If
C_ErrCode=2 'ErrCode为2则是替换或个为sKey的字典数据时找不到数据
End Property

Public Property Get Item(sKey)
If sIsEmpty(sKey) Then
Item=Null
Exit Property
End If
Dim i,iType
iType=GetType(sKey)
If iType=1 Then '如果sKey为数值型的则检查范围
If sKey>CurIndex Or sKey<1 Then
Item=Null
Exit Property
End If
End If
If iType=0 Then
For i=0 to CurIndex-1
If ArryObj(0,i)=sKey Then
If isObject(ArryObj(1,i)) Then
Set Item=ArryObj(1,i)
Else
Item=ArryObj(1,i)
End If
Exit Property
End If
Next
ElseIf iType=1 Then
sKey=sKey-1
If isObject(ArryObj(1,sKey)) Then
Set Item=ArryObj(1,sKey)
Else
Item=ArryObj(1,sKey)
End If
Exit Property
End If
Item=Null
End Property

Public Sub Add(sKey,sVal) '添加字典
'On Error Resume Next
If Exists(sKey) Or C_ErrCode=9 Then
C_ErrCode=1 'Key值不唯一(空的Key值也不能添加数字)
Exit Sub
End If
If CurIndex>MaxIndex Then
MaxIndex=MaxIndex+1 '每次增加一个标数,可以按场合需求改为所需量
Redim Preserve ArryObj(1,MaxIndex)
End If
ArryObj(0,CurIndex)=Cstr(sKey) 'sKey是标识值,将Key以字符串类型保存
if isObject(sVal) Then
Set ArryObj(1,CurIndex)=sVal 'sVal是数据
Else
ArryObj(1,CurIndex)=sVal 'sVal是数据
End If
CurIndex=CurIndex+1
End Sub

Public Sub Insert(sKey,nKey,nVal,sMethod)
If Not Exists(sKey) Then
C_ErrCode=4
Exit Sub
End If
If Exists(nKey) Or C_ErrCode=9 Then
C_ErrCode=4 'Key值不唯一(空的Key值也不能添加数字)
Exit Sub
End If
sType=GetType(sKey) '取得sKey的变量类型
Dim ArryResult(),I,sType,subIndex,sAdd
ReDim ArryResult(1,CurIndex) '定义一个数组用来做临时存放地
if sIsEmpty(sMethod) Then sMethod="b" '为空的数据则默认是"b"
sMethod=lcase(cstr(sMethod))
subIndex=CurIndex-1
sAdd=0
If sType=0 Then '字符串类型比较
If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
For I=0 TO subIndex
ArryResult(0,sAdd)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If
If ArryObj(0,I)=sKey Then '插入数据
sAdd=sAdd+1
ArryResult(0,sAdd)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sAdd)=nVal
Else
ArryResult(1,sAdd)=nVal
End If
End If
sAdd=sAdd+1
Next
Else
For I=0 TO subIndex
If ArryObj(0,I)=sKey Then '插入数据
ArryResult(0,sAdd)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sAdd)=nVal
Else
ArryResult(1,sAdd)=nVal
End If
sAdd=sAdd+1
End If
ArryResult(0,sAdd)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If
sAdd=sAdd+1
Next
End If
ElseIf sType=1 Then
sKey=sKey-1 '减1是为了符合日常习惯(从1开始)
If sMethod="1" Or sMethod="b" Or sMethod="back" Then '将数据插入sKey的后面
For I=0 TO sKey '取sKey前面部分数据
ArryResult(0,I)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I)=ArryObj(1,I)
Else
ArryResult(1,I)=ArryObj(1,I)
End If
Next
'插入新的数据
ArryResult(0,sKey+1)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sKey+1)=nVal
Else
ArryResult(1,sKey+1)=nVal
End If
'取sKey后面的数据
For I=sKey+1 TO subIndex
ArryResult(0,I+1)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)
Else
ArryResult(1,I+1)=ArryObj(1,I)
End If
Next
Else
For I=0 TO sKey-1 '取sKey-1前面部分数据
ArryResult(0,I)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I)=ArryObj(1,I)
Else
ArryResult(1,I)=ArryObj(1,I)
End If
Next
'插入新的数据
ArryResult(0,sKey)=nKey
If IsObject(nVal) Then
Set ArryResult(1,sKey)=nVal
Else
ArryResult(1,sKey)=nVal
End If
'取sKey后面的数据
For I=sKey TO subIndex
ArryResult(0,I+1)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,I+1)=ArryObj(1,I)
Else
ArryResult(1,I+1)=ArryObj(1,I)
End If
Next
End If
Else
C_ErrCode=3
Exit Sub
End If
ReDim ArryObj(1,CurIndex) '重置数据
For I=0 To CurIndex
ArryObj(0,I)=ArryResult(0,I)
If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)
Else
ArryObj(1,I)=ArryResult(1,I)
End If
Next
MaxIndex=CurIndex
Erase ArryResult
CurIndex=CurIndex+1 'Insert后数据指针加一
End Sub

Public Function Exists(sKey) '判断存不存在某个字典数据
If sIsEmpty(sKey) Then
Exists=False
Exit Function
End If
Dim I,vType
vType=GetType(sKey)
If vType=0 Then
For I=0 To CurIndex-1
If ArryObj(0,I)=sKey Then
Exists=True
Exit Function
End If
Next
ElseIf vType=1 Then
If sKey<=CurIndex And sKey>0 Then
Exists=True
Exit Function
End If
End If
Exists=False
End Function

Public Sub Remove(sKey) '根据sKey的值Remove一条字典数据
If Not Exists(sKey) Then
C_ErrCode=3
Exit Sub
End If
sType=GetType(sKey) '取得sKey的变量类型
Dim ArryResult(),I,sType,sAdd
ReDim ArryResult(1,CurIndex-2) '定义一个数组用来做临时存放地
sAdd=0
If sType=0 Then '字符串类型比较
For I=0 TO CurIndex-1
If ArryObj(0,I)<>sKey Then
ArryResult(0,sAdd)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If
sAdd=sAdd+1
End If
Next
ElseIf sType=1 Then
sKey=sKey-1 '减1是为了符合日常习惯(从1开始)
For I=0 TO CurIndex-1
If I<>sKey Then
ArryResult(0,sAdd)=ArryObj(0,I)
If IsObject(ArryObj(1,I)) Then
Set ArryResult(1,sAdd)=ArryObj(1,I)
Else
ArryResult(1,sAdd)=ArryObj(1,I)
End If
sAdd=sAdd+1
End If
Next
Else
C_ErrCode=3
Exit Sub
End If
MaxIndex=CurIndex-2
ReDim ArryObj(1,MaxIndex) '重置数据
For I=0 To MaxIndex
ArryObj(0,I)=ArryResult(0,I)
If isObject(ArryResult(1,I)) Then
Set ArryObj(1,I)=ArryResult(1,I)
Else
ArryObj(1,I)=ArryResult(1,I)
End If
Next
Erase ArryResult
CurIndex=CurIndex-1 '减一是Remove后数据指针
End Sub

Public Sub RemoveAll '全部清空字典数据,只Redim一下就OK了
Redim ArryObj(MaxIndex)
CurIndex=0
End Sub

Public Sub ClearErr '重置错误
C_ErrCode=0
End Sub

Private Function sIsEmpty(sVal) '判断sVal是否为空值
If IsEmpty(sVal) Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If
If IsNull(sVal) Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If
If Trim(sVal)="" Then
C_ErrCode=9 'Key值为空的错误代码
sIsEmpty=True
Exit Function
End If
sIsEmpty=False
End Function

Private Function GetType(sVal) '取得变量sVal的变量类型
dim sType
sType=TypeName(sVal)
Select Case sType
Case "String"
GetType=0
Case "Integer","Long","Single","Double"
GetType=1
Case Else
GetType=-1
End Select
End Function

End Class

'/*用法:
'/*Dim objDic,sKey,I,sValue
'/*Set objDic=New DictionaryClass
'/*Add方法:Add(字典的Key值,字典数据) 说明:如果"字典的Key值"已存在则Add方法失败
'/*objDic.Add "a","字母a" 'Add方法
'/*objDic.Add "b","字母b"
'/*objDic.Add "c","字母c"
'/*'Insert方法:Insert(被插入位置的Key值,新的字典Key值,新的字典数据,插入方式:b后面,f前面)
'/*objDic.Insert "a","aa","字母aa","b"
'/*objDic.Insert "b","bb","字母bb","f"
'/*'Exists方法,返回是否存在以"b"为Key值的字典数据
'/*Response.Write objDic.Exists("b")
'/*sKey=objDic.Keys '获取Keys集合,(数组集合)
'/*sValue=objDic.Items '获取字典数据集合(数组集合)
'/*objDic.Item("a")="aaaaaa" 'Item属性方法:返回或设置对应Key的字典数据
'/*For I=0 To objDic.Count-1 'Count属性返回有多少条字典数据
'/* 'Item属性方法:返回或设置对应Key的字典数据
'/* Response.Write objDic.Item(sKey(I))&"<br>"
'/*Next
'/*Remove方法:Remove(字典的Key值)
'/*objDic.Remove("a") '删除Key值为a的字典数据
'/*objDic.RemoveAll '清空字典数据
'/*objDic.ErrCode '返回操作字典时的一些错误代码(调试时用)
'/*objDic.ClearErr '清空错误代码(调试时用)
'/*Set objDic=nothing
'/*说明:
'/*"字典的Key值":除了Add方法外,都可以用字符串或序数(1,2..)使用

于是我在程序中用这个"字典类"取代CreateObject("Scripting.Dictionary")后在上传，运行，终于搞定程序运行正常！终于可以用这统计了，不过成功之余也不禁感叹，没有FSO的支持，要实现短短的一句CreateObject("Scripting.Dictionary")的功能是多么的麻烦，也可见FSO在程序中的重要性了，很多时候不要FSO支持一个简单的程序也将变的冗长无比！

顺便也提供这个统计系统的原版下载以供大家参考研究或者使用
原始下载：http://www.itlearner.com/114down/s22/21492.shtml

我修改后的可以在没有FSO支持的空间运行的程序下载：
http://count.xqin.com/count.rar(后台：用户：xqin.com密码：xqin.com

演示：http://count.xqin.com

下面是这个统计系统中我修改后可以在没有FSO支持的空间中运行的languages.asp程序：欢迎大家交流，共同提高！
http://count.xqin.com/languages.txt

（出处：http://www.sheup.com）