Тема: VBS: CallByName
Решил добавить сюда пример реализации функции CallByName для VBS.
Option Explicit
Const VbMethod = 1
Const VbGet = 2
Const VbLet = 4
Const VbSet = 8
RunInConsoleMode
'Заготовка функции для теста
Function SomeFunction(a,b,c)
WScript.Echo "SomeFunction called"
End Function
'Заготовка класса со свойствами и методами для теста
Class clsTest
Public Sub [@SomeMethod](a,b,c)
WScript.Echo "SomeMethod called"
End Sub
Public Property Get PropertyGet(a,b,c)
WScript.Echo "Property Get called"
PropertyGet = a + b + c
End Property
Public Property Let PropertyLet(a,b)
WScript.Echo "Property Let called"
End Property
Public Property Set PropertySet(a,b,c)
WScript.Echo "Property Set called"
End Property
Public Default Sub DefaultMethod()
WScript.Echo "Default Method called"
End Sub
End Class
'Создание тестового класс модуля для тестирования на его свойствах и методах
Dim objTest
Set objTest = New clsTest
With New VBSUDF
'Вызов функции
.CallByName(Array(GetRef("SomeFunction"),,,1,2,3))
'Вызов умолчательного метода у объекта
.CallByName(Array(objTest))
'Вызов метода по имени
.CallByName(Array(objTest, "@SomeMethod", vbMethod, 1,2,3))
'Получение свойства
WScript.Echo "Returned value: " & .CallByName(Array(objTest, "PropertyGet", vbGet, 1,2,3))
'Присвоение свойства с типом вызова vbLet
.CallByName(Array(objTest, "PropertyLet", vbLet, 1,2))
'Присвоение свойства с типом вызова vbSet
.CallByName(Array(objTest, "PropertySet", vbSet, 1,2, CreateObject("Scripting.FileSystemObject")))
End With
WScript.Echo "Script End. Press Enter to exit."
WScript.StdIn.ReadLine
Class VBSUDF
Function CallByName(args)
Dim i, Code, MethodName, CallType, lb, n, ErrDescription
'Определение границ массива
lb = Lbound(args)
n = Ubound(args)
'Получение параметров
CallType = GetArrayItem(args,2)
MethodName = GetArrayItem(args,lb + 1)
if InStr(1,MethodName,"]") Then Err.Raise &H800A0408, TypeName(Me)
'Если тип вызова не указан, то используется vbMethod по умолчанию
if isEmpty(CallType) Then CallType = vbMethod
'Если тип вызова vbLet, vbSet, то перебор нужно вести до предпоследнего элемента,
'так как последний элемент будет присвоен через "="
if CallType > 2 Then n = n - 1
'Сборка строки аргументов
For i = lb + 3 to n
Code = Code & ",args(" & i & ")"
Next
'Добавка скобок
Code = "(" & mid(Code,2) & ")"
'Добавка имени метода в выражение
if MethodName <> "" Then Code = ".[" & MethodName & "]" &Code
'Определение типов вызова
Select Case CallType
Case vbGet, vbMethod
Code = "Stub args(lb)" & Code & ", CallByName"
Case vbLet, vbSet
Code = "args(lb)" & Code & " = args(n+1)"
if CallType = vbSet Then Code = "Set " & Code
Case Else
Err.Raise vbObjectError + 1, TypeName(Me), "Invalid call type"
End Select
'Выполнение построенного выражения
On Error Resume Next
Execute Code
if Err.Number <> 0 Then
ErrDescription = Err.Description
On Error Goto 0
Err.Raise vbObjectError + 1, TypeName(Me) & ".CallByName", ErrDescription & ". [" & MethodName & "]"
End if
End Function
'Функция для получения элемента массива
Private Function GetArrayItem(arr, i)
if i < Lbound(arr) or i > Ubound(arr) Then Exit Function
Stub arr(i), GetArrayItem
if VarType(GetArrayItem) = vbError Then GetArrayItem = Empty
End Function
'Заглушка для возврата данных при вызове Default метода объекта
Private Sub Stub(paramIn, paramOut)
'Если на входе (в paramIn) объект, то используется Set, в ином случае прямое присвоение
If isObject(paramIn) Then
Set paramOut = paramIn
Else
paramOut = paramIn
End If
End Sub
End Class
'Процедура для запуска в консольном режиме
Sub RunInConsoleMode()
If InStr(1,WScript.FullName,"cscript",1) > 0 Then Exit Sub
CreateObject("WScript.Shell").Run("cscript /nologo """ & WScript.ScriptFullName & """")
WScript.Quit
End Sub
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !