ActiveXDLL免注册调用的方法(改良自阿国哥的源码)

绿软必备：ActiveXDLL免注册调用的方法(改良自阿国哥的源码)
http://blog.csdn.net/Modest/archive/2007/09/01/1767950.aspx

这个代码虽说在网上很容易找到了，但经典的那么优雅、那么变态还是值得让大家再欣赏一下的。

Dim pDll As Long '记录Dll，用来最后完美释放
Dim Update As Update.Handle '要实例化的对象
Set Update = LoadObjectByName(App.Path & "\Update.dll", "Handle", pDll) ' New Update.Handle
If Update Is Nothing Then Exit Sub
Update.Test '<--类中的方法
Set Update = Nothing '<-----这句不能少，否则会出现意外错误
UnLoadDll pDll '<----释放

模块中：
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function CallAsmCode Lib "user32" Alias "CallWindowProcW" (FirstAsmCode As Long, ByVal pA As Long, ByVal pB As Long, ByVal pC As Long, lpD As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private AsmCode(94) As Long

Public Function LoadObjectByName(ByVal DllPath As String, ByVal ClsName As String, pDll As Long) As Object
    Dim pObj As Long, TLIAPP As Object, TLI As Object
    Dim CLSID As String, IID As String, IIDName As String

    On Error GoTo Err

    Set TLIAPP = CreateObject("TLI.TLIApplication")
    Set TLI = TLIAPP.TypeLibInfoFromFile(DllPath)

    IIDName = "_" & Trim(ClsName)

    CLSID = TLI.GetTypeInfo(Trim(ClsName)).GUID
    IID = TLI.GetTypeInfo(Trim(IIDName)).GUID

    Set LoadObjectByName = LoadObjectByID(DllPath, CLSID, IID, pDll)
    Set TLI = Nothing
Err:
End Function

Public Function LoadObjectByID(ByVal DllPath As String, ByVal CLSID As String, ByVal IID As String, pDll As Long) As Object
    Dim pObj As Long
    Call InitAsmCode
    pObj = CallAsmCode(AsmCode(20), StrPtr(DllPath), StrPtr(CLSID), StrPtr(IID), pDll)
    CopyMemory LoadObjectByID, pObj&, 4&
End Function

Public Function UnLoadDll(pDll As Long) As Long
    Call InitAsmCode
    UnLoadDll = CallAsmCode(AsmCode(79), pDll, 0, 0, 0)
End Function

Private Sub InitAsmCode()
    If AsmCode(4) Then Exit Sub
    Dim pDll As Long

    pDll = LoadLibrary(StrPtr("kernel32"))
    AsmCode(0) = GetProcAddress(pDll, "LoadLibraryW")
    AsmCode(1) = GetProcAddress(pDll, "GetProcAddress")
    AsmCode(2) = GetProcAddress(pDll, "FreeLibrary")
    Call FreeLibrary(pDll)

    AsmCode(4) = &H476C6C44
    AsmCode(5) = &H6C437465
    AsmCode(6) = &H4F737361
    AsmCode(7) = &H63656A62
    AsmCode(8) = &H4C430074
    AsmCode(9) = &H46444953
    AsmCode(10) = &H536D6F72
    AsmCode(11) = &H6E697274
    AsmCode(12) = &H10067
    AsmCode(13) = &H0&
    AsmCode(14) = &HC00000
    AsmCode(15) = &H0&
    AsmCode(16) = &H6F4600
    AsmCode(17) = &H65006C
    AsmCode(18) = &H320033
    AsmCode(19) = &H0&
    AsmCode(20) = &H83EC8B55                               '创建对象函数入口
    AsmCode(21) = &HE853D8C4
    AsmCode(22) = &H0&
    AsmCode(23) = &H6CEB815B
    AsmCode(24) = &H8D100010
    AsmCode(25) = &H105293
    AsmCode(26) = &H93FF5210
    AsmCode(27) = &H10001010
    AsmCode(28) = &H32938D50
    AsmCode(29) = &H52100010
    AsmCode(30) = &H1493FF50
    AsmCode(31) = &H8D100010
    AsmCode(32) = &H101C93
    AsmCode(33) = &HFF028910
    AsmCode(34) = &H101893
    AsmCode(35) = &H875FF10
    AsmCode(36) = &H101093FF
    AsmCode(37) = &HC00B1000
    AsmCode(38) = &H86840F
    AsmCode(39) = &H45890000
    AsmCode(40) = &H20938DFC
    AsmCode(41) = &H52100010
    AsmCode(42) = &H1493FF50
    AsmCode(43) = &HB100010
    AsmCode(44) = &H506674C0
    AsmCode(45) = &H52EC558D
    AsmCode(46) = &HFF0C75FF
    AsmCode(47) = &H101C93
    AsmCode(48) = &H558D5810
    AsmCode(49) = &H938D52D8
    AsmCode(50) = &H10001042
    AsmCode(51) = &HEC558D52
    AsmCode(52) = &HBD0FF52
    AsmCode(53) = &H8D3E75C0
    AsmCode(54) = &HFF52DC55
    AsmCode(55) = &H93FF1075
    AsmCode(56) = &H1000101C
    AsmCode(57) = &HD8558B50
    AsmCode(58) = &H8D54128B
    AsmCode(59) = &H6A50DC45
    AsmCode(60) = &HD875FF00
    AsmCode(61) = &HB0C52FF
    AsmCode(62) = &H8B1575C0
    AsmCode(63) = &H4D8BFC45
    AsmCode(64) = &H59018914
    AsmCode(65) = &H8BD18B51
    AsmCode(66) = &H52FF5112
    AsmCode(67) = &H14EB5804
    AsmCode(68) = &HEB06EB58
    AsmCode(69) = &HEB02EB0F
    AsmCode(70) = &HFC75FF0B
    AsmCode(71) = &H101893FF
    AsmCode(72) = &HC0331000
    AsmCode(73) = &H10C2C95B
    AsmCode(74) = &H6C6C4400
    AsmCode(75) = &H556E6143
    AsmCode(76) = &H616F6C6E
    AsmCode(77) = &H776F4E64
    AsmCode(78) = &H0&
    AsmCode(79) = &H53EC8B55                               '尝试卸载DLL函数入口
    AsmCode(80) = &HE8&
    AsmCode(81) = &HEB815B00
    AsmCode(82) = &H10001155
    AsmCode(83) = &H1139938D
    AsmCode(84) = &HFF521000
    AsmCode(85) = &H93FF0875
    AsmCode(86) = &H10001014
    AsmCode(87) = &H1374C00B
    AsmCode(88) = &HC00BD0FF
    AsmCode(89) = &H75FF0E74
    AsmCode(90) = &H1893FF08
    AsmCode(91) = &H33100010
    AsmCode(92) = &H4801EBC0
    AsmCode(93) = &H10C2C95B
    AsmCode(94) = &H90909000
End Sub