ActiveXDLL免注冊呼叫的方法，如何得到IID名稱

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

uj5u.com熱心網友回復：

標籤：VB基礎類

上一篇：VB編程 讀取檔案 一行一行顯示的問題

下一篇：WIN 10 怎么獲取攝像頭