分享:检查OCX控件是否注册,没注册的可以自动注册。
整理回复后,目前有3种方法检查是否注册。cFilePath=LEFT(SYS(16),RAT("\",SYS(16)))
SET DEFA TO (cFilePath)
CLEAR
ole_name="
ole_name2="VisualFoxpro.Application"
ocx_name="G:\ComboTree\ComboTree.ocx"
ocx_name2="G:\ComboTree\ComboTree2.ocx"
? DllRegister(ocx_name, .T.) &&注册,返回0表示成功,-1表示文件不存在
? DllRegister(ocx_name, .F.) &&注销,返回0表示成功,-1表示文件不存在
? DllRegister(ocx_name2, .T.) &&注销,返回0表示成功,-1表示文件不存在
? ole_name,IsOleReg1(ole_name)
? ole_name,IsOleReg2(ole_name)
? ole_name,IsOleReg3(ole_name)
? ole_name2,IsOleReg2(ole_name2)
** 用DllRegisterServer() 或者 DllUnregisterServer() 注册 ActiveX控件 **
***********************************************************************
** lpLibFileName 需要注册的ActiveX控件名称,包含路径 **
** isReg 注册或者注销,.T.为注册,.F.为注销 **
** =DllRegister( ocx_name, .T.) &&注册,返回0表示成功,-1表示文件不存在
** =DllRegister( ocx_name, .F.) &&注销,返回0表示成功,-1表示文件不存在
** 来源:出处网上查找
***********************************************************************
Function DllRegister(lpLibFileName,isReg)
IF FILE(lpLibFileName)
isReg = iif(type("isReg")="U", .T., isReg)
lpProcName = iif(isReg, "DllRegisterServer", "DllUnregisterServer" )
Declare INTEGER (lpProcName) in (lpLibFileName)
return &lpProcName.()
ELSE
return -1
ENDIF
ENDFUNC
** 用创建对象时通过捕捉异常来判断控件是否已注册 **
** 来源:吹水老斑竹
FUNCTION IsOleReg3(OleClsName)
LOCAL oApp,oErr
TRY
oApp = CREATEOBJECT(OleClsName)
CATCH TO oErr
ENDTRY
RETURN IIF(TYPE("oErr.ErrorNo")="U",.T.,.F.) &&变量不存在,没错误返回 .T.
ENDFUNC
** 用获取类标识符来检测控件是否已注册 **
** 来源:吹水老斑竹
FUNCTION IsOleReg2(OleClsName)
LOCAL sCLSID
DECLARE LONG CLSIDFromProgID IN Ole32 STRING@, STRING@
sCLSID = REPLICATE(0h00, 16)
RETURN (CLSIDFromProgID(STRCONV(OleClsName + 0h00, 5), @sCLSID) == 0)
ENDFUNC
*本程序也可以检查DLL有没有被注册,以收发邮件的jmail.dll为例
*if IsOleReg('jmail.SMTPMail') &&参数也可以用jmail.POP3
* =MessageBox("jmail.dll 已经注册",64,"信息提示")
*else
* =MessageBox("jmail.dll 没有注册",48,"信息提示")
*endif
** 用检查注册表方法来检测控件是否已注册 **
FUNCTION IsOleReg1(OleClsName)
DECLARE INTEGER RegOpenKeyEx IN advapi32 INTEGER nKey,STRING @cSubKey,INTEGER nReserved,INTEGER nAccessMask,INTEGER @nResult
DECLARE LONG RegCloseKey IN advapi32 INTEGER nHKey
#DEFINE HKEY_CLASSES_ROOT -2147483648
LOCAL lnHKEY,lnRes,lcName1,lcGUID,guiddesc,OcxFile
*在 HKEY_CLASSES_ROOT\MSComctlLib.TreeCtrl.2中查找控件的名称
lnHKEY=0
lnRes=RegOpenKeyEx(HKEY_CLASSES_ROOT,OleClsName,0,131097,@lnHKey)
IF lnRes<>0
RETURN .F.
ENDIF
lcName1=GetRegVal(lnHKey,'')
RegCloseKey(lnHKey)
IF ISNULL(lcName1)
RETURN .F.
ENDIF
*在HKEY_CLASSES_ROOT\MSComctlLib.TreeCtrl.2\CLSID中查找控件的类标识符 GUID
lnRes=RegOpenKeyEx(HKEY_CLASSES_ROOT,OleClsName+'\CLSID',0,131097,@lnHKey)
IF lnRes<>0
RETURN .F.
ENDIF
lcGUID=GetRegVal(lnHKey,'')
RegCloseKey(lnHKey)
IF ISNULL(lcGUID)
RETURN .F.
ENDIF
*在 HKEY_CLASSES_ROOT\CLSID\… 中查找控件的类标识符 GUID 的备注
lnRes=RegOpenKeyEx(HKEY_CLASSES_ROOT,'CLSID\'+lcGUID,0,131097,@lnHKey)
IF lnRes<>0
RETURN .F.
ENDIF
guiddesc=GetRegVal(lnHKey,'')
RegCloseKey(lnHKey)
IF ISNULL(guiddesc)
RETURN .F.
ENDIF
*在 HKEY_CLASSES_ROOT\CLSID\…\InprocServer32 中查找控件的文件名(含路径)
lnRes=RegOpenKeyEx(HKEY_CLASSES_ROOT,'CLSID\'+lcGUID+'\InprocServer32',0,131097,@lnHKey)
IF lnRes<>0
RETURN .F.
ENDIF
OcxFile=GetRegVal(lnHKey,'')
RegCloseKey(lnHKey)
IF ISNULL(OcxFile)
RETURN .F.
ENDIF
IF FILE((OcxFile))
RETURN .T.
ELSE
RETURN .F.
ENDIF
ENDFUNC
PROCEDURE GetRegVal(nHKey,cProperty)
LOCAL Result,lcValue,lnValLen,lnType
DECLARE INTEGER RegQueryValueEx IN advapi32 INTEGER nKey,STRING cValueName,INTEGER nReserved,INTEGER @nType,STRING @cBuffer,INTEGER @nBufferSize
IF ISNULL(nHKey)
RETURN .NULL.
ENDIF
lnType=1
lcValue=space(255)
lnValLen=255
result=RegQueryValueEx(nHKey,@cProperty,0,@lnType,@lcValue,@lnValLen)
IF result=0 and lcValue<>CHR(0)
lcValue=Left(lcValue,lnValLen-1)
RETURN lcValue
ELSE
RETURN .NULL.
ENDIF
ENDPROC
[此贴子已经被作者于2016-3-22 11:53编辑过]