Funções de retorno de chamada de script

Às vezes, nosso componente COM deve enviar uma notificação ao cliente ou chamar a função de retorno de chamada. O esquema é simples: o componente publica a interface, o cliente cria um objeto herdado da interface e o passa para o componente, o componente, por sua vez, chama as funções da interface, chamando as funções no lado do cliente.

No caso do Visual Basic ou Visual Basic for Applicatons, podemos escrever uma classe herdada de qualquer interface, mas isso não é possível para arquivos de script VBScript.

Aqui a interface do IDispatch corre em nosso auxílio. Usando essa interface, nosso componente poderoso assumirá humildemente o papel modesto de um cliente, e um pequeno script se tornará um servidor de automação real.

Vamos desenvolver o componente na linguagem de programação FreeBASIC.

Classes no arquivo de script

Você pode declarar e usar classes em arquivos de script. Tais classes são herdadas implicitamente da interface IDispatch e são classes COM reais.

Declaramos uma classe, uma instância da qual passaremos para o nosso componente mais tarde:

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

Nosso componente receberá uma instância da classe CallBack , chamará a função CallBack e passará uma string com texto no 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

Essa interface é o obstáculo da automação. Normalmente, a implementação do IDispatch baseada em uma biblioteca de tipos através da função ITypeInfo->Invoke ou CreateStdDispatch , mas nesse caso o servidor de automação está localizado em um script e não possui uma biblioteca de tipos, e nosso componente atua como um cliente. Para simplificar, o IDipatch funciona assim: pega o nome da função e transfere o controle para ela.

A definição da interface está no cabeçalho "oaidl.bi" (recuos e quebras de linha são adicionados para facilitar a leitura):

 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 

As funções GetIDsOfNames e Invoke são mais interessantes nessa interface.

GetIDsOfNames

Ele pega o nome da função e retorna seu identificador de despacho DISPID . DISPID é um alias para o tipo LONG .

Do ponto de vista do cliente, DISPID é simplesmente uma ferramenta de otimização que evita DISPID linha. Para o servidor, DISPID é o identificador da função que o cliente deseja chamar.

Invocar

Por identificador de despacho executa a função correspondente.

DISPPARAMS

Essa estrutura contém os parâmetros da função chamada. Todos os parâmetros são empacotados em 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 o código, não usaremos argumentos nomeados; em vez disso, definiremos NULL .

Componente

Para uso em scripts, os componentes também devem herdar direta ou indiretamente do IDipatch .

Interface ITestCOMServer

ITestCOMServer criar a interface ITestCOMServer com duas funções SetCallBack e InvokeCallBack . O primeiro salvará o objeto do servidor de automação, o segundo chamará a função de 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 

Classe TestCOMServer

Agora você pode declarar uma classe COM:

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

Função setcallback

A implementação da função SetCallBack simples: salvamos o objeto do servidor de automação transmitido pelo cliente e o parâmetro de chamada da função.

 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 

Função InvokeCallBack

Mas a função InvokeCallBack terá InvokeCallBack trabalhar duro. Primeiro, você precisa obter o identificador de despachante da função CallBack do servidor de automação.

 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 

Depois que o DISPID função é recebido, ele pode ser chamado:

  '     «, %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 

Conclusão

Como você pode ver, mesmo com um arquivo de script, um componente pode receber feedback. Isso é útil para notificar o cliente sobre as operações concluídas pelo componente.

As classes em scripts podem ser registradas no registro, caso em que estarão disponíveis para todo o sistema usando ProgID , mas essa é uma história completamente diferente.

Referências

Código do projeto no site do github: https://github.com/zamabuvaraeu/TestCOMServer

PS De alguma forma, o destaque para a sintaxe BASIC desapareceu, usou o VBScript e alguns operadores não são destacados.