TCreator - История изменений

SYSDBA: /* Исходный код */

2021-12-20T12:44:35Z

‎Исходный код

SYSDBA в 13:07, 13 апреля 2010

2010-04-13T13:07:16Z

SYSDBA в 12:56, 13 апреля 2010

2010-04-13T12:56:22Z

SYSDBA в 12:56, 13 апреля 2010

2010-04-13T12:56:11Z

SYSDBA в 12:55, 13 апреля 2010

2010-04-13T12:55:10Z

SYSDBA: /* Исходный код */

2009-05-23T09:28:47Z

‎Исходный код

SYSDBA: /* Исходный код */

2009-05-13T13:43:54Z

‎Исходный код

SYSDBA: /* Пример использования */

2007-03-01T14:49:49Z

‎Пример использования

SYSDBA в 13:54, 1 марта 2007

2007-03-01T13:54:40Z

SYSDBA в 13:51, 1 марта 2007

2007-03-01T13:51:35Z

Новая страница

Класс TCreator служит для создания объектов и гарантирует освобождение объекта по выходу из области видимости. При использовании GetObject освобождение объектов непосредственно в скрипт-функции не требуется.

=== Исходный код ===

<pre>
Class TCreator
Private FCount
Private FObjectArray()
Private FFinallyCount
Private FFinallyCode()

Public Sub DestroyAllObjects
for I = UBound(FObjectArray) to LBound(FObjectArray) step -1
if VarType(FObjectArray(I)) = vbObject then
FObjectArray(I).DestroyObject
FObjectArray(I) = Empty
end if
next
FCount = -1
End Sub

Public Function GetObject(Params, ClassName, Name)
FCount = FCount + 1
if FCount > UBound(FObjectArray) then
ReDim Preserve FObjectArray((UBound(FObjectArray) + 1) * 2 - 1)
end if
set FObjectArray(FCount) = Designer.CreateObject(Params, ClassName, Name)
set GetObject = FObjectArray(FCount)
End Function

'Используется, в случае необходимости,
'для уничтожения объктов созданных Креатором
Public Sub DestroyObject(Object)
for I = UBound(FObjectArray) to LBound(FObjectArray) step -1
if VarType(FObjectArray(I)) = vbObject then
if Addr(FObjectArray(I)) = Addr(Object) then
FObjectArray(I) = Empty
Object.DestroyObject
exit sub
end if
end if
next

call Exception.Raise("Exception", "В списке не найден переданный объект.")
End Sub

Public Function AddFinallyCode(ByRef S, ByRef Obj)
FFinallyCount = FFinallyCount + 1
if FFinallyCount > UBound(FFinallyCode, 1) then _
ReDim Preserve FFinallyCode((UBound(FFinallyCode) + 1) * 2 - 1, 1)
FFinallyCode(FFinallyCount, 0) = S
if IsObject(Obj) then
Set FFinallyCode(FFinallyCount, 1) = Obj
else
FFinallyCode(FFinallyCount, 1) = Obj
end if
AddFinallyCode = FFinallyCount
End Function

Public Sub DeleteFinallyCode(I)
FFinallyCode(I, 0) = ""
if IsObject(FFinallyCode(I, 1)) then _
Set FFinallyCode(I, 1) = Nothing
End Sub

Public Sub ExecFinallyCode
Dim I
For I = LBound(FFinallyCode, 1) To UBound(FFinallyCode, 1)
if FFinallyCode(I, 0) > "" then
Execute Replace(FFinallyCode(I, 0), "<X>", "FFinallyCode(I, 1)")
DeleteFinallyCode I
end if
Next
End Sub

Private Sub Class_Initialize
ReDim FObjectArray(7)
FCount = -1
ReDim FFinallyCode(1, 1)
FFinallyCount = -1
End Sub

Private Sub Class_Terminate
ExecFinallyCode
DestroyAllObjects
End Sub
End Class
</pre>

@@ Строка 3: / Строка 3: @@
 === Пример использования ===
-<source lang="vbnet">
+<syntaxhighlight lang="vbnet">
 Option Explicit
 Sub MyProcedure
@@ Строка 17: / Строка 17: @@
 End Sub
-</source>
+</syntaxhighlight>
 См. также статью [[Реализация конструкции try-finally на VBScript]].

@@ Строка 3: / Строка 3: @@
 === Пример использования ===
-<sourcelang="vbnet">
+<source lang="vbnet">
 Option Explicit
 Sub MyProcedure

@@ Строка 3: / Строка 3: @@
 === Пример использования ===
-<syntaxhighlight lang="vbnet">
+<sourcelang="vbnet">
 Option Explicit
 Sub MyProcedure
@@ Строка 17: / Строка 17: @@
 End Sub
-</syntaxhighlight>
+</source>
 См. также статью [[Реализация конструкции try-finally на VBScript]].

@@ Строка 3: / Строка 3: @@
 === Пример использования ===
-<pre>
+<syntaxhighlight lang="vbnet">
 Option Explicit
 Sub MyProcedure
@@ Строка 17: / Строка 17: @@
 End Sub
-</pre>
+</syntaxhighlight>
 См. также статью [[Реализация конструкции try-finally на VBScript]].

@@ Строка 23: / Строка 23: @@
 === Исходный код ===
-<pre>
+<source lang="vbnet">
 Class TCreator
    Private FCount
@@ Строка 106: / Строка 106: @@
    End Sub
 End Class
-</pre>
+</source>
 [[Category:VBScript]]

@@ Строка 24: / Строка 24: @@
 <source lang="vbnet">
 Class TCreator
    Private FCount
    Private FObjectArray()
-   Private FFinallyCount
+   Private FID
-  Private FFinallyCode()
    Public Sub DestroyAllObjects
      for I = UBound(FObjectArray) to LBound(FObjectArray) step -1
        if VarType(FObjectArray(I)) = vbObject then
-         FObjectArray(I).DestroyObject
+         Designer.DestroyObject(FObjectArray(I))
-         FObjectArray(I) = Empty
+         Set FObjectArray(I) = Nothing
        end if
      next
@@ Строка 55: / Строка 65: @@
        if VarType(FObjectArray(I)) = vbObject then
          if Addr(FObjectArray(I)) = Addr(Object) then
-           FObjectArray(I) = Empty
+           Designer.DestroyObject(FObjectArray(I))
-           Object.DestroyObject
+           Set FObjectArray(I) = Nothing
            exit sub
          end if
@@ Строка 63: / Строка 73: @@
      call Exception.Raise("Exception", "В списке не найден переданный объект.")
    End Sub
@@ Строка 97: / Строка 78: @@
      ReDim FObjectArray(7)
      FCount = -1
-     ReDim FFinallyCode(1, 1)
+     FID = NextCreatorID
-     FFinallyCount = -1
+    CreatorCnt = CreatorCnt + 1
    End Sub
    Private Sub Class_Terminate
      DestroyAllObjects
    End Sub
 End Class

← Предыдущая		Версия 13:43, 13 мая 2009
Строка 107:		Строка 107:
	End Class		End Class
	</pre>		</pre>
		+
		+	[[Category:VBScript]]

← Предыдущая		Версия 13:54, 1 марта 2007
Строка 1:		Строка 1:
	Класс TCreator служит для создания объектов и гарантирует освобождение объекта по выходу из области видимости. При использовании GetObject освобождение объектов непосредственно в скрипт-функции не требуется.		Класс TCreator служит для создания объектов и гарантирует освобождение объекта по выходу из области видимости. При использовании GetObject освобождение объектов непосредственно в скрипт-функции не требуется.
		+
		+	=== Пример использования ===
		+
		+	<pre>
		+	Option Explicit
		+	Sub MyProcedure
		+
		+	Dim Creator, F
		+	Set Creator = new TCreator
		+	Set F = Creator.GetObject(Application, "usrf_MyForm", "MyName")
		+	F.ShowModal
		+
		+	' высвобождать форму F вручную не требуется, так как она будет
		+	' уничтожена автоматически в процессе уничтожения объекта Creator
		+	' по завершении процедуры MyProcedure
		+
		+	End Sub
		+	</pre>

	=== Исходный код ===		=== Исходный код ===