VB 控件使用问题,高手请进 30

VB工程里需要引入一个DLL控件,可以通过两种方式引入:引用、部件。通过引用的方式(dimwitheventsaasA),可以new出来对象,调用其中的方法,一般的方法是... VB工程里需要引入一个DLL控件,可以通过两种方式引入:引用、部件。
通过引用的方式(dim withevents a as A),可以new出来对象,调用其中的方法,一般的方法是正常的,但是其中有个监听USB拔插的方法无法响应。
通过部件的方式调用,将部件拖到窗体里,则所有的方法都是正常的。但是这种方式有个问题:如果用户没有安装这个控件,打开程序的时候就会报错。

有没有一种方法可以实现拔插事件的响应:动态插入部件?或是其它的方法,请大神指点。
展开
 我来答
tcjj3
2014-04-09 · 超过19用户采纳过TA的回答
知道答主
回答量:53
采纳率:0%
帮助的人:50.1万
展开全部

用CreateObject方法创建控件,或者把对应的文件打包在同一目录,或者打包进程序里面待使用的时候再动态释放出来,还有两种动态调用的方法可供参考:



(1)VB使用未注册的ActiveX代码

''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

  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

  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
 
  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



(2)vb.net 通过类厂创建com对象的方法

     vb.net中要创立com对象可以用new或者CreateObject,就像C++中的CoCreateInstance,一步调用就直接创建了com对象。在它们之中包括了对CoGetClassObject和CreateInstance的调用。默认使用的类厂是IClassFactory。 

    一般情况下,new或CreateObject已经够用了。但是如果我们的com组件增加了授权,也就是使用了IClassFactory2接口。那么在vb中继续用这种方法就不能创建我们所需要的组件了。我们必须使用IClassFactory2。
    在C++中实现很简单。只需要通过CoGetClassObject获得IClassFactory2接口,然后调用它的CreateInstanceLic来创建组件。
    因此,在vb.net中,我们就可以仿照c++中的方法。下面是相关代码:
    首先声明IClassFactory2的接口。IClassFactory2.idl如下:

[
    uuid(6ED6AF97-F279-4d57-A392-0B8ACF89426C),
    version(1.0),
    helpstring("INVENTOROCIDL Type Library 1.0")
]
library INVENTOROCIDL
{
    interface IClassFactory2;

    typedef enum enuCLSCTX
    {
        enuCLSCTX_INPROC_SERVER    = 1,
        enuCLSCTX_INPROC_HANDLER   = 2,
        enuCLSCTX_LOCAL_SERVER     = 4,
        enuCLSCTX_REMOTE_SERVER    = 16,
        enuCLSCTX_NO_CODE_DOWNLOAD = 400,
        enuCLSCTX_NO_FAILURE_LOG = 4000,
        enuCLSCTX_SERVER    = (1 | 4 | 16),
        enuCLSCTX_ALL       = (2 | 1)
    } CLSCTX;

    [
        object,
        uuid(B196B28F-BAB4-101A-B69C-00AA00341D07),
        pointer_default(unique)
    ]

    interface IClassFactory2 : IClassFactory
    {
        typedef IClassFactory2 * LPCLASSFACTORY2;

        typedef struct tagLICINFO {
            LONG cbLicInfo;
            BOOL fRuntimeKeyAvail;
            BOOL fLicVerified;
        } LICINFO;

        typedef struct tagLICINFO * LPLICINFO;

        HRESULT GetLicInfo(
            [out, retval] LICINFO * pLicInfo
            );

        HRESULT RequestLicKey(
            [in] LONG dwReserved,
            [out, retval] BSTR * pBstrKey
            );

        [local]
        HRESULT CreateInstanceLic(
            [in] IUnknown * pUnkOuter,
            [in] IUnknown * pUnkReserved,
            [in] GUID* riid,
            [in] BSTR bstrKey,
            [out, retval, iid_is(riid)] PVOID * ppvObj
            );

    }
}

用midl编译成IClassFactory2.tlb,并导入到vb.net的工程当中。
声明如下api用于得到IClassFactory2接口:

    Declare Function CoGetClassObject Lib "ole32.dll" (ByRef rclsid As Guid, ByVal context As Short, ByRef serverInfo As IntPtr, ByRef riid As Guid, ByRef ppv As IntPtr) As Integer
'添加如下代码:

Const bstrInventorApplication As String = "{B6B5DC40-96E3-11d2-B774-0060B0F159EF}"
    Const bstrIClassFactory2 As String = "{B196B28F-BAB4-101A-B69C-00AA00341D07}"
    Const bstrIDispatch As String = "{00020400-0000-0000-C000-000000000046}"

    Private IClsFry2 As INVENTOROCIDL.IClassFactory2 
    Dim bstrLicence As String = "12345678"   'licence key
    Dim guidInventorApplication As Guid = New Guid(bstrInventorApplication)
    Dim guidIClassFactory2 As Guid = New Guid(bstrIClassFactory2)
    Dim guidIDispatch As Guid = New Guid(bstrIDispatch)
    Dim InventorGuid As INVENTOROCIDL.GUID  'used by CreateInstanceLic,defined in INVENTOROCIDL

     'transform Guid of IDispatch to INVENTOROCIDL.GUID
      Dim byteArry() As Byte = guidIDispatch.ToByteArray()
      Dim MyGC As GCHandle = GCHandle.Alloc(byteArry, GCHandleType.Pinned)
      InventorGuid = CType(Marshal.PtrToStructure(MyGC.AddrOfPinnedObject, InventorGuid.GetType()), INVENTOROCIDL.GUID)

      'get the IClassFactory2 Interface
      Dim obj As IntPtr
      CoGetClassObject(guidInventorApplication, CInt(INVENTOROCIDL.enuCLSCTX.enuCLSCTX_LOCAL_SERVER), Nothing, guidIClassFactory2, obj)
       IClsFry2 = CType(Marshal.GetTypedObjectForIUnknown(obj, System.Type.GetTypeFromCLSID(guidIClassFactory2)), INVENTOROCIDL.IClassFactory2)

        'create Inventor Instance by using Licence
       obj = IClsFry2.CreateInstanceLic(Nothing, Nothing, InventorGuid, bstrLicence)
        InvApp = CType(Marshal.GetTypedObjectForIUnknown(obj, System.Type.GetTypeFromCLSID(guidInventorApplication)), Inventor.Application)

致此创建成功!

sihone
2014-04-09 · TA获得超过1250个赞
知道小有建树答主
回答量:560
采纳率:0%
帮助的人:307万
展开全部
有个最简单的办法了,

没有楼上的那么复杂

只需要把部件拖到窗体里,然后把你的程序打个安装包,用innosetup可以打包,打包时要注意加上注册控件命令,就ok了
本回答被网友采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式