在VFP中如何判断OCX已注册
IF GysOcxReg(SysPath+"\mscomctl.ocx","MSComctlLib.TreeCtrl.2")!=0MESSAGEBOX("树形控件注册失败,您可能有部分功能不能使用," ;
+CHR(13)+" 请检查或重新安装您的程序！...",48,"错误")
ENDIF
*返回值: 0 正常;-1 参数不够;-2 文件不存在
FUNCTION GysOcxReg
PARAMETER oMyOcxFileName , oMyOcxName
LOCAL lpLibFileName,lRegResult AS INTEGER
LOCAL HLibModule AS INTEGER,lnAddress AS LONG
lRegResult=0
IF PARAMETERS()<2
lRegResult = -1&&参数太少
ENDIF
IF IsOleReg(oMyOcxName)
RETURN lRegResult
ENDIF
IF lRegResult=0
lpLibFileName=oMyOcxFileName
IF !FILE(lpLibFileName)
lRegResult = -2&&文件不存在
ENDIF
ENDIF
IF lRegResult=0
*lpProcName = Iif(.T. ,'DllRegisterServer','DllUnregisterServer')
DECLARE INTEGER GetLastError IN kernel32
DECLARE INTEGER LoadLibrary IN kernel32 STRING
DECLARE INTEGER FreeLibrary IN kernel32 INTEGER
DECLARE INTEGER GetProcAddress IN kernel32 INTEGER , STRING
DECLARE INTEGER CallWindowProc IN user32 INTEGER , INTEGER , INTEGER , INTEGER ,INTEGER
HLibModule = LoadLibrary(lpLibFileName)&&在运行时仍然可以载入
IF HLibModule <> 0
lnAddress = GetProcAddress(HLibModule,"DllRegisterServer")
IF lnAddress <> 0
lRegResult=CallWindowProc(lnAddress,0,0,0,0)
IF lRegResult= 0
= FreeLibrary(HLibModule)
ELSE
lRegResult = GetLastError()
ENDIF
ELSE
lRegResult = GetLastError()
ENDIF
= FreeLibrary(HLibModule)
ELSE
lRegResult = GetLastError()
ENDIF
CLEAR DLLS GetLastError
CLEAR DLLS LoadLibrary
CLEAR DLLS FreeLibrary
CLEAR DLLS GetProcAddress
CLEAR DLLS CallWindowProc
ENDIF
RETURN lRegResult
ENDFUNC
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,lcName1,lcGUID,guiddesc,OcxFile,lnRes,lnRes1,lnRes2
*在 HKEY_CLASSES_ROOT\MSComctlLib.TreeCtrl.2中查找控件的名称
lnHKEY=0
lnRes1=-1
lnRes2=-1
lnRes1=RegOpenKeyEx(HKEY_CLASSES_ROOT,OleClsName,0,131097,@lnHKEY)
IF lnRes1<>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 的备注
lnRes2=RegOpenKeyEx(HKEY_CLASSES_ROOT,'CLSID\'+lcGUID,0,131097,@lnHKEY)
IF lnRes2<>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
FUNCTION 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
ENDFUNC
页:
[1]