typelib.bas

guan yu pai ke xi tong de ruan jian

Attribute VB_Name = "mTypeLib"
Option Explicit
'Public Type GUID
'    Data1 As Long
'    Data2 As Long
'    Data3 As Long
'    Data4(0 To 7) As Byte
'End Type
'Public Enum SYSKIND
'    SYS_WIN16 = 0
'    SYS_WIN32 = 1
'    SYS_MAC = 2
'End Enum
'该模块专门负责注册和反注册.
Declare Function LoadTypeLib Lib "oleaut32" (ByVal szFileName As String, lplptlib As Any) As Long
Declare Function RegisterTypeLib Lib "oleaut32" (ByVal ptlib As Any, ByVal szFullPath As String, ByVal szHelpDir As String) As Long
Declare Function UnRegisterTypeLib Lib "oleaut32" (GUID As GUID, ByVal wVerMajor As Long, ByVal wVerMinor As Long, ByVal lCID As Long, ByVal SYSKIND As SYSKIND) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

' 组件注册过程.
'sTypelibPath:注册组件的文件名.
'sHelpPath:注册类型.如果为vbNullChar则表示默认类型.
' 返回True表示成功.否则表示失败.
Public Function RegTypelib(sTypelibPath As String, Optional sHelpPath As String = vbNullChar) As Boolean
    Dim hr As Long
    Dim itlb As ITypeLib
    RegTypelib = False
    hr = LoadTypeLib(StrConv(sTypelibPath, vbUnicode), itlb)
    If hr = 0 Then
        hr = RegisterTypeLib(itlb, StrConv(sTypelibPath, vbUnicode), StrConv(sHelpPath, vbUnicode))
        If hr = 0 Then RegTypelib = True
    End If
End Function

'组件反注册过程.
'sTypelibPath:注册组件的文件名.
'sHelpPath:注册类型.如果为vbNullChar则表示默认类型.
' 返回True表示成功.否则表示失败.
Public Function UnregTypelib(sTypelibPath As String) As Boolean
    Dim hr As Long
    Dim itlb As ITypeLib
    Dim lptlba As Long
    Dim tlba As TLIBATTR
    UnregTypelib = False
    hr = LoadTypeLib(StrConv(sTypelibPath, vbUnicode), itlb)
    If hr = 0 Then
        lptlba = LocalAlloc(&H40, Len(tlba))
        hr = Err.LastDllError
        If lptlba Then
            hr = itlb.GetLibAttr(lptlba)
            If hr = 0 Then
                MoveMemory tlba, ByVal lptlba, Len(tlba)
                With tlba
                    hr = UnRegisterTypeLib(.GUID, .wMajorVerNum, .wMinorVerNum, .lCID, .SYSKIND)
                End With
            End If
            Call LocalFree(lptlba)
        End If
    End If
    If hr = 0 Then UnregTypelib = True
End Function