整理回复后，目前有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编辑过]

收到的鲜花

• hu9jj 于 2016-03-21 20:03 送鲜花  50朵   附言：好文章

吹版,怎么完善?估计这个很多人用的到

这个是测试数据，是通过的？

这个地址，是你要注册的OCX所在的地址。
使用绝对地址来测试，是能正确注册的。