(for Internet Explorer)
← ▼ ▲
↑
LifeGroupClass, LifeHandleClass (Version 2)
CaseA
WScript.echo "Returned"
Set object = CaseB()
WScript.echo "Returned"
object = Empty
Set object = CaseC()
WScript.echo "Returned"
object = Empty
Set object = CaseD()
WScript.echo "Returned"
object = Empty
CaseE
WScript.echo "Returned"
CaseF
WScript.echo "Returned"
WScript.echo "End of Main"
WScript.echo "もし、ここ以降でデストラクターが動くときは、"+_
"プログラム終了時にすべてのオブジェクトを削除する"+_
"ことによるデストラクター呼び出しです。"
Sub CaseA() '// 相互参照しているオブジェクトの削除
WScript.echo vbCRLF +"CaseA:"
Set a_handle = new RootHandleClass : a_handle.p.Name = "A1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "A2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
End Sub
Function CaseB() '// ハンドルを返すとき
WScript.echo vbCRLF +"CaseB:"
Set a_handle = new RootHandleClass : a_handle.p.Name = "B1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "B2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
Set CaseB = b_handle
End Function
Function CaseC() '// LefeGroup から外れるとき
WScript.echo vbCRLF +"CaseC:"
Set a_handle = new RootHandleClass : a_handle.p.Name = "C1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "C2"
Set c_handle = b_handle.p.CreateMember() : c_handle.p.Name = "C3"
a_handle.p.LifeGroup.Group.Remove c_handle.p
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
Set CaseC = c_handle
End Function
Function CaseD() '// ハンドルを複製するとき
WScript.echo vbCRLF +"CaseD:"
Set a_handle = new RootHandleClass : a_handle.p.Name = "D1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "D2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
Set CaseD = b_handle.p.GetReference()
End Function
Sub CaseE() '// 所属オブジェクトの参照カウンターが 0 から 1 に戻るとき
WScript.echo vbCRLF +"CaseE:"
Set a_handle = new RootHandleClass : a_handle.p.Name = "E1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "E2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
b_handle = Empty
Set b_handle = a_handle.p.GetReference()
End Sub
Sub CaseF() '// LefeGroup を再利用するとき
WScript.echo vbCRLF +"CaseF:"
For count = 1 To 2
Set a_handle = new RootHandleClass : a_handle.p.Name = "F1"
Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "F2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
a_handle = Empty
b_handle = Empty
Next
End Sub
Class MemberClass
Public Name
Public Reference
Public LifeGroup '// Don't write except for LifeGroupClass ■追加
Private Sub Class_Terminate()
WScript.echo Me.Name +": MemberClass::Class_Terminate"
End Sub
Public Sub DestroyReferences() '// ■追加
Me.Reference = Empty
End Sub
Public Function CreateMember()
Set CreateMember = Me.LifeGroup.Group.Add( new MemberClass )
End Function
Public Function GetReference()
Set GetReference = Me.LifeGroup.Group.Add( Me.Reference )
End Function
End Class
Class LifeGroupCounterClass
Public Group
Public CreatedMemberID
Public ReferenceCount
End Class
Class RootHandleClass
Public p '// Target object of this handle
Private Sub Class_Initialize()
Set group = new LifeGroupClass
group.AddHandle Me, new MemberClass
End Sub
Private Sub Class_Terminate()
WScript.echo Me.p.LifeGroup.CreatedMemberID &": RootHandleClass::Class_Terminate"
If not IsEmpty( Me.p.LifeGroup.Group ) Then _
Me.p.LifeGroup.Group.AddTerminated Me.p
End Sub
End Class
Class LifeHandleClass
Public p '// Target object of this handle
Private Sub Class_Terminate()
WScript.echo Me.p.LifeGroup.CreatedMemberID &": LifeHandleClass::Class_Terminate"
If not IsEmpty( Me.p.LifeGroup.Group ) Then _
Me.p.LifeGroup.Group.AddTerminated Me.p
End Sub
End Class
Class LifeGroupClass
Public Name
Public Objects
Public TerminatedObjects
Private m_CreatedMemberID
Private Sub Class_Initialize()
Set Me.Objects = CreateObject( "Scripting.Dictionary" )
Set Me.TerminatedObjects = CreateObject( "Scripting.Dictionary" )
m_CreatedMemberID = 0
End Sub
Private Sub Class_Terminate()
WScript.echo "LifeGroupClass::Class_Terminate"
End Sub
Public Sub AddHandle( Handle, Object )
If IsEmpty( Object.LifeGroup ) Then _
Set Object.LifeGroup = new LifeGroupCounterClass
If not IsEmpty( Object.LifeGroup.Group ) Then
If not Object.LifeGroup.Group Is Me Then
Err.Raise 1, "すでに別の LifeGroup に所属しているようです"
End If
If Object.LifeGroup.ReferenceCount = 0 Then
Me.TerminatedObjects.Remove Object.LifeGroup.CreatedMemberID
End If
Object.LifeGroup.ReferenceCount = Object.LifeGroup.ReferenceCount + 1
Else
Do
m_CreatedMemberID = m_CreatedMemberID + 1
If not Objects.Exists( m_CreatedMemberID ) Then _
Exit Do
Loop
Set Me.Objects( m_CreatedMemberID ) = Object
Set Object.LifeGroup.Group = Me
Object.LifeGroup.CreatedMemberID = m_CreatedMemberID
Object.LifeGroup.ReferenceCount = 1
End If
Set Handle.p = Object
End Sub
Public Function Add( Object )
Set Add = new LifeHandleClass
Me.AddHandle Add, Object
End Function
Public Sub Remove( Object )
If not Object.LifeGroup.Group Is Me Then Exit Sub
If not Me.Objects( Object.LifeGroup.CreatedMemberID ) Is Object Then Exit Sub
Object.DestroyReferences
Me.Objects.Remove Object.LifeGroup.CreatedMemberID
Object.LifeGroup.Group = Empty
Object.LifeGroup.CreatedMemberID = Empty
End Sub
Public Sub AddTerminated( Object )
If not Object.LifeGroup.Group Is Me Then Exit Sub
If not Me.Objects( Object.LifeGroup.CreatedMemberID ) Is Object Then Exit Sub
Object.LifeGroup.ReferenceCount = Object.LifeGroup.ReferenceCount - 1
If Object.LifeGroup.ReferenceCount = 0 Then
Set Me.TerminatedObjects( Object.LifeGroup.CreatedMemberID ) = Object
If Me.TerminatedObjects.Count = Me.Objects.Count Then
For Each a_object In Me.Objects.Items
a_object.DestroyReferences
a_object.LifeGroup = Empty
Next
Me.Objects.RemoveAll
Me.TerminatedObjects.RemoveAll
End If
End If
End Sub
End Class
ルート オブジェクトの中にある、相互参照しているオブジェクトのグループとなるオブジェクト。
グループに所属しているオブジェクト（ルート オブジェクトも含む）のハンドルがすべて参照され
なくなったら、相互参照を切るメソッド DestroyReferences を呼び出し、Class_Terminate が
呼び出されます。
ハンドルのメンバー p を介してオブジェクトを操作する必要があります。
A
B body
A body
B
LifeGroup
LifeHandleClass
p
LifeGroup
p
CaseA:
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
A1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
A2: MemberClass::Class_Terminate
Returned
CaseB:
1: RootHandleClass::Class_Terminate
Returned
2: LifeHandleClass::Class_Terminate
B1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
B2: MemberClass::Class_Terminate
CaseC:
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
C1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
C2: MemberClass::Class_Terminate
Returned
: LifeHandleClass::Class_Terminate
C3: MemberClass::Class_Terminate
CaseD:
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
Returned
1: LifeHandleClass::Class_Terminate
D2: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
D1: MemberClass::Class_Terminate
CaseE:
2: LifeHandleClass::Class_Terminate
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
E1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
E2: MemberClass::Class_Terminate
Returned
CaseF:
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
F1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
F2: MemberClass::Class_Terminate
1: RootHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
F1: MemberClass::Class_Terminate
LifeGroupClass::Class_Terminate
F2: MemberClass::Class_Terminate
Returned
End of Main
もし、ここ以降でデストラクターが動くときは、プログラム終了時にすべてのオブジェク
トを削除することによるデストラクター呼び出しです。
表示例：
検証コード
RootHandleClass
関連
→ LifeGroupClass (vbslib)
→ g_ObjectIDs
参考
← ▼ ▲
LifeGroupClass, LifeHandleClass (Version 1)
CaseA
WScript.echo "Returned"
Set object = CaseB()
WScript.echo "Returned"
object = Empty
Set object = CaseC()
WScript.echo "Returned"
object = Empty
CaseD
WScript.echo "Returned"
WScript.echo "End of Main"
WScript.echo "もし、ここ以降でデストラクターが動くときは、"+_
"プログラム終了時にすべてのオブジェクトを削除する"+_
"ことによるデストラクター呼び出しです。"
Sub CaseA() '// 相互参照しているオブジェクトの削除
WScript.echo vbCRLF +"CaseA:"
Set group = new LifeGroupClass : group.Name = "CaseA"
Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "A1"
Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "A2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
End Sub
Function CaseB() '// ハンドルを返すとき
WScript.echo vbCRLF +"CaseB:"
Set group = new LifeGroupClass : group.Name = "CaseB"
Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "B1"
Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "B2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
Set CaseB = a_handle
End Function
Function CaseC() '// LefeGroup から外れるとき
WScript.echo vbCRLF +"CaseC:"
Set group = new LifeGroupClass : group.Name = "CaseC"
Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "C1"
Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "C2"
Set c_handle = group.Add( new MutualClass ) : c_handle.p.Name = "C3"
group.Remove c_handle.p
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
Set CaseC = c_handle
End Function
Sub CaseD() '// LefeGroup を再利用するとき
WScript.echo vbCRLF +"CaseD:"
Set group = new LifeGroupClass : group.Name = "CaseD"
For count = 1 To 2
Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "D1"
Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "D2"
Set a_handle.p.Reference = b_handle.p
Set b_handle.p.Reference = a_handle.p
a_handle = Empty
b_handle = Empty
Next
End Sub
Class MutualClass
Public Name
Public Reference
Public LifeGroup '// Don't write except for LifeGroupClass
Public LifeGroupMemberID '// Don't write except for LifeGroupClass
Private Sub Class_Terminate()
WScript.echo Me.Name +": MutualClass::Class_Terminate"
End Sub
Public Sub DestroyReferences()
Me.Reference = Empty
End Sub
End Class
Class LifeHandleClass
Public p '// Target object of this handle
Private Sub Class_Terminate()
WScript.echo Me.p.LifeGroupMemberID &": LifeHandleClass::Class_Terminate"
If not IsEmpty( Me.p.LifeGroup ) Then _
Me.p.LifeGroup.AddTerminated Me.p
End Sub
End Class
Class LifeGroupClass
Public Name
Public Objects
Public TerminatedObjects
Private m_CreatedMemberID
Private Sub Class_Initialize()
Set Me.Objects = CreateObject( "Scripting.Dictionary" )
Set Me.TerminatedObjects = CreateObject( "Scripting.Dictionary" )
m_CreatedMemberID = 0
End Sub
Private Sub Class_Terminate()
WScript.echo "LifeGroupClass::Class_Terminate"
End Sub
Public Function Add( Object )
If not IsEmpty( Object.LifeGroup ) Then
If Object.LifeGroup Is Me Then Set Add = Nothing : Exit Function
Err.Raise 1, "すでに別の LifeGroup に所属しているようです"
End If
Do
m_CreatedMemberID = m_CreatedMemberID + 1
If not Objects.Exists( m_CreatedMemberID ) Then _
Exit Do
Loop
Set Me.Objects( m_CreatedMemberID ) = Object
Set Object.LifeGroup = Me
Object.LifeGroupMemberID = m_CreatedMemberID
Set Add = new LifeHandleClass
Set Add.p = Object
End Function
Public Sub Remove( Object )
If not Object.LifeGroup Is Me Then Exit Sub
If not Me.Objects( Object.LifeGroupMemberID ) Is Object Then Exit Sub
Object.DestroyReferences
Me.Objects.Remove m_CreatedMemberID
Object.LifeGroup = Empty
Object.LifeGroupMemberID = Empty
End Sub
Public Sub AddTerminated( Object )
If not Object.LifeGroup Is Me Then Exit Sub
If not Me.Objects( Object.LifeGroupMemberID ) Is Object Then Exit Sub
Set Me.TerminatedObjects( Object.LifeGroupMemberID ) = Object
If Me.TerminatedObjects.Count = Me.Objects.Count Then
For Each a_object In Me.Objects.Items
a_object.DestroyReferences
a_object.LifeGroup = Empty
a_object.LifeGroupMemberID = Empty
Next
Me.Objects.RemoveAll
Me.TerminatedObjects.RemoveAll
End If
End Sub
End Class
相互参照しているオブジェクトのグループとなるオブジェクト。
グループに所属しているオブジェクトのハンドルがすべて参照されなくなったら、
相互参照を切るメソッド DestroyReferences を呼び出し、Class_Terminate が呼び出されます。
ハンドルのメンバー p を介してオブジェクトを操作する必要があります。
A
B body
A body
B
LifeGroup
LifeHandleClass
p
p
CaseA:
1: LifeHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
A1: MutualClass::Class_Terminate
LifeGroupClass::Class_Terminate
A2: MutualClass::Class_Terminate
Returned
CaseB:
2: LifeHandleClass::Class_Terminate
Returned
1: LifeHandleClass::Class_Terminate
B2: MutualClass::Class_Terminate
LifeGroupClass::Class_Terminate
B1: MutualClass::Class_Terminate
CaseC:
1: LifeHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
C1: MutualClass::Class_Terminate
LifeGroupClass::Class_Terminate
C2: MutualClass::Class_Terminate
Returned
: LifeHandleClass::Class_Terminate
C3: MutualClass::Class_Terminate
CaseD:
1: LifeHandleClass::Class_Terminate
2: LifeHandleClass::Class_Terminate
D1: MutualClass::Class_Terminate
D2: MutualClass::Class_Terminate
3: LifeHandleClass::Class_Terminate
4: LifeHandleClass::Class_Terminate
D1: MutualClass::Class_Terminate
D2: MutualClass::Class_Terminate
LifeGroupClass::Class_Terminate
Returned
End of Main
もし、ここ以降でデストラクターが動くときは、プログラム終了時にすべてのオブジェク
トを削除することによるデストラクター呼び出しです。
表示例：
検証コード
← ▼ ▲
ラッパーによる Class_Terminate 呼び出し
Case4
WScript.echo "End of Main"
WScript.echo "もし、ここ以降でデストラクターが動くときは、"+_
"プログラム終了時にすべてのオブジェクトを削除する"+_
"ことによるデストラクター呼び出しです。"
Sub Case4()
WScript.echo "Case4:"
Set a_object = new A_Class : a_object.CaseName = "Case4"
Set b_object = new B_Class : b_object.CaseName = "Case4"
Set a_object.Reference = b_object
Set b_object.Reference = a_object.Body '// ここが a_object では呼び出されなくなる
End Sub
Class A_Class
Public Body
Private Sub Class_Initialize()
Set Me.Body = new A_BodyClass
End Sub
Private Sub Class_Terminate()
Me.Body.Reference = Empty
End Sub
Public Property Get CaseName() : CaseName = Body.CaseName : End Property
Public Property Let CaseName( x ) : Body.CaseName = x : End Property
Public Property Get Reference() : Set Reference = Body.Reference : End Property
Public Property Set Reference( x ) : Set Body.Reference = x : End Property
End Class
Class A_BodyClass
Public CaseName
Public Reference
Private Sub Class_Terminate()
WScript.echo Me.CaseName +": A_Class::Class_Terminate"
End Sub
End Class
Class B_Class
Public CaseName
Public Reference
Private Sub Class_Terminate()
WScript.echo Me.CaseName +": B_Class::Class_Terminate"
End Sub
End Class
検証コード
相互参照しているオブジェクトが、Class_Terminate を呼び出せるようにしたクラス。
このクラスのオブジェクトが削除されたとき、相互参照しているオブジェクトも削除される。
Case4:
Case4: B_Class::Class_Terminate
Case4: A_Class::Class_Terminate
End of Main
表示例：
B
A
A body
相互参照を切る
← ▼ ▲
DestroyerClass (version 2)
Case1
WScript.echo "End of Main"
Case2
WScript.echo "End of Main"
WScript.echo "もし、ここ以降でデストラクターが動くときは、"+_
"プログラム終了時にすべてのオブジェクトを削除する"+_
"ことによるデストラクター呼び出しです。"
Sub Case1()
WScript.echo vbCRLF +"Case1:"
Set destroyer = new DestroyerClass
Set a_object = new A_Class : a_object.CaseName = "Case1" : destroyer.Add a_object
Set b_object = new B_Class : b_object.CaseName = "Case1" : destroyer.Add b_object
Set a_object.Reference = b_object
Set b_object.Reference = a_object
End Sub
Sub Case2()
WScript.echo vbCRLF +"Case2:"
Set destroyer = new DestroyerClass
Set a_object = new A_Class : a_object.CaseName = "Case2"
Set b_object = new B_Class : b_object.CaseName = "Case2"
Set a_object.Reference = b_object
Set b_object.Reference = a_object
End Sub
Class DestroyerClass
Public Objects
Private Sub Class_Initialize()
Set Me.Objects = new ObjectSetClass
End Sub
Private Sub Class_Terminate()
WScript.echo "DestroyerClass::Class_Terminate"
For Each item In Me.Objects.Objects.Items
item.DestroyReferences
Next
End Sub
Public Sub Add( Object )
Me.Objects.Add Object
Object.IsDestroyer = True
End Sub
Public Sub Remove( Object )
Me.Objects.Remove Object
Object.IsDestroyer = False
End Sub
End Class
Sub CheckUnderDestroyer( Object )
If not Object.IsDestroyer Then _
Err.Raise 1,, "このオブジェクトは相互参照しているため、DestroyerClass の管理下に置く必要があります。"
End Sub
Class A_Class
Public CaseName
Public Reference
Public IsDestroyer '// ■追加
Private Sub Class_Terminate()
WScript.echo Me.CaseName +": A_Class::Class_Terminate"
CheckUnderDestroyer Me '// ■追加
End Sub
Public Sub DestroyReferences() '// ■追加
Me.Reference = Empty
End Sub
End Class
Class B_Class
Public CaseName
Public Reference
Public IsDestroyer '// ■追加
Private Sub Class_Terminate()
WScript.echo Me.CaseName +": B_Class::Class_Terminate"
CheckUnderDestroyer Me '// ■追加
End Sub
Public Sub DestroyReferences() '// ■追加
Me.Reference = Empty
End Sub
End Class
Class ObjectSetClass
Public Objects
Private m_NextID
Private Sub Class_Initialize()
Set Me.Objects = CreateObject( "Scripting.Dictionary" )
m_NextID = 0
End Sub
Public Sub Add( Object )
For Each item In Me.Objects.Items
If item is Object Then Exit Sub
Next
Do
m_NextID = m_NextID + 1
If not Objects.Exists( CStr( m_NextID ) ) Then _
Exit Do
Loop
Set Me.Objects( CStr( m_NextID ) ) = Object
End Sub
Public Sub Remove( Object )
For Each key In Me.Objects.Keys
If Objects( key ) is Object Then
Me.Objects.Remove key
Exit Sub
End If
Next
End Sub
End Class
相互参照しているオブジェクトを削除するタイミングを制御するオブジェクト。
DestroyerClass のオブジェクトが削除されるときに、相互参照を切るメソッド DestroyReferences
を呼び出し、Class_Terminate が呼び出されます。
検証コード
Destroyer
A
B
Case1:
DestroyerClass::Class_Terminate
Case1: A_Class::Class_Terminate
Case1: B_Class::Class_Terminate
End of Main
Case2:
DestroyerClass::Class_Terminate
End of Main
もし、ここ以降でデストラクターが動くときは、プログラム終了時にすべてのオブジェク
トを削除することによるデストラクター呼び出しです。
Case2: A_Class::Class_Terminate
C:\Users\user1\Desktop\MutualRef.vbs(65, 3) Microsoft VBScript 実行時エラー: こ
のオブジェクトは相互参照しているため、DestroyerClass の管理下に置く必要がありま
す。
Case2: B_Class::Class_Terminate
C:\Users\user1\Desktop\MutualRef.vbs(65, 3) Microsoft VBScript 実行時エラー: こ
のオブジェクトは相互参照しているため、DestroyerClass の管理下に置く必要がありま
す。
表示例：
相互参照を切る
→ DestroyerClass (vbslib)
関連
←
↓