VB中定制DllRegisterServer、DllUnregisterServer

最新推荐文章于 2020-12-31 15:23:51 发布

hero_yin

最新推荐文章于 2020-12-31 15:23:51 发布

阅读量1.9k

点赞数

分类专栏： vb 文章标签： vb string function integer cmd library

本文链接：https://blog.csdn.net/hero_yin/article/details/136321

版权

vb 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

VB中定制DllRegisterServer、DllUnregisterServer

-阿鬼（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：

LINK C:/Test/Form1.obj C:/Test/Modulo1.obj C:/Test/Progetto1.obj 
C:/Programmi/Microsoft Visual Studio/VB98/VBAEXE6.lib /ENTRY:__ vbaS 
/OUT:C:/Test/Progetto1.exe /BASE:0x400000 
/SUBSYSTEM:WINDOWS, 4.0 /VERSION:1.0 /DEBUG /DEBUGTYPE:CV /INCREMENTAL:NOT /OPT:REF
/MERGE:.rdata =.text /IGNORE:4078

对于我们来说这些参数没有什么意义，用默认的就行了。这段命令行中并没有包括输出函数，如果我们希望输出函数，可以定义一个.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过程中加入代码：

Public Sub 
     
     
     
     
      
      Main
     
     ()

    Dim cmd As String

    Dim fOut As Long

    Dim sOut As String

    Dim sDef As String

    cmd = Command$

    If InStr(cmd, "/DLL") > 0 And InStr(cmd, "VBAEXE6.LIB") > 0 Then

      fOut = InStr(cmd, "/OUT:")

      sOut = Mid(cmd, fOut + 6, InStr(cmd, "/BASE:") - fOut - 8)

      sDef = Left(sOut, Len(sOut) - 3) + "def"

      If Len(Dir(sDef)) Then

        cmd = cmd & "/DEF:"" "& sDef &" "" "

      End If

End If

    Shell "LINK32.EXE "& cmd

  End Sub

然后编译成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: heroyin888@hotmail.com

QQ: 7878906