توضح هذه المقالة طريقة الوحدة النمطية لـ visual basic6.0، والتي تستخدم XMLHTTP لتنفيذ وظائف النشر والحصول على التعليمات البرمجية القديمة، إلا أنها يمكن أن تحل محل عنصر تحكم Inet لتحقيق اتصال البيانات. الأمر يستحق التعلم منه.
رمز الوحدة الرئيسية هو كما يلي:
'======================================================================== = ========='|. اسم الوحدة النمطية |. XMLHTTP'|. استبدل عنصر تحكم Inet'==========. === ====================== نص استجابة بيانات التعداد العام = 1 ResponseBody = 2 وظيفة التعداد العامة GetData(ByVal Url As سلسلة، ByVal DataStic كـ DataEnum) كمتغير عند الخطأ GoTo ERR: Dim XMLHTTP ككائن Dim DataS كسلسلة Dim DataB() كمجموعة بايت XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "get"، Url، True XMLHTTP .send while XMLHTTP.ReadyState <> 4 DoEvents Wend '-------------------------------------- ------- إرجاع الوظيفة حدد نص استجابة حالة DataStic Case '-------------------------------- قم بإرجاع السلسلة مباشرةً DataS = XMLHTTP.ResponseText GetData = DataS Case ResponseBody '-- ------------------------------- إرجاع DataB الثنائي مباشرة = XMLHTTP.ResponseBody GetData = DataB Case ResponseBody + ResponseText '--- - -------------------------- تحويل ثنائي إلى سلسلة [حاول عندما تكون السلسلة التي تم إرجاعها مباشرة مشوهة] DataS = BytesToStr(XMLHTTP.ResponseBody) GetData = DataS Case Else '--------------------------------إرجاع GetData غير صالح = "" End Select '---------------------------------------حرر مساحة تعيين XMLHTTP = لا شيء Exit FunctionERR: GetData = ""وظيفة النهاية العامة PostData(ByVal StrUrl كسلسلة، ByVal StrData كسلسلة، ByVal DataStic كـ DataEnum) كمتغير عند الخطأ GoTo ERR: Dim XMLHTTP ككائن Dim DataS كسلسلة Dim DataB() كـ مجموعة البايت XMLHTTP = CreateObject("Microsoft.XMLHTTP") XMLHTTP.Open "POST"، StrUrl، True XMLHTTP.setRequestHeader "طول المحتوى"، Len(PostData) XMLHTTP.setRequestHeader "CONTENT-TYPE"، "application/x-www-form-urlencoded" XMLHTTP.send (StrData) Do حتى XMLHTTP.ReadyState = 4 DoEvents Loop '--------------------------------ترجع الدالة Select Case DataStic Case ResponseText '----------------------------- قم بإرجاع السلسلة مباشرةً DataS = XMLHTTP.ResponseText PostData = DataS Case ResponseBody '-- --- ---------------------------- إرجاع DataB الثنائي مباشرة = XMLHTTP.ResponseBody PostData = DataB Case ResponseBody + ResponseText '---- -- --------------------- تحويل ثنائي إلى سلسلة [حاول عندما تكون السلسلة التي يتم إرجاعها مباشرة مشوهة] DataS = BytesToStr(XMLHTTP.ResponseBody) PostData = DataS Case Else '- -------------------------------بيانات الإرجاع غير صالحة = "" End Select '------------------------------------حرر مساحة تعيين XMLHTTP = لا يوجد شيء خروج من الوظيفةERR : PostData = ""وظيفة النهاية BytesToStr(ByVal vIn) كسلسلة strReturn = "" For i = 1 إلى LenB(vIn) ThisCharCode = AscB(MidB(vIn, i, 1)) إذا كان ThisCharCode < &H80 ثم strReturn = strReturn & Chr(ThisCharCode) آخر NextCharCode = AscB(MidB(vIn, i + 1, 1)) strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) i = i + 1 End If Next BytesToStr = الدالة strReturnEnd