Fungsi Panggilan Balik Script

Terkadang komponen COM kami harus mengirim pemberitahuan kepada klien atau memanggil fungsi panggilan balik. Skema ini sederhana: komponen menerbitkan antarmuka, klien membuat objek yang diwarisi dari antarmuka dan meneruskannya ke komponen, komponen, pada gilirannya, memanggil fungsi antarmuka, sehingga memanggil fungsi di sisi klien.

Dalam kasus Visual Basic atau Visual Basic for Applicatons, kita dapat menulis kelas yang diwarisi dari antarmuka apa pun, tetapi ini tidak mungkin untuk file skrip VBScript.

Di sini antarmuka IDispatch bergegas membantu kami. Menggunakan antarmuka ini, komponen kuat kami akan dengan rendah hati mengambil peran sederhana dari klien, dan skrip kecil akan berubah menjadi server otomatisasi nyata.

Kami akan mengembangkan komponen dalam bahasa pemrograman FreeBASIC.

Kelas dalam file skrip

Anda dapat mendeklarasikan dan menggunakan kelas dalam file skrip. Kelas-kelas semacam itu secara implisit diwarisi dari antarmuka IDispatch dan merupakan kelas COM nyata.

Kami mendeklarasikan sebuah kelas, sebuah instance yang selanjutnya akan kami berikan ke komponen kami:

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

Komponen kami akan menerima turunan dari kelas CallBack , memanggil fungsi CallBack dan meneruskannya string dengan teks dalam 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

Antarmuka ini adalah batu sandungan otomatisasi. Biasanya, implementasi IDispatch didasarkan pada pustaka jenis melalui ITypeInfo->Invoke atau CreateStdDispatch , tetapi dalam hal ini server otomasi terletak dalam skrip dan tidak memiliki pustaka jenis, dan komponen kami bertindak sebagai klien. Untuk menyederhanakan, IDipatch berfungsi seperti ini: mengambil nama fungsi dan mentransfer kontrol ke sana.

Definisi antarmuka terletak pada tajuk "oaidl.bi" (indentasi dan pemisah baris ditambahkan agar mudah dibaca):

 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 

Fungsi GetIDsOfNames dan Invoke paling menarik di antarmuka ini.

GetIDsOfNames

Dibutuhkan nama fungsi dan mengembalikan pengenal pengirimannya DISPID . DISPID adalah alias untuk tipe LONG .

Dari sudut pandang klien, DISPID hanyalah alat pengoptimalan yang menghindari DISPID baris. Untuk server, DISPID adalah pengidentifikasi fungsi yang ingin dipanggil oleh klien.

Panggil

Dengan dispatch identifier melakukan fungsi yang sesuai.

DISPPARAM

Struktur ini berisi parameter dari fungsi yang dipanggil. Semua parameter dikemas dalam VARIANT .

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

Untuk menyederhanakan kode, kami tidak akan menggunakan argumen bernama, kami akan menetapkan NULL sebagai gantinya.

Komponen

Untuk digunakan dalam skrip, komponen juga harus secara langsung atau tidak langsung mewarisi dari IDipatch .

Antarmuka ITestCOMServer

ITestCOMServer membangun antarmuka ITestCOMServer dengan dua fungsi SetCallBack dan InvokeCallBack . Yang pertama akan menyimpan objek server otomatisasi, yang kedua akan memanggil fungsi objek.

 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 

Kelas TestCOMServer

Sekarang Anda dapat mendeklarasikan kelas COM:

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

Fungsi setcallback

Implementasi fungsi SetCallBack sederhana: kita menyimpan objek server otomatisasi yang dikirimkan oleh klien dan parameter panggilan fungsi.

 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 

Fungsi InvokeCallBack

Tetapi fungsi InvokeCallBack bekerja keras. Pertama, Anda perlu mendapatkan pengidentifikasi operator fungsi CallBack dari server otomatisasi.

 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 

Setelah DISPID fungsi diterima, itu bisa disebut:

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

Kesimpulan

Seperti yang Anda lihat, bahkan dengan file skrip, komponen dapat memperoleh umpan balik. Ini berguna untuk memberi tahu klien operasi yang selesai oleh komponen.

Kelas-kelas dalam skrip dapat didaftarkan dalam registri, dalam hal ini mereka akan tersedia untuk seluruh sistem menggunakan ProgID , tetapi ini adalah cerita yang sangat berbeda.

Referensi

Kode proyek di situs github: https://github.com/zamabuvaraeu/TestCOMServer

PS Entah bagaimana sorotan untuk sintaks BASIC menghilang, alih-alih menggunakan VBScript, dan beberapa operator tidak disorot dengan itu.