وظائف رد الاتصال النصي

في بعض الأحيان ، يجب على مكون COM إرسال إشعار إلى العميل أو استدعاء وظيفة رد الاتصال. المخطط بسيط: يقوم المكون بنشر الواجهة ، ويقوم العميل بإنشاء كائن موروث من الواجهة ويمررها إلى المكون ، ويقوم المكون بدوره باستدعاء وظائف الواجهة ، وبالتالي استدعاء الوظائف على جانب العميل.

في حالة Visual Basic أو Visual Basic for Applicatons ، يمكننا كتابة فئة موروثة من أي واجهة ، ولكن هذا غير ممكن لملفات البرامج النصية VBScript.

هنا واجهة IDispatch يندفع لمساعدتنا. باستخدام هذه الواجهة ، سيتولى مكوننا القوي بكل تواضع الدور المتواضع للعميل ، وسوف يتحول البرنامج النصي الصغير إلى خادم أتمتة حقيقي.

سنقوم بتطوير المكون في لغة البرمجة FreeBASIC.

فصول في ملف البرنامج النصي

يمكنك التصريح واستخدام الفصول في ملفات البرامج النصية. يتم توريث هذه الفئات ضمنيًا من واجهة IDispatch وهي فئات COM حقيقية.

نعلن عن فئة ، سننتقل بعدها إلى مكوننا:

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

سيتلقى المكون الخاص بنا CallBack لفئة CallBack ، ويستدعي وظيفة CallBack سلسلة نصية في المعلمة.

 '  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 و

هذه الواجهة هي حجر عثرة في الأتمتة. عادةً ما يعتمد تطبيق IDispatch على مكتبة ITypeInfo->Invoke خلال ITypeInfo->Invoke أو الدالة CreateStdDispatch ، ولكن في هذه الحالة ، يوجد خادم الأتمتة في برنامج نصي ولا يحتوي على مكتبة أنواع ، ويعمل المكون الخاص بنا كعميل. لتبسيط ، يعمل IDipatch مثل هذا: يأخذ اسم الوظيفة وينقل التحكم إليها.

يكمن تعريف الواجهة في العنوان "oaidl.bi" (تتم إضافة المسافات البادئة وفواصل الأسطر لسهولة القراءة):

 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 

تعد وظائف GetIDsOfNames و Invoke أكثر إثارة للاهتمام في هذه الواجهة.

GetIDsOfNames

يأخذ اسم الدالة وإرجاع معرف الإرسال DISPID . DISPID هو اسم مستعار لنوع LONG .

من وجهة نظر العميل ، يعد DISPID مجرد أداة تحسين تتجنب تمرير السلسلة. بالنسبة للخادم ، DISPID هو معرف الوظيفة التي يريد العميل الاتصال بها.

استدعاء

بواسطة معرف الإرسال يؤدي الوظيفة المقابلة.

DISPPARAMS

تحتوي هذه البنية على معلمات الوظيفة المدعوة. يتم حزم جميع المعلمات في VARIANT .

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

لتبسيط الرمز ، لن نستخدم الوسائط المسماة ، سنقوم بتعيين NULL بدلاً من ذلك.

عنصر

للاستخدام في البرامج النصية ، يجب أن ترث المكونات أيضًا بشكل مباشر أو غير مباشر من IDipatch .

واجهة ITestCOMServer

ITestCOMServer نبني واجهة ITestCOMServer مع وظيفتين SetCallBack و InvokeCallBack . الأول سيوفر كائن خادم الأتمتة ، والثاني سوف استدعاء وظيفة الكائن.

 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 

فئة TestCOMServer

الآن يمكنك إعلان فئة COM:

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

وظيفة setcallback

تنفيذ وظيفة SetCallBack بسيط: نحن SetCallBack كائن خادم الأتمتة الذي يرسله العميل والمعلمة استدعاء دالة.

 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

لكن وظيفة InvokeCallBack ستعمل بجد. تحتاج أولاً إلى الحصول على معرف المرسل لوظيفة 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 

بعد استلام DISPID للوظيفة ، يمكن تسميتها:

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

استنتاج

كما ترون ، حتى مع وجود ملف نصي ، يمكن للمكون الحصول على ملاحظات. هذا مفيد لإعلام العميل بالعمليات المكتملة بواسطة المكون.

يمكن تسجيل الفئات في البرامج النصية في السجل ، وفي هذه الحالة ستكون متاحة للنظام بأكمله باستخدام ProgID ، لكن هذه قصة مختلفة تمامًا.

مراجع

رمز المشروع على موقع جيثب: https://github.com/zamabuvaraeu/TestCOMServer

ملاحظة: بطريقة ما ، اختفى تسليط الضوء على بناء جملة BASIC ، واستخدم VBScript بدلاً من ذلك ، ولم يتم إبراز بعض العوامل به.