Funciones de devolución de llamada de script

A veces, nuestro componente COM debe enviar una notificación al cliente o llamar a la función de devolución de llamada. El esquema es simple: el componente publica la interfaz, el cliente crea un objeto heredado de la interfaz y lo pasa al componente, el componente a su vez llama a las funciones de la interfaz, por lo tanto, llama a las funciones en el lado del cliente.

En el caso de Visual Basic o Visual Basic para Applicatons, podemos escribir una clase heredada de cualquier interfaz, pero esto no es posible para los archivos de script VBScript.

Aquí la interfaz IDispatch apresura a ayudarnos. Usando esta interfaz, nuestro poderoso componente asumirá humildemente el modesto papel de un cliente, y un pequeño script se convertirá en un servidor de automatización real.

Desarrollaremos el componente en el lenguaje de programación FreeBASIC.

Clases en el archivo de script

Puede declarar y usar clases en archivos de script. Dichas clases se heredan implícitamente de la interfaz IDispatch y son clases COM reales.

Declaramos una clase, una instancia de la cual pasaremos posteriormente a nuestro componente:

 Class CallBack Function CallBack(Param) '    WScript.Echo Param CallBack = 0 End Function End Class 

Nuestro componente recibirá una instancia de la clase CallBack , llamará a la función CallBack y le pasará una cadena con texto en el parámetro.

 '  Dim Component Set Component = CreateObject("BatchedFiles.TestCOMServer") '    ,      Dim objCallBack Set objCallBack = New CallBack '       Component.SetCallBack objCallBack, "" '       result = Component.InvokeCallBack() WScript.Echo result Set objCallBack = Nothing Set Component = Nothing 

IDispatch

Esta interfaz es el escollo de la automatización. Normalmente, la implementación de IDispatch basa en una biblioteca de tipos a través de ITypeInfo->Invoke o la función CreateStdDispatch , pero en este caso el servidor de automatización está ubicado en un script y no tiene una biblioteca de tipos, y nuestro componente actúa como un cliente. Para simplificar, IDipatch funciona así: toma el nombre de la función y le transfiere el control.

La definición de la interfaz se encuentra en el encabezado "oaidl.bi" (se agregan sangrías y saltos de línea para facilitar la lectura):

 Type IDispatch As IDispatch_ Type LPDISPATCH As IDispatch Ptr Type IDispatchVtbl '   IUnknown Dim InheritedTable As IUnknownVtbl GetTypeInfoCount As Function( _ ByVal this As IDispatch Ptr, _ ByVal pctinfo As UINT Ptr _ )As HRESULT GetTypeInfo As Function( _ ByVal this As IDispatch Ptr, _ ByVal iTInfo As UINT, _ ByVal lcid As LCID, _ ByVal ppTInfo As ITypeInfo Ptr Ptr _ )As HRESULT GetIDsOfNames As Function( _ ByVal this As IDispatch Ptr, _ ByVal riid As Const IID Const Ptr, _ ByVal rgszNames As LPOLESTR Ptr, _ ByVal cNames As UINT, _ ByVal lcid As LCID, _ ByVal rgDispId As DISPID Ptr _ )As HRESULT Invoke As Function( _ ByVal this As IDispatch Ptr, _ ByVal dispIdMember As DISPID, _ ByVal riid As Const IID Const Ptr, _ ByVal lcid As LCID, _ ByVal wFlags As WORD, _ ByVal pDispParams As DISPPARAMS Ptr, _ ByVal pVarResult As VARIANT Ptr, _ ByVal pExcepInfo As EXCEPINFO Ptr, _ ByVal puArgErr As UINT Ptr _ )As HRESULT End Type Type IDispatch_ lpVtbl As IDispatchVtbl Ptr End Type 

Las funciones GetIDsOfNames e Invoke son más interesantes en esta interfaz.

GetIDsOfNames

Toma el nombre de la función y devuelve su identificador de envío DISPID . DISPID es un alias para el tipo LONG .

Desde el punto de vista del cliente, DISPID es simplemente una herramienta de optimización que evita el paso de cadenas. Para el servidor, DISPID es el identificador de la función que el cliente desea llamar.

Invocar

Por el identificador de despacho realiza la función correspondiente.

DISPPARAMOS

Esta estructura contiene los parámetros de la función llamada. Todos los parámetros están empaquetados en VARIANT .

 Type tagDISPPARAMS '      rgvarg As VARIANTARG Ptr '      rgdispidNamedArgs As DISPID Ptr '    cArgs As UINT '    cNamedArgs As UINT End Type Type DISPPARAMS As tagDISPPARAMS 

Para simplificar el código, no utilizaremos argumentos con nombre, estableceremos NULL lugar.

Componente

Para su uso en scripts, los componentes también deben heredar directa o indirectamente de IDipatch .

Interfaz ITestCOMServer

Construyamos la interfaz ITestCOMServer con dos funciones SetCallBack e InvokeCallBack . El primero guardará el objeto del servidor de automatización, el segundo llamará a la función del objeto.

 Type ITestCOMServer As ITestCOMServer_ Type LPITESTCOMSERVER As ITestCOMServer Ptr Type ITestCOMServerVirtualTable '   IDispatch Dim InheritedTable As IDispatchVtbl Dim SetCallBack As Function( _ ByVal this As ITestCOMServer Ptr, _ ByVal CallBack As IDispatch Ptr, _ ByVal UserName As BSTR _ )As HRESULT Dim InvokeCallBack As Function( _ ByVal this As ITestCOMServer Ptr _ )As HRESULT End Type Type ITestCOMServer_ Dim pVirtualTable As ITestCOMServerVirtualTable Ptr End Type 

Clase TestCOMServer

Ahora puede declarar una clase COM:

 Type TestCOMServer '      Dim pVirtualTable As ITestCOMServerVirtualTable Ptr '   Dim ReferenceCounter As ULONG '    Dim CallBackObject As IDispatch Ptr '   Dim UserName As BSTR End Type 

Función setcallback

La implementación de la función SetCallBack simple: guardamos el objeto del servidor de automatización transmitido por el cliente y el parámetro de llamada a la función.

 Function TestCOMServerSetCallBack( _ ByVal pTestCOMServer As TestCOMServer Ptr, _ ByVal CallBack As IDispatch Ptr, _ ByVal UserName As BSTR _ )As HRESULT '      ,      If pTestCOMServer->CallBackObject <> NULL Then IDispatch_Release(pTestCOMServer->CallBack) End If pTestCOMServer->CallBackObject = CallBack '    If pTestCOMServer->CallBackObject <> NULL Then IDispatch_AddRef(pTestCOMServer->CallBack) End If '    SysFreeString(pTestCOMServer->UserName) '      pTestCOMServer->UserName = SysAllocStringLen(UserName, SysStringLen(UserName)) Return S_OK End Function 

Función InvokeCallBack

Pero la función InvokeCallBack tendrá que trabajar duro. Primero debe obtener el identificador del despachador de la función CallBack del servidor de automatización.

 Function TestCOMServerInvokeCallBack( _ ByVal pTestCOMServer As TestCOMServer Ptr _ )As HRESULT If pTestCOMServer->CallBack = NULL Then Return E_POINTER End If '    Const cNames As UINT = 1 '     Dim rgszNames(cNames - 1) As WString Ptr = {@"CallBack"} '   DISPID Dim rgDispId(cNames - 1) As DISPID = Any Dim hr As HRESULT = IDispatch_GetIDsOfNames( _ pTestCOMServer->CallBackObject, _ @IID_NULL, _ @rgszNames(0), _ cNames, _ GetUserDefaultLCID(), _ @rgDispId(0) _ ) If FAILED(hr) Then MessageBoxW(NULL, "  DISPID", NULL, MB_OK) Return E_FAIL End If 

Después de DISPID el DISPID función, se puede llamar:

  '     «, %UserName%» Dim Greetings As BSTR = SysAllocString(", ") Dim GreetingsUserName As BSTR = Any VarBstrCat(Greetings, pTestCOMServer->UserName, @GreetingsUserName) Const ParamsCount As Integer = 1 '    Dim varParam(ParamsCount - 1) As VARIANT = Any For i As Integer = 0 To ParamsCount - 1 VariantInit(@varParam(i)) Next '   —  varParam(0).vt = VT_BSTR varParam(0).bstrVal = GreetingsUserName Dim Params(0) As DISPPARAMS = Any Params(0).rgvarg = @varParam(0) Params(0).cArgs = ParamsCount Params(0).rgdispidNamedArgs = NULL Params(0).cNamedArgs = 0 '      Dim VarResult As VARIANT = Any Dim ExcepInfo As EXCEPINFO = Any Dim uArgErr As UINT = Any '     hr = IDispatch_Invoke( _ pTestCOMServer->CallBackObject, _ rgDispId(0), _ @IID_NULL, _ GetUserDefaultLCID(), _ DISPATCH_METHOD, _ @Params(0), _ @VarResult, _ NULL, _ NULL _ ) '    For i As Integer = 0 To ParamsCount - 1 VariantClear(@varParam(i)) Next SysFreeString(Greetings) Return S_OK End Function 

Conclusión

Como puede ver, incluso con un archivo de script, un componente puede recibir comentarios. Esto es útil para notificar al cliente de las operaciones completadas por el componente.

Las clases en scripts se pueden registrar en el registro, en cuyo caso estarán disponibles para todo el sistema usando ProgID , pero esta es una historia completamente diferente.

Referencias

Código de proyecto en el sitio de github: https://github.com/zamabuvaraeu/TestCOMServer

PD De alguna manera, el resaltado de la sintaxis BASIC desapareció, en su lugar usó VBScript y algunos operadores no están resaltados con él.