绿软必备:ActiveXDLL免注册调用的方法 ----------------摘自丹心软件设计

来源:互联网 发布:aipc 知乎 编辑:程序博客网 时间:2024/04/19 04:34

阿国哥的代码(找到链接后再补上),我稍微改良了一下,做绿色软件的朋友肯定用的到。
IDE下可以引用那个dll使用。编译后可以在未注册dll的计算机上正常工作了。
使用方法:
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

原创粉丝点击