这是从最初自己注册、用于以后编制的注册小程序使用的OCX是否及未注册的自动函数。
CheckCtrlFileRegist("ctToolBar.ctToolBarCtrl.4") && 检测与注册DBI工具条控件(ctToolBar)
****************************** 控件注册函数
功能 CheckCtrlFileRegist
参数 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下拉框控件ctCombo2-("ctCoLorCombo.ctColorComboCtrl.2")
&& DBI工具条控件ctToolBar.OCX版本4-("ctToolBar.ctToolBarCtrl.4")
&& DBI树形控件ctTree.OCX版本7-("ctTree.ctTreeView.7")
本地 oErr 作为例外，oErrExit 作为例外
本地 lcCtrlFile 作为改变，lcCtrlFile 作为改变，lcRun 作为改变
本地 oCtrl 作为对象，oShell 作为对象
本地 lcMess 作为字符
lcMess=''
lcCtrlFile=SUBSTR(lcCheck,1,AT('.',lcCheck,1)-1)
试一试
oCtrl=CREATEOBJECT(lcCheck)
抓到错误
oErrVALUE="发现OCX控件！"+lcCtrlFile+"]未注册"
=MESSAGEBOX(oErr.USERVALUE,0+64,'提示！')
做的时候.T。
lcCtrlFile=GETFILE('OCX','输入文件名：','确定',0,'选择需要操作的文件')
如果不是文件（lcCtrlFile，1）或空（lcCtrlFile）那么
lcCtrl='程序必须注册的控件文件？'+IIF(EMPTY(lcCtrlFile),'','['+lcCtrlFile+']')+'不存在'
IF 6=MESSAGEBOX(lcMess,4+32+256,'系统提示！') THEN
环带
别
退出
万一
万一
oShell=CREATEOBJECT('Wscript.shell')
lcRun="Regsvr32 /S"+lcCtrlFile
IF oShell.RUN('&lcRun',0,.T.) != 0 THEN && 隐藏运行并返回错误代码(不为0,运行异常窗口注册失败)
lcMess='选择的控件文件'+lcCtrlFile+'不包含控件'+lcCtrlFile+', 注册失败继续注册么？
IF 6=MESSAGEBOX(lcMess, 4+32+256, '信息提示') THEN
环带
别
退出
万一
万一
试一试
oCtrl=CREATEOBJECT(lcCheck)
赶上 oErrExit
oErrExit.USERVALUE = "OCX控件["+lcCtrlFile+"]未注册成功或与版本不符合！"
=MESSAGEBOX(oErrExit.USERVALUE,0+64,'提示！')
退出
最后
ENDTRY
lcMess='控件['+lcCtrlFile+']注册成功！'
=MESSAGEBOX(lcMess, 0+64, '系统提示！',5000)
出口处
ENDDO
最后
释放 oErr、oErrExit、lcCtrlFile、lcCtrlFile、lcRun、oCtrl、oShell、lcMess
ENDTRY
函数结束是摘录下录的红雨老师的一个个人的委托，并示（个人无权职）回复测试，抄录执行网上行使职能后的版本检测功能未有关利益，有相关测试者可在此确认给我，谢谢）：
* 程序：动态注册(dll、ocx)控件
* 设计：红雨
*---------------------------------------------------- ---
清除
cLibFileName = GETFILE([控件注册(*.ocx,*.dll):ocx,dll],[控件文件])IF !EM(lcLibFileName)
? DllRegister(lcLibFileName,.T.) && 注册
*? DllRegister(lcLibFileName,.F.) && 注销ENDIFCLEA DLLSRETURNFUNCTION DllRegister (lpLibFileName,isReg)
isReg = IIF(TYPE("isReg")="U", .T., isReg)
lpProcName = IIF(isReg, "DllRegisterServer", "DllUnregisterServer" )
在 kernel32 中声明整数 GetLastError
DECLARE INTEGER LoadLibrary IN kernel32 STRING lpLibFileName
在 kernel32 INTEGER hLibModule 中声明整数 FreeLibrary
DECLARE INTEGER GetProcAddress IN kernel32 INTEGER hModule, STRING lpProcName
DECLARE INTEGER CallWindowProc IN user32 INTEGER lpPrevWndFunc, INTEGER HWND, INTEGER Msg, INTEGER wParam, INTEGER LPARAM
hLibModule = LoadLibrary (lpLibFileName)
如果 hLibModule # 0 lnAddress = GetProcAddress (hLibModule, lpProcName)
IF lnAddress # 0 IF CallWindowProc( lnAddress, 0,0,0,0) = 0
= 免费图书馆 (hLibModule)
RETURN "成功：" + lpProcName + "地址：" + ALLT(STR(lnAddress,12))
别的
lnerror = GetLastError()
万一
别的
lnerror = GetLastError()
万一
= 免费图书馆 (hLibModule)
别的
lnerror = GetLastError()
万一
RETURN "错误: (" + ALLT(STR(lnerror)) + []) + GetErrorStr(lnerror)
结束功能
******************************
函数 GetErrorStr (lpnError)
DECLARE INTEGER FormatMessage IN kernel32 INTEGER dwFlags, INTEGER lpSource, INTEGER dwMessageId,;
INTEGER dwLanguageId, INTEGER @lpBuffer, INTEGER nSize, INTEGER 参数
DECLARE RtlMoveMemory IN kernel32 AS CopyMemory STRING @Destination, INTEGER SOURCE, INTEGER nLength
dwFlags = 256 + 4096 + 512
lpBuffer = 0
lnLength = FormatMessage(dwFlags, 0, lpnError, 0, @lpBuffer, 0, 0)
如果长度 <> 0
lpResult = REPLI (CHR(0), 500)
= CopyMemory (@lpResult, lpBuffer, lnLength)
返回STRTRAN（左（lpResult，lnLength），CHR（13）+CHR（10），“”）
别的
返回 "#<未知错误>#"
万一
结束函数
联系客服
