| « | June 2023 | » | | 日 | 一 | 二 | 三 | 四 | 五 | 六 | | | | | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | | |
|
公告 |
| 暂无公告... |
| Blog信息 |
|
blog名称:VFP及Sql Server拙笔
日志总数:46
评论数量:107
留言数量:0
访问次数:427177
建立时间:2005年5月12日 |
| |
|
 [VFP与SQL]VFP中OCX控件注册检测及自动注册
原创空间, 文章收藏, 网上资源, 日后处理, 电脑与网络
老瓷 发表于 2011/12/7 22:22:15 |
| 这是原来从网上搜集、整理后编制用于自己的小程序使用的OCX是否注册及未注册控件的自动注册函数。
CheckCtrlFileRegist("ctToolBar.ctToolBarCtrl.4") && 检测与注册DBI工具条控件(ctToolBar)
****************************** 控件注册函数Function CheckCtrlFileRegistParameters lcCheck
&& 调用形如：CheckCtrlFileRegist("ctGrid.ctGridCtrl.3")&& 其中，经常用到的控件如下：&& MS日期控件 MSComCt2.OCX 版本2-("MSComCtl2.DTPicker.2")(MS Date and Time Picker Control 6.0 (SP4))&& 视频头控件 AVCap.OCX 版本1-("AVCap.AVCapture.1")&& DBI表格控件 ctGrid.OCX 版本3-("ctGrid.ctGridCtrl.3")，版本1-("ctGrid.ctGridCtrl.1") && DBI下拉框控件 ctCombo.OCX 版本2-("ctCoLorCombo.ctColorComboCtrl.2") && DBI工具条控件 ctToolBar.OCX 版本4-("ctToolBar.ctToolBarCtrl.4") && DBI树形控件 ctTree.OCX 版本7-("ctTree.ctTreeView.7")
Local oErr As Exception, oErrExit As Exception Local lcCtrlFile As Character, lcCtrl As Character, lcRun As Character Local oCtrl As Object, oShell As Object Local lcMess As Character
lcMess='' lcCtrl=SubStr(lcCheck,1,At('.',lcCheck,1)-1)
Try oCtrl=CreateObject(lcCheck)Catch To oErr oErr.UserValue="发现OCX控件["+lcCtrl+"]未注册！" =MessageBox(oErr.UserValue,0+64,'提示！') Do While .T. lcCtrlFile=GetFile('OCX','输入文件名：','确定',0,'选择需要操作的文件') If Not File(lcCtrlFile,1) OR Empty(lcCtrlFile) Then lcMess='程序所必要的控件文件'+Iif(Empty(lcCtrlFile),'','['+lcCtrlFile+']')+'不存在！继续注册么？' If 6=MessageBox(lcMess,4+32+256,'系统提示！') Then Loop Else Quit Endif Endif oShell=CreateObject('Wscript.shell') lcRun="Regsvr32 /S "+lcCtrlFile If oShell.Run('&lcRun',0,.T.) != 0 Then && 隐藏窗口运行并返回错误代码(不为0,运行出错,注册失败) lcMess='选定的控件文件'+lcCtrlFile+'不包含控件'+lcCtrl+', 注册失败！继续注册么？' If 6=Messagebox(lcMess, 4+32+256, '信息提示') Then Loop Else Quit Endif Endif Try oCtrl=CreateObject(lcCheck) Catch To oErrExit oErrExit.UserValue = "OCX控件["+lcCtrl+"]未注册成功 或 与要求版本不符合！" =MessageBox(oErrExit.UserValue,0+64,'提示！') Quit Finally EndTry lcMess='控件['+lcCtrl+']注册成功！' =MessageBox(lcMess, 0+64, '系统提示！',5000) Exit EndDoFinally Release oErr, oErrExit, lcCtrlFile, lcCtrl, lcRun, oCtrl, oShell, lcMessEndTryEndFunc
*************************
下面是网上摘抄的红雨先生的一个关于控件注册的函数，一并列示如下（本人未对该函数作过测试，对该函数的控件版本检测功能亦未判断，有兴趣者测试后可在此回复给我，谢谢）：
程序: 动态注册(dll、ocx)控件* 设计: 红雨*-------------------------------------------------ClearcLibFileName = getfile([注册控件(*.ocx,*.dll):ocx,dll],[控件文件])If !Empt(lcLibFileName) ? DllRegister(lcLibFileName,.T.) && 注册*? DllRegister(lcLibFileName,.F.) && 注销EndifClea DllsReturn
Function DllRegister (lpLibFileName,isReg)isReg = iif(type("isReg")="U", .T., isReg)lpProcName = iif(isReg, "DllRegisterServer", "DllUnregisterServer" )Declare Integer GetLastError in kernel32Declare Integer LoadLibrary in kernel32 String lpLibFileNameDeclare Integer FreeLibrary in kernel32 Integer hLibModuleDeclare Integer GetProcAddress in kernel32 Integer hModule, String lpProcNameDeclare Integer CallWindowProc in user32 Integer lpPrevWndFunc, Integer hwnd, Integer Msg, Integer wParam, Integer lParamhLibModule = LoadLibrary (lpLibFileName)If hLibModule # 0 lnAddress = GetProcAddress (hLibModule, lpProcName) If lnAddress # 0 If CallWindowProc( lnAddress, 0,0,0,0) = 0 = FreeLibrary (hLibModule) Return "成功: " + lpProcName + " 地址: " + allt(str(lnAddress,12)) Else lnerror = GetLastError() Endif Else lnerror = GetLastError() Endif = FreeLibrary (hLibModule)Else lnerror = GetLastError()EndifReturn "错误: (" + allt(str(lnerror)) + []) + GetErrorStr(lnerror)End func**************************
Function GetErrorStr (lpnError)Declare INTEGER FormatMessage IN kernel32 INTEGER dwFlags, INTEGER lpSource, INTEGER dwMessageId,; INTEGER dwLanguageId, INTEGER @lpBuffer, INTEGER nSize, INTEGER ArgumentsDeclare RtlMoveMemory IN kernel32 As CopyMemory STRING @Destination, INTEGER Source, INTEGER nLengthdwFlags = 256 + 4096 + 512lpBuffer = 0lnLength = FormatMessage(dwFlags, 0, lpnError, 0, @lpBuffer, 0, 0)If lnLength <> 0 lpResult = REPLI (Chr(0), 500) = CopyMemory (@lpResult, lpBuffer, lnLength) Return STRTRAN(LEFT(lpResult, lnLength), Chr(13)+Chr(10), "")Else Return "#<未知错误>#"EndifEndfunc |
|
|