VFP中OCX控件注册检测及自动注册

这是原来从网上搜集、整理后编制用于自己的小程序使用的OCX是否注册及未注册控件的自动注册函数。

CheckCtrlFileRegist("ctToolBar.ctToolBarCtrl.4")  && 检测与注册DBI工具条控件(ctToolBar)

****************************** 控件注册函数
Function CheckCtrlFileRegist
Parameters 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
  EndDo
Finally
  Release oErr, oErrExit, lcCtrlFile, lcCtrl, lcRun, oCtrl, oShell, lcMess
EndTry
EndFunc

*************************

下面是网上摘抄的红雨先生的一个关于控件注册的函数，一并列示如下（本人未对该函数作过测试，对该函数的控件版本检测功能亦未判断，有兴趣者测试后可在此回复给我，谢谢）：

* 程序: 动态注册(dll、ocx)控件
* 设计: 红雨
*-------------------------------------------------
Clear
cLibFileName = getfile([注册控件(*.ocx,*.dll):ocx,dll],[控件文件])
If  !Empt(lcLibFileName)      
? DllRegister(lcLibFileName,.T.)  && 注册
*? DllRegister(lcLibFileName,.F.)  && 注销
Endif
Clea Dlls
Return

Function DllRegister (lpLibFileName,isReg)
isReg = iif(type("isReg")="U", .T., isReg)
lpProcName = iif(isReg, "DllRegisterServer", "DllUnregisterServer" )
Declare Integer GetLastError in kernel32
Declare Integer LoadLibrary in kernel32 String lpLibFileName
Declare Integer FreeLibrary in kernel32 Integer hLibModule
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)
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()
Endif
Return "错误: (" + 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  Arguments
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)
If lnLength <> 0
   lpResult = REPLI (Chr(0), 500)
   = CopyMemory (@lpResult, lpBuffer, lnLength)
   Return STRTRAN(LEFT(lpResult, lnLength), Chr(13)+Chr(10), "")
Else   
   Return "#<未知错误>#"
Endif
Endfunc