扯会dll，不注册调用com

wy24789 2015-02-09 05:00:54

挺喜欢vb的，个头小巧，本领不小（精简版只几M，就可以写出不错的程序了），调用com，使用系统api都挺方便的，功能也得到了扩展，不过vb只能生成com类型的dll，使用前要注册，相信有部分人不喜欢，网上也有vb生成普通dll的方法，不过好像有些限制不是很好用，再次看到论坛有人发vb生成dll的方法就想谈谈这个话题，个人也是很喜欢dll这个东东的，论坛回帖也是找这方面的有趣的帖子回，其实也是其它方面懂的少啦

先说说com的好，挺好的封装，一个个类，使用方便，面向对象，不知道为什么.net生成的dll缺省不支持com，要做些修改才能用，想要淘汰掉这个技术吗，还是嫌注册表装了太多注册信息了，下面说调用了，知道两个办法
一、以前看别人代码看到的，程序内部带注册语句，使用时如果没注册会自动注册，都在程序内部用代码实现的，不需要其它额外的东西，算挺绿色的吧，只是写注册表了
二、先发段vc不注册调用的代码

typedef HRESULT (__stdcall * pfnHello)(REFCLSID,REFIID,void**);

   pfnHello fnHello= NULL;

   HINSTANCE hdllInst = LoadLibrary("组件所在目录myCom.dll");

   fnHello=(pfnHello)GetProcAddress(hdllInst,"DllGetClassObject");

if (fnHello != 0)

{

   IClassFactory* pcf = NULL;

   HRESULT hr=(fnHello)(CLSID_GetRes,IID_IClassFactory,(void**)&pcf);

   if (SUCCEEDED(hr) && (pcf != NULL))

   {

       IGetRes* pGetRes = NULL;

       hr = pcf->CreateInstance(NULL, IID_IFoo, (void**)&pGetRes);

       if (SUCCEEDED(hr)   && (pFoo != NULL))     //这里pFoo应该改成pGetRes,不过hr成功了，pGetRes应该不会null

       {

           pGetRes->Hello();

           pGetRes->Release();

       }

       pcf->Release();

   }

} 

   FreeLibrary(hdllInst);

直接从dll中得到DllGetClassObject，接着生成类对象及类实例（这方法可以
使组件不用在注册表里注册,这是最原始的方法,但这样做没什么意义,至少失去了COM
对用户的透明性）,不推荐使用.
原帖地址http://www.cppblog.com/woaidongmao/archive/2011/01/10/138250.html
vb这样调用也可以，不过我在测试时用CallWindowProc来调用函数指针失败了，没有返回正确的结果(win7)，后来加个vc的dll来完成这些步骤返回class的，我发一些相关的代码出来，有兴趣的朋友可以试试看能否全部用vb实现
vb的没完成，这段代码需要引用一个ClassFactory的类型库

Option Explicit

Private Declare Function CoInitialize Lib "ole32.dll" (ByVal pvReserved As Long) As Long

Private Declare Function LoadLibrary Lib "Kernel32.dll" Alias "LoadLibraryW" (ByVal lpFileName As Long) As Long

Private Declare Function FreeLibrary Lib "Kernel32.dll" (ByVal hModule As Long) As Long

Private Declare Function GetProcAddress Lib "Kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function DllFunAdrCall Lib "D:\Administrator\Documents\Visual Studio 2008\Projects\dllfunadrcall\Debug\dllfunadrcall.dll" (ByVal hfun As Long, pargs As Long, ByVal count As Long) As Long

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, hWnd As Long, Msg As Long, wParam As Long, lParam As Long) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, pclsid As Long) As Long



'IID_IClassFactory"00000001-0000-0000-C000-000000000046"



Public Function LoadDll_cf(dllname As String, sclsid As String) As BOOL

Dim dll As Long

Dim fun As Long

Dim rt As Long

Dim ccf As CLSID

Dim ccl As CLSID

Dim icf As IClassFactory3

Dim n As Long

Dim pargs(3) As Long

Dim iid2 As CLSID



    rt = CoInitialize(0)

    dll = LoadLibrary(StrPtr(dllname))

    If dll > 0 Then

        fun = GetProcAddress(dll, "DllGetClassObject")

        If fun > 0 Then

            rt = CLSIDFromString(StrPtr(sclsid), ccf.Data1)

            rt = CLSIDFromString(StrPtr("{00000001-0000-0000-C000-000000000046}"), ccl.Data1)

            rt = CLSIDFromString(StrPtr("{507B7E6A-DA56-4893-A701-95EA372EA15F}"), iid2.Data1)

            pargs(0) = VarPtr(ccf.Data1)

            pargs(1) = VarPtr(ccl.Data1)

            pargs(2) = VarPtr(icf)

            rt = DllFunAdrCall(fun, pargs(0), 3)

            icf.CreateInstance ByVal 0, iid2.Data1, n

            'rt = CallWindowProc(fun, ccf.Data1, ccl.Data1, n, ByVal 0)

        End If

        FreeLibrary dll

    End If

End Function

...全文

3713 17 打赏收藏转发到动态举报

写回复

用AI写文章

17 条回复

切换为时间正序

请发表友善的回复…

发表回复

MeThee 2016-12-26

打赏
举报

多种免注册调用的代码，收藏自网络，版权归原作者所有
下载图片，修改为zip解压

u013735048 2016-01-03

打赏
举报

测试了一下,效果很不错,能不能做个vb.net版本的?

wcymiss 2015-03-17

打赏
举报

CoCreateInstance + DispCallFunc 可行不？

舉杯邀明月 2015-03-10

打赏
举报

引用 13 楼 wy24789 的回复:

Dim objTest As Object 这样声明使用是需要一个类型库的， ......... 我把工程文件以及类型库还有这个mp3info.dll都打包上传了（希望舉杯邀明月不要介意），有生成一个exe文件，mp3请自备，最后欢迎大家测试，如果只是写个小的绿色的工具软件还是可以用的。 http://download.csdn.net/detail/wy24789/8486047

这个不错，在IDE下也能正常运行。

我编译好.exe后，到另一台Win7（32位）的电脑上也运行正常，并且查了一下它的注册表，没有产生mp3info.dll的注册信息。我在12F说的那个，把变量定义改成Dim objTest也不行（也就是objTest为Variant类型变量），还是相同的结果。看样子，用楼主的dllcall.bas接口，就能直接调用任意的ActivX DLL了？

wy24789 2015-03-09

打赏
举报

Dim objTest As Object 这样声明使用是需要一个类型库的，vb生成的dll可以正常使用，我之前试过vc2008生成的com，基于atl的，无法正常调用，需要先引用，变量也要指定类型，生成exe后就不依赖它了，不注册也可以用。这个dll用peid查看是“Microsoft Visual C++ 7.0 DLL Method 3”。最终修改的代码在ide状态是可以调试的，要自己建立一个类型库文件，当然生成exe后，这些东西都不需要了，只要exe文件和dll（有些废话，这些是最基本的）。我把工程文件以及类型库还有这个mp3info.dll都打包上传了（希望舉杯邀明月不要介意），有生成一个exe文件，mp3请自备，最后欢迎大家测试，如果只是写个小的绿色的工具软件还是可以用的。 http://download.csdn.net/detail/wy24789/8486047

舉杯邀明月 2015-03-09

打赏
举报

最近测试了一下楼主的代码，效果不理想啊。
前几天下载一个小软件，它带了一个ActiveX DLL文件，我就用它做了一次试验。

窗体代码如下（另有一个标准模块，代码就是楼主在4F贴的）：

Option Explicit



Private Sub Command1_Click()

   Dim objTest As Object

   Dim lRetVal As Integer

   

   Set objTest = Dll_GetClassObject("E:\Temp\mp3info.dll", _

                        "{AAFA1E73-4842-4BEC-BC46-48C62E1C5C9C}", _

                        "{F31A1156-1CC0-4130-9FCB-B69116480C93}")

   ' function IsMP3File(fileName:BSTR): bool;

   Me.Print objTest.IsMP3File("E:\Temp\123.mp3")

   lRetVal = objTest.IsMP3File("E:\Temp\123.mp3")

   Me.Print lRetVal

   Set objTest = Nothing

End Sub

测试结果为（被测试的DLL文件是：E:\Temp\mp3info.dll　　操作系统： Windows XP/SP3）：
①在IDE环境中无法运行，会引起VB6出错崩溃。编译后可以运行 .exe 文件。
②在mp3info.dll已经在系统中注册的情况下，运行正常（窗体上输出了True和1）。
③如果把mp3info.dll从系统中 UnReg了，就会出现下图中的那个“运行时错误”。点确定后，程序崩溃。

下图就是运行结果截图。
窗体内容是“正常”的结果图片。
那个错误消息，就是 Regsvr32 /u mp3info.dll 之后的“效果”。
mp3info.dll这个文件已经包含在下图中了。
把下图保存到你的电脑中，更名为 *.rar 文件，就可打开解压出来了。

wy24789 2015-03-01

打赏
举报

不会啊，我测试过了的，用完后，注册表也不会产生注册信息。附带说句，最后修改版在调试状态也可以用

，能够多些人测试稳定性就好了

Fairphoenix 2015-02-28

打赏
举报

楼主的代码，真没看懂啊。这个函数：Public Function Dll_GetClassObject(dllname As String, sclsid As String, siid As String) As Object 传入的字符串参数 sclsid、siid ，这从哪得来的？刚才找了个ActiveX DLL文件看了看，文件中根本找不到CLSID的参数啊！根本就没有：{6D926E71-56E7-467D-B64F-E7571EF1B806} {B1F1024A-7CF1-44C8-B34B-B7BE383F4825} 这样的字符串在文件中，那对于“任意一个ActiveX DLL”，怎么得到这个参数？难道还是要注册文件之后，到注册表中去找吗？

threenewbee 2015-02-28

打赏
举报

你这样写，还是要注册的。实际上你可以调用com内的dllselfregister实现注册，表面上隐藏了这个过程而已。

wy24789 2015-02-28

打赏
举报

我用eXeScope.exe看的你如果有兴趣可以看这里 http://blog.csdn.net/wy24789/article/details/43899413 最后整理的

wy24789 2015-02-13

打赏
举报

生成dll时在选项里设置二进制兼容，clsid就不会变了是先得到DllGetClassObject的地址才创建的类工厂啊 dll的资源里有个类型库，可以根据类名查找，不用clsid，LoadTypeLib或者加载资源主要是vb做这些挺麻烦的，加入汇编后，稳定性也不好说，也就玩玩吧调用函数地址的汇编我又改了个，不用每次调用函数地址都生成汇编指令，效率也会高些，不过这种损失对vb真算不了什么

yst803 2015-02-13

打赏
举报

以上方法的缺点：一旦Dll文件更新升级，调用的主程序也必须修改，很不方便。使用GetProcAddress，再获得类工厂指针，最后创建对象CreateInstance才是最好的方法。

PctGL 2015-02-11

打赏
举报

晚了... vb都完蛋了

wy24789 2015-02-11

打赏
举报


Option Explicit

Private Type CLSID
    d1 As Long
    d2 As Integer
    d3 As Integer
    d4 As Integer
    d5(5) As Byte
End Type

Private Declare Function LoadLibraryW Lib "kernel32.dll" (ByVal lpFileName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, Optional ByVal Length As Long = 4) As Long
Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, pclsid As Long) As Long

Dim fMdfFunCode As Boolean

Function CallFunAddr1(ByVal addr As Long) As Long
    MsgBox "CallFunAddr1 未修改"
End Function

'00401312    FF6424 04       JMP DWORD PTR SS:[ESP+4]
'00401316    90              NOP

Sub MdfCallFunAddr1code()
    Dim n As Long
    Dim r As Long
    r = VirtualProtect(AddressOf CallFunAddr1, 4, &H40, n)
    r = &H42464FF
    CopyMemory AddressOf CallFunAddr1, VarPtr(r), 4
    fMdfFunCode = True
End Sub

Public Function CallFunAddrArgs(ByVal addr As Long, ParamArray args() As Variant) As Long
    Dim code(30) As Long
    Dim i As Long
    Dim j As Long
    
On Error Resume Next
    i = 0
    j = -1
    For j = UBound(args) To 0 Step -1
        code(i) = &H68909090
        code(i + 1) = args(j)
        i = i + 2
    Next
    code(i) = &HB8909090
    code(i + 1) = addr
    code(i + 2) = &HC290D0FF
    code(i + 3) = 4

    If fMdfFunCode = False Then MdfCallFunAddr1code
    CallFunAddrArgs = CallFunAddr1(VarPtr(code(0)))
End Function

'77174AF3             68 78563412                  push 12345678
'77174AF8 OLEAUT32.>  B8 12345678                  mov eax,78563412
'77174AFD             FFD0                         call eax
'77174AFF             FFE0                         jmp eax
'77174B01             C2 1000                      retn 10
'77174B04             90                           nop

Public Sub MdfFunAddr(ByVal vbfun As Long, ByVal newAddr As Long)
    Dim r As Long
    Dim n As Long
    Dim code(2) As Long
    code(0) = &HB8909090
    code(1) = newAddr
    code(2) = &H9090E0FF
    r = VirtualProtect(ByVal vbfun, 12, &H40, n)
    CopyMemory ByVal vbfun, VarPtr(code(0)), 12
End Sub

'member索引从0开始，IUnknown3个成员函数，IDispatch4个成员函数，IClassFactory.CreateInstance在3号位置
Public Function GetClassMemberAddr(ByVal cthis As Long, ByVal member As Long) As Long
    Dim vtab As Long
    Dim fun As Long
    CopyMemory VarPtr(vtab), ByVal cthis, 4
    CopyMemory VarPtr(fun), ByVal vtab + member * 4, 4
    GetClassMemberAddr = fun
End Function

Public Function Dll_GetClassObject(dllname As String, sclsid As String, siid As String) As Object
Dim dll As Long
Dim hr As Long
Dim clsid_icf As CLSID
Dim clsid_cls As CLSID
Dim clsid_iid As CLSID
Dim icf As Long 'IClassFactory
Dim funDllGetClassObject As Long
Dim funCreateInstance As Long
Dim funRelease As Long
Dim obj As Object
    dll = LoadLibraryW(StrPtr(dllname))
    If dll > 0 Then
        funDllGetClassObject = GetProcAddress(dll, "DllGetClassObject")
        If funDllGetClassObject > 0 Then
            hr = CLSIDFromString(StrPtr("{00000001-0000-0000-C000-000000000046}"), clsid_icf.d1)
            hr = CLSIDFromString(StrPtr(sclsid), clsid_cls.d1)
            hr = CLSIDFromString(StrPtr(siid), clsid_iid.d1)
            hr = CallFunAddrArgs(funDllGetClassObject, VarPtr(clsid_cls.d1), VarPtr(clsid_icf.d1), VarPtr(icf))
            funCreateInstance = GetClassMemberAddr(icf, 3)
            hr = CallFunAddrArgs(funCreateInstance, icf, 0, VarPtr(clsid_iid.d1), VarPtr(obj))
            funRelease = GetClassMemberAddr(icf, 2)
            hr = CallFunAddrArgs(funRelease, icf)
            MsgBox TypeName(obj)
            Set Dll_GetClassObject = obj
        End If
        'FreeLibrary dll
    Else
        MsgBox "dll加载失败"
    End If
End Function

Private Sub Form_Load() Dim c 'As aatest2.Class1 Set c = Dll_GetClassObject("aatest2.dll", "{6D926E71-56E7-467D-B64F-E7571EF1B806}", "{B1F1024A-7CF1-44C8-B34B-B7BE383F4825}") c.testadd 1, 2, "a" End Sub 需要生成exe才有效，win7 64位测试通过

wy24789 2015-02-10

打赏
举报

vb内联汇编测试通过了，不使用CallWindowProc调用汇编码，直接修改vb模块内的函数的汇编码

Public Function MyMessageBox(ByVal nhwnd As Long, ByVal m As String, ByVal c As String, ByVal i As Long) As Long
    Dim t As Long
    t = 1
    t = t + 2
    t = t + 5
    MyMessageBox = t
End Function

Public Function GetFunAddr(ByVal vbfun As Long) As Long
    GetFunAddr = vbfun
End Function

'77174AF3             68 78563412                  push 12345678
'77174AF8 OLEAUT32.>  B8 12345678                  mov eax,78563412
'77174AFD             FFD0                         call eax
'77174AFF             FFE0                         jmp eax
'77174B01             C2 1000                      retn 10
'77174B04             90                           nop

Public Sub MdfFunAddr(ByVal vbfun As Long, ByVal newAddr As Long)
    Dim r As Long
    Dim n As Long
    Dim code(2) As Long
    code(0) = &HB8909090
    code(1) = newAddr
    code(2) = &H9090E0FF
    r = VirtualProtect(ByVal vbfun, 12, &H40, n)
    CopyMemory ByVal vbfun, code(0), 12
End Sub

Sub Test_CallFunAddr()
    Dim a As Long
    a = LoadLibrary(StrPtr("user32.dll"))
    a = GetProcAddress(a, "MessageBoxW")
    MdfFunAddr AddressOf MyMessageBox, a
    a = MyMessageBox(0, "消息内容", "标题", vbOKCancel)
    MsgBox a
End Sub

wy24789 2015-02-10