modcom.bas

反编译vb软件,可以把vb打包的软件直接翻译成源码,非常好用,

                            'Indicate ByVal
                            If bByVal Then
                                sOutput = sOutput & "ByVal "
                            End If

                            'Display the parameter name
                            sOutput = sOutput & tliParameterInfo.Name

                            If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                                sOutput = sOutput & "()"
                            End If

                            If tliTypeInfo Is Nothing Then 'Information not available
                                sOutput = sOutput & " As ?"
                            Else
                                If .IsExternalType Then
                                    sOutput = sOutput & " As " & .TypeLibInfoExternal.Name & "." & tliTypeInfo.Name
                                Else
                                    sOutput = sOutput & " As " & tliTypeInfo.Name
                                End If
                            End If

                            'Reset error handling
                            On Error GoTo 0
                        Else
                            If .PointerLevel = 0 Then
                                sOutput = sOutput & "ByVal "
                            End If

                            sOutput = sOutput & tliParameterInfo.Name
                            If intVarTypeCur <> vbVariant Then
                                strTypeName = TypeName(.TypedVariant)
                                If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                                    sOutput = sOutput & "() As " & Left$(strTypeName, Len(strTypeName) - 2)
                                Else
                                    sOutput = sOutput & " As " & strTypeName
                                End If
                            End If
                        End If

                        If bOptional Then
                            If bDefault Then
                                sOutput = sOutput & ProduceDefaultValue(tliParameterInfo.DefaultValue, tliResolvedTypeInfo)
                                'sOutput = sOutput & " = " & tliParameterInfo.DefaultValue
                            End If
                            sOutput = sOutput & "]"
                        End If
                    End With
                Next
                sOutput = sOutput & ")"
            End If
        End With
        'return type
        If bIsConstant Then
            ConstVal = .Value
            sOutput = sOutput & " = " & ConstVal
            Select Case VarType(ConstVal)
                Case vbInteger, vbLong
                    If ConstVal < 0 Or ConstVal > 15 Then
                        sOutput = sOutput & " (&H" & Hex$(ConstVal) & ")"
                    End If
            End Select
        Else
            With .ReturnType
                intVarTypeCur = .VarType
                If intVarTypeCur = 0 Or (intVarTypeCur And Not (VT_ARRAY Or VT_VECTOR)) = 0 Then
                    On Error Resume Next
                    If Not .TypeInfo Is Nothing Then
                        If Err Then                        'Information not available
                            sOutput = sOutput & " As ?"
                        Else
                            If .IsExternalType Then
                                sOutput = sOutput & " As " & .TypeLibInfoExternal.Name & "." & .TypeInfo.Name
                            Else
                                sOutput = sOutput & " As " & .TypeInfo.Name
                            End If
                        End If
                    End If

                    If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                        sOutput = sOutput & "()"
                    End If
                    On Error GoTo 0
                Else
                    Select Case intVarTypeCur
                        Case VT_VARIANT, VT_VOID, VT_HRESULT
                        Case Else
                            strTypeName = TypeName(.TypedVariant)
                            If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                                sOutput = sOutput & "() As " & Left$(strTypeName, Len(strTypeName) - 2)
                            Else
                                sOutput = sOutput & " As " & strTypeName
                            End If
                    End Select
                End If
            End With
        End If
    End With
    getNameFromMemberInfo = sOutput
End Function
Public Function ProduceDefaultValue(DefVal As Variant, ByVal tliTypeInfo As TypeInfo) As String
    'This helper function adapted from Microsoft documentation
    Dim lngTrackVal As Long
    Dim mi As MemberInfo
    Dim tliTypeKinds As TypeKinds

    If tliTypeInfo Is Nothing Then
        Select Case VarType(DefVal)
            Case vbString
                If Len(DefVal) Then
                    ProduceDefaultValue = """" & DefVal & """"
                End If
            Case vbBoolean                                 'Always show for Boolean
                ProduceDefaultValue = DefVal
            Case vbDate
                If DefVal Then
                    ProduceDefaultValue = "#" & DefVal & "#"
                End If
            Case Else                                      'Numeric Values
                If DefVal <> 0 Then
                    ProduceDefaultValue = DefVal
                End If
        End Select
    Else
        'Resolve constants to their enums
        tliTypeKinds = tliTypeInfo.TypeKind
        Do While tliTypeKinds = TKIND_ALIAS
            tliTypeKinds = TKIND_MAX
            On Error Resume Next
            Set tliTypeInfo = tliTypeInfo.ResolvedType
            If Err = 0 Then
                tliTypeKinds = tliTypeInfo.TypeKind
            End If
            On Error GoTo 0
        Loop
        If tliTypeInfo.TypeKind = TKIND_ENUM Then
            lngTrackVal = DefVal
            For Each mi In tliTypeInfo.Members
                If mi.Value = lngTrackVal Then
                    ProduceDefaultValue = " = " & mi.Name
                    Exit For
                End If
            Next
        End If
    End If
End Function
Public Function getFunctionsFromFile(sFileName As String) As String
    '*****************************
    'Purpose: Get all functions from a COM file
    '*****************************
    'On Error Resume Next
    Dim srT As SearchResults
    Dim srM As SearchResults
    Dim mi As MemberInfo, mi2 As MemberInfo
    Dim lSearchData As Long
    Dim bIsConstant As Boolean
    Dim strReturn As String
    Dim p As Long, m As Long, t As Long
    Dim bFirstParameter As Boolean
    Dim bParamArray As Boolean
    Dim tliParameterInfo As ParameterInfo
    Dim bDefault As Boolean
    Dim bOptional As Boolean
    Dim tliTypeInfo As TypeInfo
    Dim tliResolvedTypeInfo As TypeInfo
    Dim tliTypeKinds As TypeKinds
    Dim intVarTypeCur As Integer
    Dim bByVal As Boolean
    Dim strTypeName As String
    Dim ConstVal As Variant
    'txtEntityPrototype = PrototypeMember(lstTypeInfos.ItemData(lstTypeInfos.ListIndex), tliInvokeKinds, lstMembers.[_Default])
    frmMain.txtFunctions.Text = ""

    With tliTypeLibInfo
        .ContainingFile = sFileName



        Set srT = .GetTypes(, tliStAll, False)
        For t = 1 To srT.count

            lSearchData = srT(t).SearchData
            frmMain.txtFunctions.Text = frmMain.txtFunctions.Text & "'==================== " & srT(t).Name & "====================" & vbCrLf & vbCrLf
            Set srM = tliTypeLibInfo.GetMembers(lSearchData)


            For m = 1 To srM.count

                'Text1.Text = Text1.Text & "guid:" & srM(m).Guid & vbCrLf
                DoEvents
                Set mi = tliTypeLibInfo.GetMemberInfo(lSearchData, srM(m).InvokeKinds, srM(m).MemberId, srM(m).Name)
                frmMain.txtFunctions.Text = frmMain.txtFunctions.Text & getNameFromMemberInfo(mi) & vbCrLf
            Next m
        Next t
    End With
    MsgBox "all done"

End Function
Public Function ReturnGuiOpcode(ByVal SearchData As Long, _
    ByVal InvokeKinds As InvokeKinds, _
    Optional ByVal MemberName As String) As Integer
    '*****************************
    'Purpose: To return the opcode of a property used in form decompiling
    '*****************************
    On Error GoTo exitFunction
    Dim tliTypeInfo As TypeInfo
    Dim num As Integer
    With tliTypeLibInfo

        With .GetMemberInfo(SearchData, InvokeKinds, , MemberName)
            'Debug.Print "MemberID: 0x" & Hex(.MemberId - &H10000)

            num = (.MemberId - 65536)
        End With
    End With
    If num > 255 Then
        num = -1
    End If
    ReturnGuiOpcode = num
    Exit Function
exitFunction:
    ReturnGuiOpcode = -1
    Exit Function
End Function
Public Function ReturnDataType(ByVal SearchData As Long, _
    ByVal InvokeKinds As InvokeKinds, _
    Optional ByVal MemberName As String) As String
    '*****************************
    'Purpose: To return the data type of a property
    '*****************************
    On Error GoTo exitFunction
    Dim tliParameterInfo As ParameterInfo
    Dim bFirstParameter As Boolean
    Dim bIsConstant As Boolean
    Dim bByVal As Boolean
    Dim strReturn As String
    Dim ConstVal As Variant
    Dim strTypeName As String
    Dim intVarTypeCur As Integer
    Dim bDefault As Boolean
    Dim bOptional As Boolean
    Dim bParamArray As Boolean
    Dim tliTypeInfo As TypeInfo
    Dim tliResolvedTypeInfo As TypeInfo
    Dim tliTypeKinds As TypeKinds

    With tliTypeLibInfo

        'First, determine the type of member we're dealing with
        bIsConstant = GetSearchType(SearchData) And tliStConstants
        With .GetMemberInfo(SearchData, InvokeKinds, , MemberName)


            If bIsConstant Then
                ConstVal = .Value
                strReturn = strReturn & " = " & ConstVal
                Select Case VarType(ConstVal)
                    Case vbInteger, vbLong
                        If ConstVal < 0 Or ConstVal > 15 Then
                            strReturn = strReturn & " (&H" & Hex$(ConstVal) & ")"
                        End If
                End Select
            Else
                With .ReturnType
                    intVarTypeCur = .VarType
                    If intVarTypeCur = 0 Or (intVarTypeCur And Not (VT_ARRAY Or VT_VECTOR)) = 0 Then
                        On Error Resume Next
                        If Not .TypeInfo Is Nothing Then
                            If Err Then                    'Information not available
                                strReturn = strReturn & " As ?"
                            Else
                                If .IsExternalType Then
                                    strReturn = strReturn & .TypeLibInfoExternal.Name & "." & .TypeInfo.Name
                                Else
                                    strReturn = strReturn & .TypeInfo.Name
                                End If
                            End If
                        End If

                        If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                            strReturn = strReturn & "()"
                        End If
                        On Error GoTo 0
                    Else
                        Select Case intVarTypeCur
                            Case VT_VARIANT, VT_VOID, VT_HRESULT
                            Case Else
                                strTypeName = TypeName(.TypedVariant)
                                If intVarTypeCur And (VT_ARRAY Or VT_VECTOR) Then
                                    strReturn = strReturn & "() As " & Left$(strTypeName, Len(strTypeName) - 2)
                                Else
                                    strReturn = strReturn & strTypeName
                                End If
                        End Select
                    End If
                End With
            End If