Hola MicroInf

No tengo mucho tiempo, te pego un viejo email que envie a estas listas que
contiene el código necesario para explorar un activex, en el ejemplo genera
un XML a partir del componente.

Pego a continuación:
-----------------------------------------------------------------------------------------------------------------------------
*From:* [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] *On Behalf Of *Daniel
Calvin
*Sent:* Viernes, 20 de Abril de 2007 11:38 a.m.
*To:* [EMAIL PROTECTED]
*Subject:* [puntonet] registracion de COM

Hola Carlos

De todas formas hay que registrar el componente en cada maquina Carlos.

En cuanto a reflection en VB6 no se llama asi, pero hay un equivalente.
Hay que agregar una referencia a TypeLibInformation ( TLBINF.DLL )

Esa API te permite explorar cualquier dll o exe  COM, parecido a como haces
con el gettype() en net.

Luego si combinas el reultado con CallByName, termina teniendo algo muy
parecido a la reflection de net....

Lo uso, sip todavia vb6, para algunas aplicaciones.

1 - Un framework para test unitarios en VB6. ( le paso la dll, el tipo
obtiene todos los metodos de setup, test y demas por reflection... )
2 - Un ORM que utiliza unos XML de mapeo, un hibernate del sub desarrollo.

Un ejemplo de Activex a XML:

Public Function CreateMappingInfoFileFromDLL

(DLLFileName As String, ByRef outXML As String) As Boolean
    Dim tliApp As New TLI.TLIApplication
    Dim tlibi As TLI.TypeLibInfo
    Dim ti As TLI.TypeInfo
    Dim iti As TLI.TypeInfo
    Dim itis As TLI.TypeInfos

    Dim vi As VarTypeInfo

    Dim oM As MemberInfo

    Dim wrt As New MXXMLWriter

    Dim cnth As IVBSAXContentHandler
    Dim dtdh As IVBSAXDTDHandler
    Dim lexh As IVBSAXLexicalHandler
    Dim errh As IVBSAXErrorHandler

    Dim atrs As SAXAttributes

    Set cnth = wrt
    Set dtdh = wrt
    Set lexh = wrt
    Set errh = wrt



    wrt.omitXMLDeclaration = True
    wrt.indent = True
    wrt.encoding = "UTF-8"


    cnth.startDocument
    lexh.startDTD "mappinginfo", "", "mappinginfo-0_1_0.dtd"
    lexh.endDTD


    Set tlibi = tliApp.TypeLibInfoFromFile(DLLFileName)

    Set atrs = New SAXAttributes
    atrs.addAttribute "", "", "name", "", DLLFileName
    atrs.addAttribute "", "", "guid", "", tlibi.GUID
    cnth.startElement "", "", "mappinginfo", atrs

    For Each ti In tlibi.TypeInfos

        If ti.AttributeMask = 2 Then
            Debug.Print ti.Name
        End If

        If ti.AttributeMask <> 2 Then
            Set atrs = New SAXAttributes

            atrs.addAttribute "", "", "name", "", ti.Name
            atrs.addAttribute "", "", "parent", "", ti.Parent
            atrs.addAttribute "", "", "insert", "", "DAL" & ti.Name &
"_Insert"
            atrs.addAttribute "", "", "delete", "", "DAL" & ti.Name &
"_Delete"
            atrs.addAttribute "", "", "update", "", "DAL" & ti.Name &
"_Update"
            atrs.addAttribute "", "", "select", "", "DAL" & ti.Name &
"_Select"
            atrs.addAttribute "", "", "selectall", "", "DAL" & ti.Name &
"_SelectAll"
            atrs.addAttribute "", "", "selectfilter", "", "DAL" & ti.Name &
"_SelectFilter"
            atrs.addAttribute "", "", "errorparam", "", "@iErrorCode"

            cnth.startElement "", "", "class", atrs

            For Each oM In ti.Members

                Set vi = oM.ReturnType

                Debug.Print oM.Name

                If oM.Parameters.Count = 0 And (oM.InvokeKind And
(INVOKE_PROPERTYPUTREF Or INVOKE_PROPERTYPUT Or INVOKE_PROPERTYGET)) Then
                    Set atrs = New SAXAttributes
                    atrs.addAttribute "", "", "name", "", oM.Name

                    Select Case oM.InvokeKind
                        Case INVOKE_PROPERTYPUTREF
                            atrs.addAttribute "", "", "calltype", "",
"VbSet"
                        Case INVOKE_PROPERTYPUT
                            atrs.addAttribute "", "", "calltype", "",
"VbLet"
                        Case INVOKE_PROPERTYGET
                            atrs.addAttribute "", "", "calltype", "",
"VbGet"
                        Case Else
                            atrs.addAttribute "", "", "calltype", "",
oM.InvokeKind
                    End Select

                    If vi.VarType Then
                         atrs.addAttribute "", "", "typename", "", TypeName(
vi.TypedVariant)
                    Else
                         atrs.addAttribute "", "", "typename", "",
vi.TypeInfo.Parent & "." & vi.TypeInfo.Name <http://vi.typeinfo.name/>
                    End If

                    atrs.addAttribute "", "", "rowname", "", oM.Name
                    atrs.addAttribute "", "", "paramname", "", "@" & oM.Name
                    cnth.startElement "", "", "procedure", atrs

                    atrs.Clear
                    cnth.endElement "", "", "procedure"
                Else
                    Beep
                End If

            Next

            cnth.startElement "", "", "key", Nothing

            Set atrs = New SAXAttributes
            atrs.addAttribute "", "", "name", "", "myName"
            atrs.addAttribute "", "", "unsaved-value", "", "undefined"
            cnth.startElement "", "", "field", atrs
            cnth.endElement "", "", "field"

            atrs.Clear
            cnth.endElement "", "", "key"

            Set atrs = New SAXAttributes
            atrs.addAttribute "", "", "name", "", "myParentName01"
            cnth.startElement "", "", "parentkey", atrs

            Set atrs = New SAXAttributes
            atrs.addAttribute "", "", "name", "", "myName01"
            cnth.startElement "", "", "field", atrs
            cnth.endElement "", "", "field"

            Set atrs = New SAXAttributes
            atrs.addAttribute "", "", "name", "", "myName02"
            cnth.startElement "", "", "field", atrs
            cnth.endElement "", "", "field"

            atrs.Clear
            cnth.endElement "", "", "parentkey"

            On Error Resume Next
            Set itis = tlibi.GetTypeInfo(Mid$(ti.Name, 2)).Interfaces
            If Err = 0 Then
                For Each iti In itis
                    If Not (iti.Name = ti.Name) Then
                        Set atrs = New SAXAttributes
                        atrs.addAttribute "", "", "name", "", iti.Name
                        atrs.addAttribute "", "", "parent", "", ti.Name
                        cnth.startElement "", "", "interface", atrs

                        For Each oM In iti.Members
                            Set vi = oM.ReturnType
                            Debug.Print oM.Name
                            If oM.Parameters.Count = 0 And
(oM.InvokeKindAnd (INVOKE_PROPERTYPUTREF Or INVOKE_PROPERTYPUT Or
INVOKE_PROPERTYGET))
Then
                                Set atrs = New SAXAttributes
                                atrs.addAttribute "", "", "name", "",
oM.Name
                                Select Case oM.InvokeKind
                                    Case INVOKE_PROPERTYPUTREF
                                        atrs.addAttribute "", "",
"calltype", "", "VbSet"
                                    Case INVOKE_PROPERTYPUT
                                        atrs.addAttribute "", "",
"calltype", "", "VbLet"
                                    Case INVOKE_PROPERTYGET
                                        atrs.addAttribute "", "",
"calltype", "", "VbGet"
                                    Case Else
                                        atrs.addAttribute "", "",
"calltype", "", oM.InvokeKind
                                End Select
                                If vi.VarType Then
                                     atrs.addAttribute "", "", "typename",
"", TypeName(vi.TypedVariant)
                                Else
                                     atrs.addAttribute "", "", "typename",
"", vi.TypeInfo.Name <http://vi.typeinfo.name/>
                                End If
                                atrs.addAttribute "", "", "rowname", "",
oM.Name
                                atrs.addAttribute "", "", "paramname", "",
"@" & oM.Name
                                cnth.startElement "", "", "procedure", atrs
                                atrs.Clear
                                cnth.endElement "", "", "procedure"
                            End If
                        Next

                        cnth.endElement "", "", "interface"

                    End If
                Next
            End If
            atrs.Clear
            cnth.endElement "", "", "class"
        Else
            Beep

        End If

    Next
    cnth.endElement "", "", "mappinginfo"

    outXML = wrt.output

    CreateMappingInfoFileFromDLL = True

    Set cnth = Nothing
    Set dtdh = Nothing
    Set lexh = Nothing
    Set errh = Nothing
    Set wrt = Nothing
End Function





El día 3/08/07, microinf <[EMAIL PROTECTED]> escribió:
>
>  Hola, deseo saber si existe alguna forma en VB6, de recuperar el nombre
> de todos atributos y metodos de un objeto creado por mi.
>
>
> --
> Este mensaje ha sido analizado por *MailScanner*<http://www.mailscanner.info/>
> en busca de virus y otros contenidos peligrosos,
> y se considera que está limpio.
> MailScanner agradece a transtec Computers <http://www.transtec.co.uk/> por
> su apoyo.




-- 
Daniel A. Calvin
Cooperator Team Member
http://www.cooperator.com.ar
Microsoft Certified Professional

Responder a