Fonctions de rappel de script

Parfois, notre composant COM doit envoyer une notification au client ou appeler la fonction de rappel. Le schéma est simple: le composant publie l'interface, le client crée un objet hérité de l'interface et le transmet au composant, le composant, à son tour, appelle les fonctions de l'interface, appelant ainsi les fonctions côté client.

Dans le cas de Visual Basic ou Visual Basic pour Applicatons, nous pouvons écrire une classe héritée de n'importe quelle interface, mais cela n'est pas possible pour les fichiers de script VBScript.

Ici, l'interface IDispatch précipite à notre aide. En utilisant cette interface, notre puissant composant assumera humblement le rôle modeste d'un client, et un petit script se transformera en un véritable serveur d'automatisation.

Nous développerons le composant dans le langage de programmation FreeBASIC.

Classes dans le fichier script

Vous pouvez déclarer et utiliser des classes dans des fichiers de script. Ces classes sont implicitement héritées de l'interface IDispatch et sont de véritables classes COM.

Nous déclarons une classe, dont nous passerons par la suite à notre composant:

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

Notre composant recevra une instance de la classe CallBack , appellera la fonction CallBack et lui passera une chaîne avec du texte dans le paramètre.

 '  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

Cette interface est la pierre d'achoppement de l'automatisation. En règle générale, l'implémentation d' IDispatch basée sur une bibliothèque de types via ITypeInfo->Invoke ou la fonction CreateStdDispatch , mais dans ce cas, le serveur d'automatisation est situé dans un script et n'a pas de bibliothèque de types, et notre composant agit comme un client. Pour simplifier, IDipatch fonctionne comme ceci: prend le nom de la fonction et lui transfère le contrôle.

La définition de l'interface se trouve dans la rubrique «oaidl.bi» (des retraits et des sauts de ligne sont ajoutés pour plus de lisibilité):

 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 

Les fonctions GetIDsOfNames et Invoke sont les plus intéressantes dans cette interface.

GetIDsOfNames

Il prend le nom de la fonction et renvoie son identifiant de répartition DISPID . DISPID est un alias pour le type LONG .

Du point de vue du client, DISPID est simplement un outil d'optimisation qui évite le passage de chaînes. Pour le serveur, DISPID est l'identifiant de la fonction que le client souhaite appeler.

Invoquer

Par identifiant d'expédition effectue la fonction correspondante.

DISPPARAMS

Cette structure contient les paramètres de la fonction appelée. Tous les paramètres sont regroupés dans VARIANT .

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

Pour simplifier le code, nous n'utiliserons pas d'arguments nommés, nous allons définir NULL place.

Composant

Pour une utilisation dans les scripts, les composants doivent également hériter directement ou indirectement d' IDipatch .

Interface ITestCOMServer

Construisons l'interface ITestCOMServer avec deux fonctions SetCallBack et InvokeCallBack . Le premier enregistre l'objet serveur d'automatisation, le second appelle la fonction objet.

 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

Vous pouvez maintenant déclarer une classe COM:

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

Fonction setcallback

L'implémentation de la fonction SetCallBack simple: on enregistre l'objet serveur d'automatisation transmis par le client et le paramètre d'appel de fonction.

 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 

Fonction InvokeCallBack

Mais la fonction InvokeCallBack devra travailler dur. Vous devez d'abord obtenir l'identifiant du répartiteur de la fonction CallBack du serveur d'automatisation.

 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 

Une fois le DISPID fonction reçu, il peut être appelé:

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

Conclusion

Comme vous pouvez le voir, même avec un fichier de script, un composant peut obtenir des commentaires. Ceci est utile pour informer le client des opérations terminées par le composant.

Les classes dans les scripts peuvent être enregistrées dans le registre, auquel cas elles seront disponibles pour l'ensemble du système à l'aide de ProgID , mais c'est une tout autre histoire.

Les références

Code de projet sur le site github: https://github.com/zamabuvaraeu/TestCOMServer

PS D'une manière ou d'une autre, le rétro-éclairage de la syntaxe BASIC a disparu, a utilisé VBScript à la place, et certains opérateurs ne sont pas mis en évidence avec.