本站首页    管理页面    写新日志    退出


«September 2018»
1
2345678
9101112131415
16171819202122
23242526272829
30


公告
暂无公告...

我的分类(专题)

日志更新

最新评论

留言板

链接


Blog信息
blog名称:VFP及Sql Server拙笔
日志总数:46
评论数量:107
留言数量:0
访问次数:367495
建立时间: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


阅读全文(4861) | 回复(0) | 编辑 | 精华
 



发表评论:
昵称:
密码:
主页:
标题:
验证码:  (不区分大小写,请仔细填写,输错需重写评论内容!)



站点首页 | 联系我们 | 博客注册 | 博客登陆

Sponsored By W3CHINA
W3CHINA Blog 0.8 Processed in 0.031 second(s), page refreshed 144135295 times.
《全国人大常委会关于维护互联网安全的决定》  《计算机信息网络国际联网安全保护管理办法》
苏ICP备05006046号