التفتيش الذاتي VB6 UDTs

https://stackoverflow.com/questions/547903

23-08-2019
|

سؤال

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

Public Sub PrintUDT ( vData As Variant )
  for each vDataMember in vData
    print vDataMember.Name & ": " & vDataMember.value 
  next vDataMember 
End Sub

يبدو أن هذه المعلومات يجب أن تكون متاحة COM في مكان ما...أي VB6 معلمو هناك تعهدا من النار ؟

شكرا

دان

المحلول

على عكس ما قاله الآخرون ، فإنه من الممكن الحصول على وقت تشغيل نوع المعلومات UDT في VB6 (على الرغم من أنه ليس المدمج في اللغة الميزة).مايكروسوفت عناصر المعلومات مكتبة كائنات (tlbinf32.dll) يسمح لك برمجيا فحص COM معلومات نوع وقت التشغيل.وينبغي أن لديك بالفعل هذا العنصر إذا كان لديك Visual Studio مثبتا:لإضافته إلى القائمة VB6 المشروع ، انتقل إلى المشروع->المراجع والتحقق من دخول المسمى "عناصر المعلومات." ملاحظة أنه سيكون لديك توزيع و تسجيل tlbinf32.dll في التطبيق الخاص بك برنامج "الإعداد".

يمكنك فحص UDT الحالات باستخدام عناصر المعلومات مكون في وقت التشغيل ، طالما UDT هي المعلنة Public ويتم تحديدها من خلال Public فئة.وهذا أمر ضروري من أجل جعل VB6 توليد COM متوافق مع نوع المعلومات الخاصة بك UDT هو (والتي يمكن تعداد مع مختلف الطبقات في TypeLib المعلومات مكون).أسهل طريقة لتحقيق هذا الشرط من شأنه أن يكون لوضع كل ما تبذلونه من UDT في العام UserTypes الدرجة التي سيتم تجميعها في DLL ActiveX أو ActiveX EXE.

ملخص سبيل المثال العمل

هذا المثال يحتوي على ثلاثة أجزاء:

الجزء 1:إنشاء DLL ActiveX المشروع الذي سوف تحتوي على جميع الجمهور UDT الإعلانات
الجزء 2:إنشاء مثال PrintUDT طريقة لإظهار كيف يمكن تعداد مجالات UDT سبيل المثال
الجزء 3:إنشاء مخصص مكرر الدرجة التي تسمح لك بسهولة من خلال تكرار ميادين عامة UDT والحصول على أسماء الحقول والقيم.

على سبيل المثال العمل

الجزء 1:ActiveX DLL

كما ذكرت سابقا, عليك أن تجعل النظام الخاص بك UDT العامة يمكن الوصول إليها في تعداد لهم باستخدام عناصر المعلومات عنصر.السبيل الوحيد لتحقيق ذلك هو وضع UDT في فئة العمومي داخل DLL ActiveX أو ActiveX EXE.مشاريع أخرى في التطبيق الخاص بك التي تحتاج إلى الوصول إلى UDT إرادة هذا العنصر الجديد.

اتبع جنبا إلى جنب مع هذا المثال ، تبدأ من خلال خلق جديد DLL ActiveX المشروع و اسم UDTLibrary.

بجانب إعادة تسمية Class1 فئة الوحدة النمطية (يضاف هذا افتراضيا IDE) إلى UserTypes وإضافة اثنين من الأنواع المعرفة من قبل المستخدم إلى فئة ، Person و Animal:

' UserTypes.cls '

Option Explicit

Public Type Person
    FirstName As String
    LastName As String
    BirthDate As Date
End Type

Public Type Animal
    Genus As String
    Species As String
    NumberOfLegs As Long
End Type

قائمة 1: UserTypes.cls بمثابة حاوية لدينا UDT هو

المقبل, تغيير المثيلات الملكية UserTypes الطبقة "2-PublicNotCreatable".لا يوجد أي سبب لأي شخص إنشاء مثيل UserTypes فئة مباشرة, لأنها ببساطة بوصفها العامة حاوية لدينا UDT هو.

وأخيرا تأكد Project Startup Object (تحت المشروع->خصائص) على أن "(لا شيء)" و ترجمة المشروع.يجب أن يكون لديك الآن ملف جديد يسمى UDTLibrary.dll.

الجزء 2:تعداد UDT نوع المعلومات

الآن حان الوقت لإظهار كيف يمكننا استخدام عناصر مكتبة كائنات لتنفيذ PrintUDT الأسلوب.

الأولى تبدأ من خلال إنشاء مشروع EXE قياسي جديد و سمه ما تريد.إضافة مرجع إلى ملف UDTLibrary.dll التي تم إنشاؤها في الجزء 1.منذ أنا فقط أريد أن تظهر كيف يعمل هذا ، سوف نستخدم الإطار الحالي إلى اختبار التعليمات البرمجية سوف نكتب.

إنشاء وحدة نمطية جديدة, اسم UDTUtils وإضافة التعليمة البرمجية التالية إليه:

'UDTUtils.bas'
Option Explicit    

Public Sub PrintUDT(ByVal someUDT As Variant)

    ' Make sure we have a UDT and not something else... '
    If VarType(someUDT) <> vbUserDefinedType Then
        Err.Raise 5, , "Parameter passed to PrintUDT is not an instance of a user-defined type."
    End If

    ' Get the type information for the UDT '
    ' (in COM parlance, a VB6 UDT is also known as VT_RECORD, Record, or struct...) '

    Dim ri As RecordInfo
    Set ri = TLI.TypeInfoFromRecordVariant(someUDT)

    'If something went wrong, ri will be Nothing'

    If ri Is Nothing Then
        Err.Raise 5, , "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    Else

        ' Iterate through each field (member) of the UDT '
        ' and print the out the field name and value     '

        Dim member As MemberInfo
        For Each member In ri.Members

            'TLI.RecordField allows us to get/set UDT fields:                 '
            '                                                                 '
            ' * to get a fied: myVar = TLI.RecordField(someUDT, fieldName)    '
            ' * to set a field TLI.RecordField(someUDT, fieldName) = newValue ' 
            '                                                                 '
            Dim memberVal As Variant
            memberVal = TLI.RecordField(someUDT, member.Name)

            Debug.Print member.Name & " : " & memberVal

        Next

    End If

End Sub

Public Sub TestPrintUDT()

    'Create a person instance and print it out...'

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    PrintUDT p

    'Create an animal instance and print it out...'

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Familiaris"
    a.NumberOfLegs = 4

    PrintUDT a

End Sub

قائمة 2:مثال PrintUDT الطريقة بسيطة طريقة الاختبار

الجزء 3:مما يجعل وجوه المنحى

الأمثلة المذكورة أعلاه توفر "سريعة وقذرة" مظاهرة كيفية استخدام عناصر المعلومات مكتبة كائنات تعداد مجالات UDT.في العالم الحقيقي السيناريو ، ربما خلق UDTMemberIterator الطبقة التي من شأنها أن تسمح لك بسهولة أكثر من خلال تكرار مجالات UDT ، جنبا إلى جنب مع وظيفة الأداة في وحدة الذي يخلق UDTMemberIterator معين UDT سبيل المثال.هذا من شأنه أن تسمح لك أن تفعل شيئا مثل التالية في التعليمات البرمجية التي هي أقرب بكثير إلى الزائفة الكود الذي شارك في السؤال:

Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'

For Each member In UDTMemberIteratorFor(someUDT)
   Debug.Print member.Name & " : " & member.Value
Next

في الواقع ليس من الصعب جدا أن تفعل هذا ، ونحن يمكن إعادة استخدامها أكثر من رمز من PrintUDT الروتينية التي تم إنشاؤها في الجزء 2.

أولا ActiveX جديدة إنشاء المشروع و اسم UDTTypeInformation أو شيئا من هذا القبيل.

تأكد من أن كائن بدء التشغيل للمشروع الجديد هو "(لا شيء)".

أول شيء القيام به هو إنشاء المجمع بسيطة الفئة التي سوف إخفاء التفاصيل TLI.MemberInfo فئة من استدعاء رمز تجعل من السهل للحصول على UDT حقل اسم القيمة.اتصلت هذه الفئة UDTMember.على المثيلات الملكية هذه الفئة ينبغي أن يكون PublicNotCreatable.

'UDTMember.cls'
Option Explicit

Private m_value As Variant
Private m_name As String

Public Property Get Value() As Variant
    Value = m_value
End Property

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Value(rhs As Variant)
    m_value = rhs
End Property

Public Property Get Name() As String
    Name = m_name
End Property

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Name(ByVal rhs As String)
    m_name = rhs
End Property

قائمة 3:على UDTMember المجمع الدرجة

الآن نحن بحاجة إلى إنشاء مكرر الصف ، UDTMemberIterator, هذا سوف يسمح لنا باستخدام VB For Each...In جملة تكرار مجالات UDT سبيل المثال.على Instancing الملكية هذه الفئة يجب تعيين PublicNotCreatable (نحن سوف تحدد طريقة فائدة في وقت لاحق من شأنها أن تخلق حالات نيابة عن استدعاء التعليمات البرمجية).

تحرير: (2/15/09) لقد نظفت رمز قليلا أكثر.

'UDTMemberIterator.cls'

Option Explicit

Private m_members As Collection ' Collection of UDTMember objects '


' Meant to be called only by Utils.UDTMemberIteratorFor '
'                                                       '
' Sets up the iterator by reading the type info for     '
' the passed-in UDT instance and wrapping the fields in '
' UDTMember objects                                     '

Friend Sub Initialize(ByVal someUDT As Variant)

    Set m_members = GetWrappedMembersForUDT(someUDT)

End Sub

Public Function Count() As Long

    Count = m_members.Count

End Function

' This is the default method for this class [See Tools->Procedure Attributes]   '
'                                                                               '
Public Function Item(Index As Variant) As UDTMember

    Set Item = GetWrappedUDTMember(m_members.Item(Index))

End Function

' This function returns the enumerator for this                                     '
' collection in order to support For...Each syntax.                                 '
' Its procedure ID is (-4) and marked "Hidden" [See Tools->Procedure Attributes]    '
'                                                                                   '
Public Function NewEnum() As stdole.IUnknown

    Set NewEnum = m_members.[_NewEnum]

End Function

' Returns a collection of UDTMember objects, where each element                 '
' holds the name and current value of one field from the passed-in UDT          '
'                                                                               '
Private Function GetWrappedMembersForUDT(ByVal someUDT As Variant) As Collection

    Dim collWrappedMembers As New Collection
    Dim ri As RecordInfo
    Dim member As MemberInfo
    Dim memberVal As Variant
    Dim wrappedMember As UDTMember

    ' Try to get type information for the UDT... '

    If VarType(someUDT) <> vbUserDefinedType Then
        Fail "Parameter passed to GetWrappedMembersForUDT is not an instance of a user-defined type."
    End If

    Set ri = tli.TypeInfoFromRecordVariant(someUDT)

    If ri Is Nothing Then
        Fail "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    End If

    ' Wrap each UDT member in a UDTMember object... '

    For Each member In ri.Members

        Set wrappedMember = CreateWrappedUDTMember(someUDT, member)
        collWrappedMembers.Add wrappedMember, member.Name

    Next

    Set GetWrappedMembersForUDT = collWrappedMembers

End Function

' Creates a UDTMember instance from a UDT instance and a MemberInfo object  '
'                                                                           '
Private Function CreateWrappedUDTMember(ByVal someUDT As Variant, ByVal member As MemberInfo) As UDTMember

    Dim wrappedMember As UDTMember
    Set wrappedMember = New UDTMember

    With wrappedMember
        .Name = member.Name
        .Value = tli.RecordField(someUDT, member.Name)
    End With

    Set CreateWrappedUDTMember = wrappedMember

End Function

' Just a convenience method
'
Private Function Fail(ByVal message As String)

    Err.Raise 5, TypeName(Me), message

End Function

قائمة 4:على UDTMemberIterator فئة.

لاحظ أنه من أجل جعل هذه الفئة iterable بحيث For Each يمكن استخدامها مع ذلك, سيكون لديك مجموعة معينة إجراء الصفات على Item و _NewEnum أساليب (كما ورد في تعليقات التعليمات البرمجية).يمكنك تغيير الإجراءات سمات من القائمة "أدوات" (Tools->الإجراء سمات).

أخيرا, نحن بحاجة إلى وظيفة الأداة (UDTMemberIteratorFor في أول المثال التعليمات البرمجية في هذا القسم) التي من شأنها خلق UDTMemberIterator عن UDT سبيل المثال ، والتي يمكننا ثم تكرار مع For Each.إنشاء وحدة نمطية جديدة تسمى Utils وإضافة التعليمة البرمجية التالية:

'Utils.bas'

Option Explicit

' Returns a UDTMemberIterator for the given UDT    '
'                                                  '
' Example Usage:                                   '
'                                                  '
' Dim member As UDTMember                          '
'                                                  '        
' For Each member In UDTMemberIteratorFor(someUDT) '
'    Debug.Print member.Name & ":" & member.Value  '
' Next                                             '
Public Function UDTMemberIteratorFor(ByVal udt As Variant) As UDTMemberIterator

    Dim iterator As New UDTMemberIterator
    iterator.Initialize udt

    Set UDTMemberIteratorFor = iterator

End Function

قائمة 5:على UDTMemberIteratorFor وظيفة الأداة.

وأخيرا ترجمة المشروع ثم قم بإنشاء مشروع جديد لاختبار بها.

في اختبار projet إضافة مرجع إلى تم إنشاؤه حديثا ، UDTTypeInformation.dll و UDTLibrary.dll التي تم إنشاؤها في الجزء 1 و محاولة الخروج من البرمجية التالية في وحدة نمطية جديدة:

'Module1.bas'

Option Explicit

Public Sub TestUDTMemberIterator()

    Dim member As UDTMember

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    For Each member In UDTMemberIteratorFor(p)
        Debug.Print member.Name & " : " & member.Value
    Next

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Canine"
    a.NumberOfLegs = 4

    For Each member In UDTMemberIteratorFor(a)
        Debug.Print member.Name & " : " & member.Value
    Next

End Sub

قائمة 6:اختبار UDTMemberIterator فئة.

نصائح أخرى

وDan،

ويبدو مثل محاولة لاستخدام RTTI من UDT. أنا لا أعتقد أنه يمكنك حقا الحصول على تلك المعلومات دون أن يعرفوا عن UDT قبل وقت التشغيل. لتبدأ محاولة:

فهم UDTs
بسبب عدم وجود هذه القدرة التفكير. وأود أن إنشاء بلدي RTTI لUDTs بلدي.

لتعطيك الأساس. جرب هذا:

Type test
    RTTI as String
    a as Long
    b as Long 
    c as Long
    d as Integer
end type

ويمكنك إرسال الأداة التي من شأنها فتح كل ملف المصدر وإضافة وRTTI مع اسم نوع إلى UDT. ربما سيكون من الأفضل أن تضع كل UDTs في ملف مشترك.

وقال إن RTTI يكون شيئا مثل هذا:

و"سلسلة: الطويل: طويل: طويل: عدد صحيح"

واستخدام الذاكرة من UDT يمكنك استخراج القيم.

إذا قمت بتغيير جميع أنواع لفئات. لديك خيارات. مأزق كبير لتغيير من نوع إلى فئة هو أن لديك لاستخدام keyworld الجديد. في كل مرة هناك تعريف لمتغير نوع إضافة الجديد.

وبعد ذلك يمكن استخدام لكم الكلمة البديل أو CallByName. VB6 لم يكن لديك anytype للتفكير ولكن يمكنك تقديم قوائم من الحقول صالحة واختبار لمعرفة ما إذا كانت موجودة على سبيل المثال

واختبار الفئة لديها ما يلي

Public Key As String
Public Data As String

ويمكنك بعد ذلك القيام بما يلي

Private Sub Command1_Click()
    Dim T As New Test 'This is NOT A MISTAKE read on as to why I did this.
    T.Key = "Key"
    T.Data = "One"
    DoTest T
End Sub

Private Sub DoTest(V As Variant)
    On Error Resume Next
    Print V.Key
    Print V.Data
    Print V.DoesNotExist
    If Err.Number = 438 Then Print "Does Not Exist"
    Print CallByName(V, "Key", VbGet)
    Print CallByName(V, "Data", VbGet)
    Print CallByName(V, "DoesNotExist", VbGet)
    If Err.Number = 438 Then Print "Does Not Exist"
End Sub

إذا حاولت استخدام حقل غير موجود ثم خطأ سيتم رفع 438. CallByName يتيح لك استخدام السلاسل إلى استدعاء الميدان وأساليب فئة.

وماذا VB6 عندما تقوم بتعريف خافت كما هو الجديد مثيرة للاهتمام للغاية وسوف تقليل الخلل في هذا التحويل إلى حد كبير. ترى هذا

Dim T as New Test

لا تعامل بالضبط نفس

Dim T as Test
Set T = new Test

وعلى سبيل المثال هذا العمل

Dim T as New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"

وهذا سيعطي خطأ

Dim T as Test
Set T = New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"

والسبب في ذلك هو أن في أول الأعلام سبيل المثال VB6 T بحيث في أي وقت يتم الوصول إلى أحد الأعضاء تحقق ما إذا كان T هو لا شيء. إذا كان فإنه سيتم تلقائيا إنشاء مثيل جديد من فئة اختبار ومن ثم تعيين المتغير.

في المثال الثاني VB لا يضيف هذا السلوك.

في معظم المشاريع التي نقوم بدقة تأكد نذهب خافت T كما الاختبار، وهناك مجموعة T = اختبار جديد. ولكن في حالتك منذ كنت تريد تحويل أنواع في الفصول الدراسية مع أقل قدر من الآثار الجانبية باستخدام خافت T كما الاختبار الجديد هو الطريق للذهاب. وذلك لأن خافت كما نيو تسبب المتغير لتقليد طريقة أنواع يعمل بشكل وثيق.

مرخصة بموجب: CC-BY-SA مع الإسناد

لا تنتمي إلى StackOverflow