vb.netuuid的简单介绍

用VB制作一个简易的网页登陆器

你是直接在VB中加载登录窗口进行登录，还是在浏览器中做插件进行登录？

创新互联建站基于成都重庆香港及美国等地区分布式IDC机房数据中心构建的电信大带宽，联通大带宽，移动大带宽，多线BGP大带宽租用,是为众多客户提供专业服务器托管报价，主机托管价格性价比高，为金融证券行业内蒙古服务器托管，ai人工智能服务器托管提供bgp线路100M独享，G口带宽及机柜租用的专业成都idc公司。

在VB中进行登录：

'函数功能：     登陆网页

'输入参数：     WB:webbrower控件，sURL：网址，OverTime：超时时间，UserName：用户名，UserPWD：用户密码，InPutName：用户名输入框，InPutPWD：密码输入框，LoginFrom：登陆窗体，BtnName：登陆按钮名字

'输出参数：     无

'返回值：       True：成功，false：失败

'******************************************************************

Public Function LoginUrl(WB As WebBrowser, sURL As String, OverTime As Long, UserName As String, UserPWD As String, InputName As String, InputPWD As String, LoginFrom As String, BtnName As String) As Boolean

On Error GoTo errorHandle

bHtmlFlag = False

Set sDocument = WB.Document

sDocument.getElementById(InputName).Value = UserName

sDocument.getElementById(InputPWD).Value = UserPWD

If BtnName = "" Then

sDocument.Forms(LoginFrom).submit

Else

sDocument.getElementById(BtnName).Click

End If

If HtmlOverTime(OverTime, sURL) = 1 Then        '判断超时

LoginUrl = False

InsertLog "登陆网址："  sURL  "失败！", 1

Exit Function

End If

LoginUrl = True

Exit Function

errorHandle:

InsertLog "错误号:"  Err.Number  "错误描述:"  Err.Description, 1

Debug.Print Err.Description

Err.Clear

End Function

'******************************************************************

'创建日期：     2008-10-28

'函数功能：     判断网页打开是否超时

'输入参数：     sTime：超时时间

'输出参数：     无

'返回值：       0:成功，1：失败

'******************************************************************

Public Function HtmlOverTime(sTime As Long, sURL As String) As Long

t = GetTickCount

Do Until bHtmlFlag = True

DoEvents

If GetTickCount - t  sTime Then

InsertLog "打开网址："  sURL  "失败！", 1

HtmlOverTime = 1

Exit Function

End If

Loop

HtmlOverTime = 0

End Function

如果用插件的 复杂一些，可以查找olelib的知识

'引用olelib实现IObjectWithSite接口来获得IE对象

Implements olelib.IObjectWithSite

'

Private WithEvents m_IEObj As InternetExplorer

Attribute m_IEObj.VB_VarHelpID = -1

Private m_site As olelib.IUnknown

Private sDoc    As New MSHTML.HTMLDocument

Private Sub IObjectWithSite_GetSite(riid As olelib.UUID, ppvSite As stdole.IUnknown)

m_site.QueryInterface riid, ppvSite

End Sub

Private Sub IObjectWithSite_SetSite(ByVal pUnkSite As stdole.IUnknown)

Set m_site = pUnkSite

Set m_IEObj = pUnkSite

End Sub

'========================================================

'网页加载完成后要处理

'

'

'========================================================

Private Sub m_IEObj_DocumentComplete(ByVal pDisp As Object, URL As Variant)

On Error Resume Next

Dim strHTML     As String

Dim strScript       As String

Dim scDoc           As New MSHTML.HTMLDocument

Dim sHeads          As IHTMLElementCollection

Dim sHead           As IHTMLHeadElement

Dim sElement        As IHTMLElement

'获取Script脚本内容

strScript = getHTMLScript

'MsgBox URL

If InStr(URL, "zs/browseShenbao.do?formId=")  0 Then

'获取添加按钮的html语句

strHTML = GetIni("HTML", "String1", App.Path  "\HtmlMark.ini")

Set sDoc = m_IEObj.Document

Set scDoc = sDoc.parentWindow.Document.frames("workspace").Document.frames("top_Frame").Document

Set scDoc = scDoc.frames("mainFrame").Document

'获取HEAD头的对象

Set sHeads = scDoc.getElementsByTagName("HEAD")

Set sHead = sHeads(0)

'创建script的节点

Set sElement = scDoc.createElement("script")

sElement.setAttribute "language", "JavaScript"

sElement.setAttribute "text", strScript

'把script的节点插入到head中

Call sHead.insertBefore(sElement, Null)

'把按钮的html语句插入到页面中

scDoc.body.innerHTML = scDoc.body.innerHTML  strHTML

End If

'

If InStr(URL, "/initArchive.do")  0 Then

Set sDoc = m_IEObj.Document

'获取添加按钮的html语句

strHTML = GetIni("HTML", "String2", App.Path  "\HtmlMark.ini")

Set scDoc = sDoc.parentWindow.Document.frames("workspace").Document.frames("top_Frame").Document

Set scDoc = scDoc.frames("mainFrame").Document

'获取HEAD头的对象

Set sHeads = scDoc.getElementsByTagName("HEAD")

Set sHead = sHeads(0)

'创建script的节点

Set sElement = scDoc.createElement("script")

sElement.setAttribute "language", "JavaScript"

sElement.setAttribute "text", strScript

'把script的节点插入到head中

Call sHead.insertBefore(sElement, Null)

'把按钮的html语句插入到页面中

scDoc.body.innerHTML = scDoc.body.innerHTML  strHTML

End If

'档案查询页面

If InStr(URL, "/showDangAn.do?")  0 Then

Set sDoc = m_IEObj.Document

'获取添加按钮的html语句

strHTML = GetIni("HTML", "String3", App.Path  "\HtmlMark.ini")

'MsgBox "strHTML---------"  strHTML

'MsgBox sDoc.body.innerHTML

Set scDoc = sDoc.parentWindow.Document.frames("workspace").Document.frames("top_Frame").Document

Set scDoc = scDoc.frames("mainFrame").Document

'MsgBox scDoc.body.innerHTML

'获取HEAD头的对象

Set sHeads = scDoc.getElementsByTagName("HEAD")

Set sHead = sHeads(0)

'创建script的节点

Set sElement = scDoc.createElement("script")

sElement.setAttribute "language", "JavaScript"

sElement.setAttribute "text", strScript

'把script的节点插入到head中

Call sHead.insertBefore(sElement, Null)

'把按钮的html语句插入到页面中

scDoc.body.innerHTML = scDoc.body.innerHTML  strHTML

End If

End Sub

如何使用 CoCreateGUID API 生成与 VB 6 的 GUID

通用的GUID的结构如下

typedef struct _GUID {

DWORD Data1;

WORD Data2;

WORD Data3;

BYTE Data4[8];

} GUID;

举一个例子：

假设一个GUID的格式是这样的 6B29FC40-CA47-1067-B31D-00DD010662DA

其中Data1 是32位，可以看做8个四位十六进制数，对应于上面的6B29FC40

其中Data2 是16位，可以看做4个四位十六进制数，对应于上面的CA47

其中Data3 是16位，可以看做4个四位十六进制数，对应于上面的1067

其中Data4 比较特殊，是8个字节也就可以看做16个四位十六进制数

取其Data4[0],Data4[1]来组成4个四位十六进制数，对应于上面的B31D

取其Data4[2],Data4[3]来组成4个四位十六进制数，对应于上面的00DD

取其Data4[4],Data4[5]来组成4个四位十六进制数，对应于上面的0106

取其Data4[6],Data4[7]来组成4个四位十六进制数，对应于上面的62DA

*注意：四位十六进制数对应一个GUID字符。

在Windows下提供了一个函数可以生成一个GUID。需要使用的头文件 "objbase.h"，需要链接的库ole32.lib。

HRESULT CoCreateGuid(GUID * pguid);

在Linux下首先需要下载到相应的库文件和头文件

如果是Debian用户可以方便的通过apt命令来获取相关资源。

apt-get install uuid-dev

安装完成后会发现

在/usr/include/ 下有一个uuid文件夹，其中则包含了uuid.h头文件。

在/usr/lib/ 下有几个libuuid*的链接库文件，包括静态和动态链接库。

打开uuid.h你会发现有一个uuid_generate(uuid_t out) 的函数声明。我们可以通过调用这个函数来生成UUID。

uuid_generate(reinterpret_castunsigned char *(guid));

生成GUID是不是很简单！是的，因为生成的算法不用我们去实现，我们是站在前人的肩膀所以我们要感谢他们。

下面给出一个WINDOWS和LINUX下通用的程序。

// uuid_test.cpp

#include string

#include stdio.h

#include iostream

#include "uuid_test.hpp"

#ifdef WIN32

#include objbase.h

#else

#include uuid/uuid.h

#endif

using namespace std;

namespace ChinuxTeam

{

GUID CreateGuid()

{

GUID guid;

#ifdef WIN32

CoCreateGuid(guid);

#else

uuid_generate(reinterpret_castunsigned char *(guid));

#endif

return guid;

}

std::string GuidToString(const GUID guid)

{

char buf[64] = {0};

#ifdef __GNUC__

snprintf(

#else // MSVC

_snprintf_s(

#endif

buf,

sizeof(buf),

"{%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X}",

guid.Data1, guid.Data2, guid.Data3,

guid.Data4[0], guid.Data4[1],

guid.Data4[2], guid.Data4[3],

guid.Data4[4], guid.Data4[5],

guid.Data4[6], guid.Data4[7]);

return std::string(buf);

}

}

对应的头文件

// uuid_test.hpp"

#include string

#include stdio.h

#include iostream

typedef struct _GUID

{

unsigned long Data1;

unsigned short Data2;

unsigned short Data3;

unsigned char Data4[8];

} GUID, UUID;

namespace ChinuxTeam

{

GUID CreateGuid();

std::string GuidToString(const GUID guid);

}// namespace ChinuxTeam

最后一个 GuidToString()稍微解释一下，作用就是把GUID以固定的格式输出到标准string字符串中，

根据编译器的不同调用分别调用了不同的字符串打印函数。

另外附一个简单的测试函数

#include string

#include stdio.h

#include iostream

#ifdef WIN32

#include "objbase.h"

#else

typedef struct _GUID

{

unsigned long Data1;

unsigned short Data2;

unsigned short Data3;

unsigned char Data4[8];

} GUID, UUID;

#endif

namespace ChinuxTeam{

GUID CreateGuid();

std::string GuidToString(const GUID guid);

}

运行后会生成一个GUID并打印到标准输出的控制台上。

如何用VB写安全控件

把下列内容拷贝到“记事本”中，然后保存到上述文件夹，文件名为Objsafe.odl：

[

uuid(C67830E0-D11D-11cf-BD80-00AA00575603),

helpstring("VB IObjectSafety Interface"),

version(1.0)

]

library IObjectSafetyTLB

{

importlib("stdole2.tlb");

[

uuid(CB5BDC81-93C1-11cf-8F20-00805F2CD064),

helpstring("IObjectSafety Interface"),

odl

]

interface IObjectSafety:IUnknown {

[helpstring("GetInterfaceSafetyOptions")]

HRESULT GetInterfaceSafetyOptions(

[in] long riid,

[in] long *pdwSupportedOptions,

[in] long *pdwEnabledOptions);

[helpstring("SetInterfaceSafetyOptions")]

HRESULT SetInterfaceSafetyOptions(

[in] long riid,

[in] long dwOptionsSetMask,

[in] long dwEnabledOptions);

}

}

在命令行提示符下切换到项目文件夹，输入下列命令创建一个.tlb 文件：

MKTYPLIB objsafe.odl /tlb objsafe.tlb

在VB中新建一个ActiveX Control 项目。修改属性，把项目命名为IobjSafety，控件命名为DemoCtl。在控件上放置一个按钮，命名为cmdTest，在它的Click事件中加入一句代码 MsgBox "Test" 。

打开菜单“工程-引用”，点“浏览”，找到刚刚建立的Objsafe.tlb，把它加入到引用中。

增加一个新module名为basSafeCtl，并在其中加入下列代码：

Option Explicit

Public Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Public Const IID_IPersistStorage = _

"{0000010A-0000-0000-C000-000000000046}"

Public Const IID_IPersistStream = _

"{00000109-0000-0000-C000-000000000046}"

Public Const IID_IPersistPropertyBag = _

"{37D84F60-42CB-11CE-8135-00AA004BB851}"

Public Const INTERFACESAFE_FOR_UNTRUSTED_CALLER = H1

Public Const INTERFACESAFE_FOR_UNTRUSTED_DATA = H2

Public Const E_NOINTERFACE = H80004002

Public Const E_FAIL = H80004005

Public Const MAX_GUIDLEN = 40

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As _

Any, ByVal lpstrClsId As Long, ByVal cbMax As Integer) As Long

Public Type udtGUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(7) As Byte

End Type

Public m_fSafeForScripting As Boolean

Public m_fSafeForInitializing As Boolean

Sub Main()

m_fSafeForScripting = True

m_fSafeForInitializing = True

End Sub

在工程属性中把启动对象改成Sub Main确保上述代码会被执行。m_fSafeForScripting 和m_fSafeForInitializing两件变量的值分别指定了脚本安全和初始化安全取值。

打开控件代码窗口，在声明部分加入如下代码(如果有Option Explicit语句，当然要保证代码放在其后)：

Implements IObjectSafety

把下面两个过程代码拷贝到控件代码中：

Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _

Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)

Dim Rc As Long

Dim rClsId As udtGUID

Dim IID As String

Dim bIID() As Byte

pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _

INTERFACESAFE_FOR_UNTRUSTED_DATA

If (riid 0) Then

CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)

Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)

Rc = InStr(1, bIID, vbNullChar) - 1

IID = Left$(UCase(bIID), Rc)

Select Case IID

Case IID_IDispatch

pdwEnabledOptions = IIf(m_fSafeForScripting, _

INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)

Exit Sub

Case IID_IPersistStorage, IID_IPersistStream, _

IID_IPersistPropertyBag

pdwEnabledOptions = IIf(m_fSafeForInitializing, _

INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)

Exit Sub

Case Else

Err.Raise E_NOINTERFACE

Exit Sub

End Select

End If

End Sub

Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _

Long, ByVal dwOptionsSetMask As Long, ByVal dwEnabledOptions As Long)

Dim Rc As Long

Dim rClsId As udtGUID

Dim IID As String

Dim bIID() As Byte

If (riid 0) Then

CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)

Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)

Rc = InStr(1, bIID, vbNullChar) - 1

IID = Left$(UCase(bIID), Rc)

Select Case IID

Case IID_IDispatch

If ((dwEnabledOptions And dwOptionsSetMask) _

INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then

Err.Raise E_FAIL

Exit Sub

Else

If Not m_fSafeForScripting Then

Err.Raise E_FAIL

End If

Exit Sub

End If

Case IID_IPersistStorage, IID_IPersistStream, _

IID_IPersistPropertyBag

If ((dwEnabledOptions And dwOptionsSetMask) _

INTERFACESAFE_FOR_UNTRUSTED_DATA) Then

Err.Raise E_FAIL

Exit Sub

Else

If Not m_fSafeForInitializing Then

Err.Raise E_FAIL

End If

Exit Sub

End If

Case Else

Err.Raise E_NOINTERFACE

Exit Sub

End Select

End If

End Sub

VB 控件使用问题，高手请进

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

致此创建成功！

如何用VB.NET生成GUID

由于各种原因,开发人员使用全局唯一标识符(GUID)，例如，在类中给全局标识符赋值使用GUID或者是在处理数据库的时候使用GUID。GUID是微软分布计算环境（DCE）全局唯一标识符（UUID）的实现。GUID是128位全局唯一标识符，它是根据不断频繁变化的因素自动产生的。有一个相当小的可能性，那就是GUID的值可能都是零，或者是它可能等于其它的GUID。你能使用GUID通过所有需要唯一标识的计算机或者网络。GUID可以标识界面或者类对象。一个 GUID由一组8位的十六进制数和三组4位十六进制数（也就是一组12位十六进制数）组成。在下面的脚本中，我手动生成了GUID，我利用VB.NET在后面的应用中使用了它：Private Sub GenerateGUID() Dim sGUID As String sGUID = System.GUID.NewGUID.ToString() MessageBox.Show(sGUID) End Sub在这个例子中，我定义了一个字符串变量，sGUID，这个变量是用来保存将生成的GUID。然后我再将System.GUID.NewGUID（使用System.GUID名字空间）这个方法的返回值赋给sGUID，再使用ToString()将这个结果转换成字符串类型。这样就可以在消息对话框中显示这个结果了。注意：Visual Studio .NET允许你通过运行Visual Studio .NET Command Prompt交互生成GUID。可以访问MSDN网站获得更详细的信息。你也可以参考TechRepublic的另一篇文章“Generating and working with GUIDs in .NET。