ScriptControl Run

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
pertov
Начинающий
Начинающий
 
Сообщения: 9
Зарегистрирован: 20.12.2014 (Сб) 17:51

ScriptControl Run

Сообщение pertov » 03.05.2017 (Ср) 23:00

Код: Выделить всё
Sub Main()
Dim vbs As Object
Set vbs = CreateObject("ScriptControl")
vbs.language = "VBSCRIPT"
Dim Code$
Code = Code & "Function F0()" & vbCrLf
Code = Code & "F0=0" & vbCrLf
Code = Code & "End Function" & vbCrLf

Code = Code & "Function F1(a0)" & vbCrLf
Code = Code & "F1=10:a0=11" & vbCrLf
Code = Code & "End Function" & vbCrLf

Code = Code & "Function F2(a0,a1)" & vbCrLf
Code = Code & "F2=20:a0=21:a1=22" & vbCrLf
Code = Code & "End Function" & vbCrLf

Code = Code & "Function F3(a0,a1,a2)" & vbCrLf
Code = Code & "F3=30:a0=31:a1=32:a2=33" & vbCrLf
Code = Code & "End Function" & vbCrLf

Code = Code & "Function F4(a0,a1,a2,a3)" & vbCrLf
Code = Code & "F4=40:a0=41:a1=42:a2=43:a3=44" & vbCrLf
Code = Code & "End Function" & vbCrLf

vbs.addcode Code

Dim c0, c1, c2, c3
Debug.Print vbs.Run("F0")
Debug.Print vbs.Run("F1", c0), c0
Debug.Print vbs.Run("F2", c0, c1), c0, c1
Debug.Print vbs.Run("F3", c0, c1, c2), c0, c1, c2
Debug.Print vbs.Run("F4", c0, c1, c2, c3), c0, c1, c2, c3

Dim b0, b1, b2, b3
b0 = 100
b1 = 101
b2 = 102
b3 = 103
Debug.Print ScriptControl_Run2(vbs, "F0")
Debug.Print ScriptControl_Run2(vbs, "F1", b0), b0
Debug.Print ScriptControl_Run2(vbs, "F2", b0, b1), b0, b1
Debug.Print ScriptControl_Run2(vbs, "F3", b0, b1, b2), b0, b1, b2
Debug.Print ScriptControl_Run2(vbs, "F4", b0, b1, b2, b3), b0, b1, b2, b3

b0 = 1000
b1 = 1001
b2 = 1002
b3 = 1003
Debug.Print ScriptControl_Run1(vbs, "F0")
Debug.Print ScriptControl_Run1(vbs, "F1", b0), b0
Debug.Print ScriptControl_Run1(vbs, "F2", b0, b1), b0, b1
Debug.Print ScriptControl_Run1(vbs, "F3", b0, b1, b2), b0, b1, b2
Debug.Print ScriptControl_Run1(vbs, "F4", b0, b1, b2, b3), b0, b1, b2, b3
End Sub

мне нужно передавать аргументы в функцию и забирать их обратно (нутром чуствую что решение гдето рядом)
такое работает:
Код: Выделить всё
Function ScriptControl_Run2(eVBS As Object, ProcedureName As String, ParamArray Parameters() As Variant)
Dim res As Variant
Select Case UBound(Parameters)
Case -1
    res = eVBS.Run(ProcedureName)
Case 0
    res = eVBS.Run(ProcedureName, Parameters(0))
Case 1
    res = eVBS.Run(ProcedureName, Parameters(0), Parameters(1))
Case 2
    res = eVBS.Run(ProcedureName, Parameters(0), Parameters(1), Parameters(2))
Case 3
    res = eVBS.Run(ProcedureName, Parameters(0), Parameters(1), Parameters(2), Parameters(3))
'Case 4
'Case 5
'Case 11
End Select
ScriptControl_Run2 = res
End Function

а такое (не работает = не может принять ParamArray ):
Код: Выделить всё
Private Declare Function rtcCallByName Lib "MSVBVM60.dll" (ByVal Object As Object, ByVal ProcName As Long, ByVal CallType As VbCallType, ByRef Args() As Any, Optional ByVal lcid As Long) As Variant
Function ScriptControl_Run1(eVBS As Object, ProcedureName As String, ParamArray Parameters())
If UBound(Parameters) = -1 Then
    ScriptControl_Run1 = eVBS.Run(ProcedureName)
Else
'вот здесь не работает
    ScriptControl_Run1 = CallByName(eVBS.CodeObject, ProcedureName, VbMethod, Parameters)
'и тут тоже
    ScriptControl_Run1 = rtcCallByName(eVBS.CodeObject, ProcedureName, VbMethod, Parameters)

End If
End Function
как скормить ParamArray в функцию ScriptControl.Run и получить измененные ParamArray обратно.?
Последний раз редактировалось pertov 04.05.2017 (Чт) 19:47, всего редактировалось 3 раз(а).

Vi
Постоялец
Постоялец
 
Сообщения: 739
Зарегистрирован: 25.01.2002 (Пт) 11:03
Откуда: Россия, Ижевск

Re: ScriptControl Run

Сообщение Vi » 04.05.2017 (Чт) 10:11

pertov писал(а):мне нужно передавать аргументы в одномерном массиве (нутром чуствую что решение гдето рядом)


a = array(1,2,3,4,5)
msgbox join(a,",")

вот тебе и строка параметров.
Vita
Выше головы не прыгнешь, ниже земли не упадешь, дальше границы не убежишь! (с) КВН


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10

    TopList