高手指教：VFP9如何判断一个控件（.ocx）是否注册？ - VFP论坛

得分:0

&&我自己在网上找了一个，问题已解决并与各狐友分享：

IF IsOleReg('农历控件.Calendar')   && IsOleReg()是自定义的一个函数。
   =MESSAGEBOX("控件 Calendar 已经注册",64,"信息提示")
ELSE
   =MESSAGEBOX("控件 Calendar 没有注册",48,"信息提示")
ENDIF

*本程序也可以检查DLL有没有被注册，以收发邮件的jmail.dll为例
*if IsOleReg('jmail.SMTPMail')   &&参数也可以用jmail.POP3
*   =MessageBox("jmail.dll 已经注册",64,"信息提示")
*else
*   =MessageBox("jmail.dll 没有注册",48,"信息提示")
*endif

FUNCTION  IsOleReg

LPARAMETERS 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