Skript-Rückruffunktionen

Manchmal muss unsere COM-Komponente eine Benachrichtigung an den Client senden oder die Rückruffunktion aufrufen. Das Schema ist einfach: Die Komponente veröffentlicht die Schnittstelle, der Client erstellt ein von der Schnittstelle geerbtes Objekt und übergibt es an die Komponente. Die Komponente ruft wiederum die Schnittstellenfunktionen auf und ruft damit die Funktionen auf der Clientseite auf.

Im Fall von Visual Basic oder Visual Basic für Anwendungen können wir eine Klasse schreiben, die von einer beliebigen Schnittstelle geerbt wurde. Dies ist jedoch für VBScript-Skriptdateien nicht möglich.

Hier eilt uns die IDispatch Schnittstelle zu Hilfe. Über diese Schnittstelle übernimmt unsere leistungsstarke Komponente demütig die bescheidene Rolle eines Clients, und aus einem kleinen Skript wird ein echter Automatisierungsserver.

Wir werden die Komponente in der Programmiersprache FreeBASIC entwickeln.

Klassen in der Skriptdatei

Sie können Klassen in Skriptdateien deklarieren und verwenden. Solche Klassen werden implizit von der IDispatch Schnittstelle geerbt und sind echte COM-Klassen.

Wir deklarieren eine Klasse, deren Instanz wir anschließend an unsere Komponente übergeben werden:

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

Unsere Komponente empfängt eine Instanz der CallBack Klasse, ruft die CallBack Funktion auf und CallBack ihr eine Zeichenfolge mit Text im Parameter.

 '  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

Diese Schnittstelle ist der Stolperstein der Automatisierung. Normalerweise basiert die Implementierung von IDispatch auf einer ITypeInfo->Invoke über ITypeInfo->Invoke oder die Funktion CreateStdDispatch In diesem Fall befindet sich der Automatisierungsserver jedoch in einem Skript und verfügt nicht über eine CreateStdDispatch Unsere Komponente fungiert als Client. Zur Vereinfachung funktioniert IDipatch : IDipatch den Namen der Funktion und überträgt die Kontrolle an sie.

Die Definition der Schnittstelle liegt in der Überschrift „oaidl.bi“ (Einrückungen und Zeilenumbrüche werden zur besseren Lesbarkeit hinzugefügt):

 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 

Die Funktionen GetIDsOfNames und Invoke sind in dieser Schnittstelle am interessantesten.

GetIDsOfNames

Es nimmt den Namen der Funktion und gibt ihre DISPID . DISPID ist ein Alias ​​für den Typ LONG .

Aus Sicht des DISPID ist DISPID lediglich ein Optimierungswerkzeug, das das Übergeben von Zeichenfolgen vermeidet. Für den Server ist DISPID die Kennung der Funktion, die der Client aufrufen möchte.

Rufen Sie auf

Per Versand führt die Kennung die entsprechende Funktion aus.

DISPPARAMS

Diese Struktur enthält die Parameter der aufgerufenen Funktion. Alle Parameter sind in VARIANT .

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

Um den Code zu vereinfachen, verwenden wir keine benannten Argumente, sondern setzen stattdessen NULL .

Komponente

Für die Verwendung in Skripten sollten Komponenten auch direkt oder indirekt von IDipatch erben.

ITestCOMServer-Schnittstelle

Erstellen ITestCOMServer die ITestCOMServer Schnittstelle mit zwei Funktionen, SetCallBack und InvokeCallBack . Der erste speichert das Automatisierungsserverobjekt, der zweite ruft die Objektfunktion auf.

 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 

Klasse TestCOMServer

Jetzt können Sie eine COM-Klasse deklarieren:

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

Funktionsrückruf

Die Implementierung der SetCallBack Funktion SetCallBack einfach: Wir speichern das vom Client übertragene Automatisierungsserverobjekt und den Funktionsaufrufparameter.

 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 

InvokeCallBack-Funktion

Die InvokeCallBack Funktion InvokeCallBack jedoch hart arbeiten. Zuerst müssen Sie die Dispatcher- CallBack der CallBack Funktion des Automatisierungsservers CallBack .

 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 

Nachdem die DISPID Funktion empfangen wurde, kann sie aufgerufen werden:

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

Fazit

Wie Sie sehen, kann eine Komponente auch mit einer Skriptdatei Feedback erhalten. Dies ist nützlich, um den Client über abgeschlossene Vorgänge durch die Komponente zu informieren.

Klassen in Skripten können in der Registrierung registriert werden. In diesem Fall sind sie mit ProgID für das gesamte System ProgID . Dies ist jedoch eine ganz andere Geschichte.

Referenzen

Projektcode auf der Github-Site: https://github.com/zamabuvaraeu/TestCOMServer

PS Irgendwie verschwand das Highlight für die BASIC-Syntax, stattdessen wurde VBScript verwendet, und einige Operatoren werden damit nicht hervorgehoben.