VB使用未注册的ActiveX代码
来源:优易学  2011-12-10 20:08:44   【优易学:中国教育考试门户网】   资料下载   IT书店

  ''(声明:魏滔序原创,转贴请注明出处。)
  ''阿国哥的代码(找到链接后再补上),我稍微改良了一下,做绿色软件的朋友肯定用的到。
  ''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()Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
  Private Declare Function GetProcAddress()Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  Private Declare Function FreeLibrary()Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  Private Declare Function CallAsmCode()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()Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  Private AsmCode(94) As Long
  Public Function LoadObjectByName()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()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()Function UnLoadDll(pDll As Long) As Long
  Call InitAsmCode
  UnLoadDll = CallAsmCode(AsmCode(79), pDll, 0, 0, 0)
  End Function
  Private Sub InitAsmCode()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

[1] [2] 下一页

责任编辑:小草

文章搜索:
 相关文章
热点资讯
资讯快报
热门课程培训