VB中定製DllRegisterServer、DllUnregisterServer<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />
-阿鬼（heroyin）
VB作爲一種簡單容易上手的語言，可以讓開發者快速上手，開發速度快，效率高。但它過分的封裝也給開發者帶來諸多不便。
問題的由來
最近本人在開發一個插件結構的項目中就遇到了一個麻煩，我的項目是採用COM架構，框架由DELPHI開發，插件爲COM組件，插件可以由其他語言開發，當然也包括VB。每個插件必須註冊爲一個固定的組件類別（Categories）。在其他語言如VC、DELPHI中實現起來非常簡單，只需要重載DllRegisterServer、DllUnregisterServer在兩個函數里加入註冊註銷類別的代碼，然後輸出就可以了。但到了VB就碰到麻煩了。
VB正常情況下是不能直接開發標準DLL，所以也就不支持自定義導出函數，開發ACTIVE DLL的時候，是由VB自動導出必須的四個函數DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer。要加入註冊註銷類別代碼就必須重新導出DllRegisterServer, DllUnregisterServer。
好了，問題就轉換成了如何在VB寫的DLL中導出函數了
VB編譯內幕
VB的編譯過程大致如下，當我們在編輯環境中編寫完代碼後，VB調用C2將所有的模塊（包括CLASS）編譯成OBJ文件（能夠爲機器語言識別的代碼）。一下是C2的一些編譯參數說明（E文）：
- the the name of the prefixed one used for the names of the rowscontaining ' precompilato', one
risen of intermediate tails (from which name of the switch) temporary; these rows are 5 and finish withi suffissi GL, SY, FORMER, IN and DB; they contained are not documented
- f the name of the rows to compile
- W3 warning level 3, level of ' attenzione' dedicating to i warnings
- Gy it qualifies the connection to level of function (function-level linking)
- G5 optimization for the Pentium
- Gs4096 it allows not to insert the code for the control of stack (stack probe) if a function does not
use more than 4096 byte of stack
- dos not documented
- Z1 it removes the name of the bookcase of default from the rows.OBJ
- Fofileobj the name of rows OBJ to generate (rows output)
- Qifdiv it puts in action the corrections for the bug of the division of the Pentium (FDIV bug)
- MILILITER it creates rows eseguibile single-threaded
- basic it indicates the compiler C2 the fact that the compilation it happens for a plan basic
C2完成編譯後，VB會調用LINK.EXE將所有的OBJ文件連接成EXE文件，完成編譯過程。下面是一段命令行演示如何調用LINK.EXE：
對於我們來說這些參數沒有什麼意義，用默認的就行了。這段命令行中並沒有包括輸出函數，如果我們希望輸出函數，可以定義一個.def文件，按照格式加入要輸出的函數列表，然後在命令行後面加上 “/DEF: 文件名”（當然也可以直接加/ EXPORTS參數），再調用命令行編譯，用的denpendency工具查看你就會發現你要輸出的函數了。
Def文件格式的定義：
LIBRARY 程序名稱
DESCRIPTION "MyDLL - (C) Antonio Giuliana, 2004"
EXPORTS
函數名= ?函數名@函數所在模塊名@@AAGXXZ
…
例：
LIBRARY MyDLL
DESCRIPTION "MyDLL - (C) Antonio Giuliana, 2004"
EXPORTS
DllRegisterServer= ?DllRegisterServer@SymExp@@AAGXXZ
DllUnregisterServer= ?DllUnregisterServer@SymExp@@AAGXXZ
注意：函數名和模塊名是區分大小寫的
找到了解決方案了，但是，由於VB編譯完成後就會自動刪除OBJ文件，如何再C2生成完OBJ文件後中斷編譯過程取得OBJ文件呢，網上有種方法就是替換調VB的LINK文件，然後中斷一下，將OBJ文件拷貝出來，在用命令行編譯。這是個很好的辦法，但不夠智能化，本人在國外網站上發現了一個更爲有效的方法。
製作VB的輔助編譯工具
新建一個工程，命名爲LINK，在MAIN過程中加入代碼：
然後編譯成LINK.EXE，先將VB目錄下的LINK.EXE改名成LINK32.EXE，再將LINK.EXE拷貝到VB目錄下，這樣做的好處是不改變原有的編譯過程，只是在編譯DLL的時候才插入“/DEF:”參數，不會對編譯其他程序造成影響。
完成了替換操作後，如果要輸出其他函數，只需要在程序輸出目錄下編輯一個和輸出文件同名的後綴爲“.DEF”的文件就可以了。
開始替換DllRegisterServer、DllUnregisterServer
1、製作註冊和註銷的工具庫ComRegisterDll
新建一個工程，引入兩個庫：ISA helper Com component 1.0 type library和 TypeLib Information。再創建一個類ComRegister，在ComRegister類中實現一個方法：
RegTypelib(sLib As String, ByVal bState As Boolean, ByVal bThreadModel As eThreadModel)用來實現註冊和註銷ACTIVEX。代碼如下：
Option Explicit
Public Enum eThreadModel
tmApartment = 0& '"Apartment"
tmSingle = 1& '"Single"
End Enum
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Enum eSYSKIND
SYS_WIN16 = 0&
SYS_WIN32 = 1&
SYS_MAC = 2&
End Enum
Private Declare Function LoadTypeLib Lib "oleaut32.dll" ( _
pFileName As Byte, pptlib As Object) As Long
Private Declare Function RegisterTypeLib Lib "oleaut32.dll" ( _
ByVal ptlib As Object, szFullPath As Byte, _
szHelpFile As Byte) As Long
Private Declare Function UnRegisterTypeLib Lib "oleaut32.dll" ( _
libID As GUID, ByVal wVerMajor As Integer, _
ByVal wVerMinor As Integer, ByVal lCID As Long, _
ByVal tSysKind As eSYSKIND) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (lpsz As Byte, pclsid As GUID) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Function Message(eStr As String)
MessageBox 0, eStr, "", 0
End Function
Private Function GetModulePath(bModuleName As String) As String
Dim ModleId As Long
Dim Path As String * 254
ModleId = GetModuleHandle(bModuleName)
Call GetModuleFileName(ModleId, Path, 254)
GetModulePath = Path
End Function
Private Function SetKeyAndValue(ByVal szKey As String, _
ByVal szSubkey As String, ByVal szValue As String) As Boolean
Dim cR As New cRegistry
cR.ClassKey = HKEY_CLASSES_ROOT
cR.SectionKey = szKey
cR.CreateKey
cR.ValueKey = szSubkey
cR.ValueType = REG_SZ
cR.Value = szValue
End Function
Private Function RegisterServer(ByVal clsid As String, _
ByVal szFileName As String, ByVal szProgID As String, _
ByVal szDescription As String, ByVal szVerIndProgID As String) As Long
Dim szKey As String
szKey = "CLSID/" + clsid + "/"
SetKeyAndValue szKey, "", szDescription
SetKeyAndValue szKey + "InprocServer32/", "", szFileName
If (szProgID <> "") Then
SetKeyAndValue szKey + "ProgID/", "", szProgID
SetKeyAndValue szProgID + "/CLSID/", "", clsid
End If
If (szVerIndProgID <> "") Then
' Add the version-independent ProgID subkey under CLSID key.
SetKeyAndValue szKey + "VersionIndependentProgID", "", szVerIndProgID
' Add the version-independent ProgID subkey under HKEY_CLASSES_ROOT.
SetKeyAndValue szVerIndProgID, "", szDescription
SetKeyAndValue szVerIndProgID + "/CLSID/", "", clsid
SetKeyAndValue szVerIndProgID + "CurVer/", "", szProgID
' Add the versioned ProgID subkey under HKEY_CLASSES_ROOT.
SetKeyAndValue szProgID, "", szDescription
SetKeyAndValue szProgID + "/CLSID/", "", clsid
End If
End Function
Private Function DeleteAllKey(bClassKey As ERegistryClassConstants, bParentKey As String, bSubKey As String) As Boolean
Dim cR As New cRegistry
cR.ClassKey = bClassKey
cR.SectionKey = bParentKey + "/" + bSubKey
Dim hKey() As String
Dim hCount As Long
Dim I As Long
Dim ReturnResult As Boolean
cR.EnumerateSections hKey, hCount
For I = 1 To hCount
If Not DeleteAllKey(bClassKey, bParentKey + "/" + bSubKey, hKey(I)) Then
DeleteAllKey = False
Exit Function
End If
Next
cR.SectionKey = bParentKey
cR.ValueKey = bSubKey
DeleteAllKey = cR.DeleteKey()
End Function
Private Function UnregisterServer(ByVal clsid As String, _
ByVal szProgID As String, _
ByVal szVerIndProgID As String)
DeleteAllKey HKEY_CLASSES_ROOT, "CLSID", clsid
End Function
Public Function RegTypelib(sLib As String, ByVal bState As Boolean, _
bClassName As String, _
ByVal bThreadModel As eThreadModel) As Long
Dim suLib() As Byte
Dim errOK As Long
Dim bClassGuid As String
Dim cTLI As TypeLibInfo
Dim iMajor As Integer, iMinor As Integer
Dim DllPath As String
DllPath = GetModulePath(sLib)
Set cTLI = TLI.TypeLibInfoFromFile(DllPath)
bClassGuid = cTLI.CoClasses.NamedItem(bClassName).GUID
iMajor = cTLI.CoClasses.NamedItem(bClassName).MajorVersion
iMinor = cTLI.CoClasses.NamedItem(bClassName).MinorVersion
Set TypeReg2 = TypeReg
If bState Then
Dim szKey As String
szKey = "CLSID/" + bClassGuid + "/"
SetKeyAndValue szKey, "", sLib + "." + bClassName
SetKeyAndValue szKey + "InprocServer32/", "", DllPath
Select Case bThreadModel
Case tmApartment
SetKeyAndValue szKey + "InprocServer32/", "ThreadingModel", "Apartment"
Case tmSingle
SetKeyAndValue szKey + "InprocServer32/", "ThreadingModel", "Single"
End Select
SetKeyAndValue szKey + "VersionIndependentProgID/", "", sLib + "." + bClassName
SetKeyAndValue szKey + "ProgID/", "", sLib + "." + bClassName
SetKeyAndValue sLib + "." + bClassName + "/CLSID/", "", bClassGuid
SetKeyAndValue szKey + "Version/", "", iMajor & "." & iMinor
SetKeyAndValue szKey + "TypeLib/", "", cTLI.GUID
Else
UnregisterServer bClassGuid, "", sLib + "." + bClassName
End If
Set cTLI = Nothing
End Function
將工程編譯成ComRegiterDll.dll，註冊。這個庫爲公用庫，所有需要重新定製DllRegisterServer、DllUnregisterServer的工程都可以方便的引用它來方便的完成註冊和註銷過程。
2、定製DllRegisterServer、DllUnregisterServer
新建一個工程MyDll，引入ComRegiterDll.dll，添加一個MODULE mainmodule，在mainmodule中新建兩個函數DllRegisterServer、DllUnregisterServer：
Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Function DllRegisterServer() As Long
Dim ComReg As ComRegister
Set ComReg = New ComRegister
‘加入你的處理代碼
MessageBox 0, ”註冊過程”, “MYDLL”, 0
DllRegisterServer = ComReg.RegTypelib("MyDll", True, tmApartment )
End Function
Public Function DllUnregisterServer() As Long
Dim ComReg As ComRegister
Set ComReg = New ComRegister
‘加入你的處理代碼
MessageBox 0, ”註銷過程”, “MYDLL”, 0
DllUnregisterServer = ComReg.RegTypelib("MyDll", False, tmApartment )
End Function
在程序目錄中新建一個mydll.def，def文件內容如下：
LIBRARY MyDLL
DESCRIPTION "MyDLL - (C) Antonio Giuliana, 2004"
EXPORTS
DllRegisterServer= ?DllRegisterServer@ mainmodule @@AAGXXZ
DllUnregisterServer= ?DllUnregisterServer@ mainmodule @@AAGXXZ
保存，編譯，運行regsvr32註冊mydll你就發現彈出對話框“註冊過程“
結束語
本人使用導出函數的方法引自：http://www.visual-basic.it/uploads/articoli/tecnici/agDllByVB.htm
本人在實現過程中還碰到了一些問題，就是在導出的函數過程中使用很多方法都會有限制，可能是由於VB的一下全局對象未初始化引起的，所以就把註冊方法封裝到ComRegisterDll.dll中，再去引用，如果不依靠ComRegisterDll.dll而直接將ComRegister放到要註冊的DLL的單元中去引用就會出錯，歡迎大家與我一起探討這個問題的解決方案。
另：本人沒有個人空間不方便把源碼上傳，如有需要可與本人聯繫:
E-MAIL: [email protected]
QQ: 7878906