ASP/WScript/VBScript实现ActiveX COM对象管理器(2)

!本文可能 超过1年没有更新,今后内容也许不会被维护或者支持,部分内容可能具有时效性,涉及技术细节或者软件使用方面,本人不保证相应的兼容和可操作性。

上面一篇已经介绍了关于对象管理器类cObjectManager,这篇主要讲在ASP中实现持续性对象管理器,大家知道,在ASP技术中,Global.asa是一个特殊的文件,其随着用户访问网站而启用,并在整个会话期内有效,我们可以将cObjectManager字典对象Scripting.Dictionary单独分离到这个文件中,该怎么做才能让所有ASP文件都能共享这一个对象呢?其实我们只需要在Global.asa中应用<object runat=”server”></object>这样的标签就可以创建一个静态的全局对象了。

语法:

1
2
3
4
<object runat="server" scope="scope" id="id"
{progid="progID"|classid="classID"}>
....
</object>

scope 设置对象的作用域(作用范围)(Session 或者 Application)。
id 为对象指定一个唯一的 id。
ProgID 与 ClassID 关联的 id。ProgID 的格式是:[Vendor.]Component[.Version]。ProgID 或 ClassID 必需被指定。
ClassID 为 COM 类对象指定唯一的 id。ProgID 或 ClassID 必需被指定。

global.asa

1
2
<object runat="server" scope="application" id="objMgrDict"
progid="Scripting.Dictionary"></object>

然后我们只需要简单修改一下cObjectManager类:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Class cObjectManager
 Public IsPersist
 Private objHost
 Private objDict
 
 ' 自动初始化可用的环境宿主
 ' Server - ASP 环境
 ' WScript,WSH - Windows Script 宿主
 Private Sub InitHost()
  Dim objDefaultHosts, i
  Set objHost = Nothing
  objDefaultHosts = Array("Server", "WScript", "WSH")
  For i = 0 To UBound(objDefaultHosts)
    If IsObject(Eval(objDefaultHosts(i))) Then
      Set objHost = Eval(objDefaultHosts(i))
      Exit For
    End If
  Next
  ' 如果不定义全局字典,请确保此处始终是False
  IsPersist = False
 End Sub
 
 ' 构造函数
 Private Sub Class_Initialize()
   Call InitHost()
   ' 建立对象字典,直接引用全局字典
   Set objDict = Application.StaticObjects("objMgrDict")
 End Sub
 
 ' 析构函数
 Private Sub Class_Terminate()
   If IsValidObject(objDict) And (Not IsPersist) Then
	DeleteAllObjects ' 删除所有对象及引用
	objDict.RemoveAll
   End If
   Set objDict = Nothing
   Set objHost = Nothing
 End Sub
 
 ' 得到已缓存的对象数目
 Public Function GetObjectsCount()
  GetObjectsCount = objDict.Count
 End Function
 
 ' 设置环境宿主类型
 ' Example :
 ' Object.Host = Server
 Public Property Let Host(obj) 
   Set objHost = obj
 End Property
 
 ' 创建COM对象
 Private Function CreateActiveXObject(progName)
  If objHost Is Nothing Then
   ' 如果环境宿主不存在就直接调用语言特性CreateObject
   Set CreateActiveXObject = CreateObject(progName)
  Else
   Set CreateActiveXObject = objHost.CreateObject(progName)
  End If
 End Function
 
 ' 建立新对象,支持数组组件名
 ' 如果传入数组组件名,那么将依次尝试创建对象
 ' 直到建立可用对象位置
 Public Function NewObject(progName)
   On Error Resume Next
   If Not IsArray(progName) Then
    Set NewObject = CreateActiveXObject(progName)
   Else
   Dim i
   For i=0 To UBound(progName)
    Set NewObject = CreateActiveXObject(progName(i))
    If Err.Number=0 And IsValidObject(NewObject) Then
     Exit For
    ElseIf Err.number = -2147352567 Then
     Err.Clear
  Else
   Err.Clear
   Exit For
    End If
   Next
  End If
  If Err.Number<>0 Then
   Err.Clear
   Set NewObject = Nothing
  End If
 End Function
 
 ' 判断建立的对象是否有效
 Private Function IsValidObject(obj)
  IsValidObject = (Not (obj Is Nothing) And IsObject(obj))
 End Function
 
 ' 获取字典缓存或者系统内可用的对象,支持数组
 Private Function GetExistsObject(progName, useGetObject)
    Set GetExistsObject = Nothing
  If Not IsArray(progName) Then
    If objDict.Exists(progName) Then
      Set GetExistsObject = objDict.Item(progName)
    ElseIf useGetObject Then
	  ' 如果useGetObject=true并且字典缓存内对象不存在,
	  ' 那么就通过GetObject来获取系统内缓存的对象,
	  ' 一般情况下不建议直接使用系统缓存的对象,
	  ' 所以正常情况下useGetObject=false
      On Error Resume Next
      Set GetExistsObject = objHost.GetObject("",progName)
      If IsValidObject(GetExistsObject) Then
        Exit Function
      End If
      Set GetExistsObject = Nothing
      If Err.Number<>0 Then
        Err.Clear
      End If
    End If
  Else
    Dim i
    For i=0 To UBound(progName)
      Set GetExistsObject = GetExistsObject(progName(i), useGetObject)
      If IsValidObject(GetExistsObject) Then Exit Function
    Next
  End If
 End Function
 
 '  获取对象实例,支持数组对象名称,如果使useGetObject=true
 '  那么字典获取不到的情况下将尝试使用GetObject获取系统内对象
 Public Function GetObjectInstance(progName, useGetObject)
  'If TypeName(useGetObject) = "Error" Then
  '  useGetObject = False
  'End If
 
  Set GetObjectInstance = GetExistsObject(progName, useGetObject)
  If IsValidObject(GetObjectInstance) Then Exit Function
 
  On Error Resume Next
  If Not IsArray(progName) Then
    Set GetObjectInstance = CreateActiveXObject(progName)
    If Err.Number<>0 Or Not IsValidObject(GetObjectInstance) Then
      Err.Clear
      Set GetObjectInstance = Nothing
    Else
      objDict.Add progName, GetObjectInstance
      Exit Function
    End If
  Else
    Dim i
    For i=0 To UBound(progName)
      Set GetObjectInstance = GetObjectInstance(progName(i), useGetObject)
      If IsValidObject(GetObjectInstance) Then Exit Function
    Next
  End If
 End Function
 
 '  删除一个对象并解除引用
 Public Sub DeleteObject(progName)
  If Not IsArray(progName) Then
    If objDict.Exists(progName) Then
      Set objDict.Item(progName) = Nothing
	  objDict.Remove progName
	End If
  Else
    Dim i
    For i=0 To UBound(progName)
      DeleteObject(progName(i))
    Next
  End If
 End Sub
 
 ' 删除所有对象并解除引用
 Public Sub DeleteAllObjects()
   Dim i,keys,items
   keys = objDict.Keys
   items = objDict.Items
   For i = 0 To objDict.Count-1
     DeleteObject keys(i)
   Next
 End Sub
End Class

但是记得要设置cObjectManager的IsPersist=True哦,要不在cObjectManager对象生存期到了后会DeleteAllObjects的。如下所示:

1
2
3
4
5
6
7
8
9
10
<%
Dim objMgr
 
Set objMgr = New cObjectManager
' 重要,标记为持续对象,避免objMgr销毁时删除所有创建对象
objMgr.IsPersist = True
 
' TODO: 处理相关事务
Set objMgr = Nothing
%>

静态全局字典对象管理器1.png静态全局字典对象管理器2.png

好了相关内容就介绍到这里,有什么问题欢迎讨论。

相关下载:ActiveX COM对象管理器.zip,注意的是global.asa必须位于网站的根目录下。

若无特别说明,本网站文章均为原创,原则上这些文章不允许转载,但是如果阁下是出于研究学习目的可以转载到阁下的个人博客或者主页,转载遵循创作共同性“署名-非商业性使用-相同方式共享”原则,请转载时注明作者出处谢绝商业性、非署名、采集站、垃圾站或者纯粹为了流量的转载。谢谢合作!
请稍后...

发表评论

电子邮件地址不会被公开。 必填项已用*标注

*