COM加载宏封装自定义函数并全自动安装最简实例

baomaboy

原帖由 tonychris 于 2011-5-19 21:25 发表
封装个函数谁都会，主要是如何能在excel中作为公式使用，
你这代码说明不了问题，难道自己每次做个插件还必须要执行你的那个install

1、在excle中作为公式用的函数插件手工引用(自动化)这个谁都会，根本不用执行我这个install，难道你不会？？？
2、“我这代码说明不了问题”，因为我根本不是给你说明问题的，我是只给你4楼一个回复，你问的就是封装。
“封装”这个有人可能不会，但“使用”可是人人都会啊，谁知道你不但不会封装就连使用也不会啊！

原帖由 tonychris 于 2011-5-18 22:38 发表
说说如何吧函数封装到com组件的方法啊

[ 本帖最后由 baomaboy 于 2011-5-19 23:41 编辑 ]

AVEL

呵呵 宝马男孩 你就满足大家好奇心好了。介绍一下封装。

zhj1978

请问自定义函数封装实例中，执行文件install，怎么做的，请提供代码

baomaboy

原帖由 fecmen 于 2011-5-19 14:19 发表
试了下，制作成.bat文件也可以加载和卸载
加载：regsvr32 GCSY.DLL
卸载：regsvr32 GCSY.DLL -u

之所以只用regsvr32就可以，是因为已经用install安装过一次，即使/u卸载了，注册表中也会有加载项残留，所以才会成功，如果是全新安装(从没安装过)只是用regsvr32就不行了，还需要手工去从加载宏列表中的自动化服务中去找封装的dll中的类名添加到加载宏列表并勾选才行。
其实VBA中已经提供了AddIns.Add的方法免去手工加载的繁琐，顶楼更新了附件，VBS源码，可以任意改VBA和VB。

用VBS安装是因为：
1、简单，根本不用装VB等第三方软件，使用系统内的记事本就能完成。
2、界面，能提供个简单的安装交互界面，用VBA的话我不想看到excel的界面。

当然 用VB可能显的专业一点。

鉴于后来自己都已经承认DLL是可以加载自身到加载宏列表的，所以应该说fecmen的“试了下，制作成.bat文件也可以加载和卸载”在这个基础上是成立的，只不过本贴中的DLL都是常规做的，并没做成自加载的形式，所以只是regsvr一下还是不行的。

[ 本帖最后由 baomaboy 于 2011-5-21 22:04 编辑 ]

baomaboy

最后在说说用winrar做成自解压文件这样会让你的安装更加自动一些。
关于rar的自解压可能大家都会了，这里主要是想说个小技巧，也许是大家没注意到的，
其实我们每次做自解压文件时完全没必要每次都在那些选项里转来转去的，只要在第一次时做个“注释文件”以后3步就可以做成我们想要的自解压安装文件
1、选择我们将要压缩在包里的文件，右键添加到rar压缩文件
2、在“常规”选项勾“选创建自解压格式文件”
3、转到“注释”选项，浏览找到我们提前弄好的注释文件，确定即可。
注释文件可以从第一次做好的自解压文件获取也可以直接用记事本编辑，内容如下：

1. ;下面的注释包含自解压脚本命令
   
2. 
   
3. TempMode
   
4. ;TempMode="工程试验函数集1.0 — Excel_VBA自定义函数","安装 — 工程试验函数集1.0 — by baomaboy"
   
5. ;上面两句是安装前是否弹窗确认安装的语句，由于我们在VBS里控制安装过程所以此处注释掉，你可以根据需要选择是否弹窗。
   
6. Silent=1
   
7. Overwrite=1
   
8. Setup=Setup.vbs

复制代码

zhj1978

执行文件install，怎么做的，请提供代码

baomaboy

install的源码暂时不公开，本贴也暂时更新至此。

fecmen

'**************************************
'ActiveX   Dll   注册/反注册API全局声明
'**************************************


Private   Declare   Function   LoadLibraryRegister   Lib   "KERNEL32 "   Alias   "LoadLibraryA "   (ByVal   lpLibFileName   As   String)   As   Long


Private   Declare   Function   FreeLibraryRegister   Lib   "KERNEL32 "   Alias   "FreeLibrary "   (ByVal   hLibModule   As   Long)   As   Long


Private   Declare   Function   CloseHandle   Lib   "KERNEL32 "   (ByVal   hObject   As   Long)   As   Long


Private   Declare   Function   GetProcAddressRegister   Lib   "KERNEL32 "   Alias   "GetProcAddress "   (ByVal   hModule   As   Long,   ByVal   lpProcName   As   String)   As   Long


Private   Declare   Function   CreateThreadForRegister   Lib   "KERNEL32 "   Alias   "CreateThread "   (lpThreadAttributes   As   Long,   ByVal   dwStackSize   As   Long,   ByVal   lpStartAddress   As   Long,   ByVal   lpparameter   As   Long,   ByVal   dwCreationFlags   As   Long,   lpThreadID   As   Long)   As   Long


Private   Declare   Function   WaitForSingleObject   Lib   "KERNEL32 "   (ByVal   hHandle   As   Long,   ByVal   dwMilliseconds   As   Long)   As   Long


Private   Declare   Function   GetExitCodeThread   Lib   "KERNEL32 "   (ByVal   hThread   As   Long,   lpExitCode   As   Long)   As   Long


Private   Declare   Sub   ExitThread   Lib   "KERNEL32 "   (ByVal   dwExitCode   As   Long)

'**************************************
'模块名:   ActiveX   Dll   注册/反注册
'描述:该代码演示怎样在程序中注册和反注册，在regsvr32上自己进行
'输入Inputs:文件名
'返回:7   个标志，具体看代码
'**************************************

Option   Explicit


Private   Declare   Function   LoadLibraryRegister   Lib   "KERNEL32 "   Alias   "LoadLibraryA "   (ByVal   lpLibFileName   As   String)   As   Long


Private   Declare   Function   FreeLibraryRegister   Lib   "KERNEL32 "   Alias   "FreeLibrary "   (ByVal   hLibModule   As   Long)   As   Long


Private   Declare   Function   CloseHandle   Lib   "KERNEL32 "   (ByVal   hObject   As   Long)   As   Long


Private   Declare   Function   GetProcAddressRegister   Lib   "KERNEL32 "   Alias   "GetProcAddress "   (ByVal   hModule   As   Long,   ByVal   lpProcName   As   String)   As   Long


Private   Declare   Function   CreateThreadForRegister   Lib   "KERNEL32 "   Alias   "CreateThread "   (lpThreadAttributes   As   Long,   ByVal   dwStackSize   As   Long,   ByVal   lpStartAddress   As   Long,   ByVal   lpparameter   As   Long,   ByVal   dwCreationFlags   As   Long,   lpThreadID   As   Long)   As   Long


Private   Declare   Function   WaitForSingleObject   Lib   "KERNEL32 "   (ByVal   hHandle   As   Long,   ByVal   dwMilliseconds   As   Long)   As   Long


Private   Declare   Function   GetExitCodeThread   Lib   "KERNEL32 "   (ByVal   hThread   As   Long,   lpExitCode   As   Long)   As   Long


Private   Declare   Sub   ExitThread   Lib   "KERNEL32 "   (ByVal   dwExitCode   As   Long)
        Private   Const   STATUS_WAIT_0   =   &H0
        Private   Const   WAIT_OBJECT_0   =   ((STATUS_WAIT_0)   +   0)
        Private   Const   NOERRORS   As   Long   =   0


Private   Enum   stRegisterStatus
        stFileCouldNotBeLoadedIntoMemorySpace   =   1
        stNotAValidActiveXComponent   =   2
        stActiveXComponentRegistrationFailed   =   3
        stActiveXComponentRegistrationSuccessful   =   4
        stActiveXComponentUnRegisterSuccessful   =   5
        stActiveXComponentUnRegistrationFailed   =   6
        stNoFileProvided   =   7
End   Enum


Public   Function   Register(ByVal   p_sFileName   As   String)   As   Variant
        Dim   lLib   As   Long
        Dim   lProcAddress   As   Long
        Dim   lThreadID   As   Long
        Dim   lSuccess   As   Long
        Dim   lExitCode   As   Long
        Dim   lThreadHandle   As   Long
        Dim   lRet   As   Long
        On   Error   GoTo   ErrorHandler


        If   lRet   =   NOERRORS   Then


                If   p_sFileName   =   " "   Then
                        lRet   =   stNoFileProvided
                End   If
        End   If


        If   lRet   =   NOERRORS   Then
                lLib   =   LoadLibraryRegister(p_sFileName)


                If   lLib   =   0   Then
                        lRet   =   stFileCouldNotBeLoadedIntoMemorySpace
                End   If
        End   If


        If   lRet   =   NOERRORS   Then
                lProcAddress   =   GetProcAddressRegister(lLib,   "DllRegisterServer ")


                If   lProcAddress   =   0   Then
                        lRet   =   stNotAValidActiveXComponent
                Else
                        lThreadHandle   =   CreateThreadForRegister(0,   0,   lProcAddress,   0,   0,   lThreadID)


                        If   lThreadHandle   <>   0   Then
                                lSuccess   =   (WaitForSingleObject(lThreadHandle,   10000)   =   WAIT_OBJECT_0)


                                If   lSuccess   =   0   Then
                                        Call   GetExitCodeThread(lThreadHandle,   lExitCode)
                                        Call   ExitThread(lExitCode)
                                        lRet   =   stActiveXComponentRegistrationFailed
                                Else
                                        lRet   =   stActiveXComponentRegistrationSuccessful
                                End   If
                        End   If
                End   If
        End   If
        ExitRoutine:
        Register   =   lRet


        If   lThreadHandle   <>   0   Then
                Call   CloseHandle(lThreadHandle)
        End   If


        If   lLib   <>   0   Then
                Call   FreeLibraryRegister(lLib)
        End   If
        Exit   Function
        ErrorHandler:
        lRet   =   Err.Number
        GoTo   ExitRoutine
End   Function


Public   Function   UnRegister(ByVal   p_sFileName   As   String)   As   Variant
        Dim   lLib   As   Long
        Dim   lProcAddress   As   Long
        Dim   lThreadID   As   Long
        Dim   lSuccess   As   Long
        Dim   lExitCode   As   Long
        Dim   lThreadHandle   As   Long
        Dim   lRet   As   Long
        On   Error   GoTo   ErrorHandler


        If   lRet   =   NOERRORS   Then


                If   p_sFileName   =   " "   Then
                        lRet   =   stNoFileProvided
                End   If
        End   If


        If   lRet   =   NOERRORS   Then
                lLib   =   LoadLibraryRegister(p_sFileName)


                If   lLib   =   0   Then
                        lRet   =   stFileCouldNotBeLoadedIntoMemorySpace
                End   If
        End   If


        If   lRet   =   NOERRORS   Then
                lProcAddress   =   GetProcAddressRegister(lLib,   "DllUnregisterServer ")


                If   lProcAddress   =   0   Then
                        lRet   =   stNotAValidActiveXComponent
                Else
                        lThreadHandle   =   CreateThreadForRegister(0,   0,   lProcAddress,   0,   0,   lThreadID)


                        If   lThreadHandle   <>   0   Then
                                lSuccess   =   (WaitForSingleObject(lThreadHandle,   10000)   =   WAIT_OBJECT_0)


                                If   lSuccess   =   0   Then
                                        Call   GetExitCodeThread(lThreadHandle,   lExitCode)
                                        Call   ExitThread(lExitCode)
                                        lRet   =   stActiveXComponentUnRegistrationFailed
                                Else
                                        lRet   =   stActiveXComponentUnRegisterSuccessful
                                End   If
                        End   If
                End   If
        End   If
        ExitRoutine:
        UnRegister   =   lRet


        If   lThreadHandle   <>   0   Then
                Call   CloseHandle(lThreadHandle)
        End   If


        If   lLib   <>   0   Then
                Call   FreeLibraryRegister(lLib)
        End   If
        Exit   Function
        ErrorHandler:
        lRet   =   Err.Number
        GoTo   ExitRoutine
End   Function

zhj1978

请做个详细注释，谢谢

zhj1978

怎么在VB里做的