VBS: CallByName

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