registry.prg

一个汽车修理厂管理系统源码

			m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime)
			
			DO CASE
			CASE m.nErrCode = ERROR_EOF
				EXIT
			CASE m.nErrCode # ERROR_SUCCESS
				EXIT
			ENDCASE

			cNewKey = ALLTRIM(m.cNewKey)
			cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1)
			IF !EMPTY(aKeyNames[1])
				DIMENSION aKeyNames[ALEN(aKeyNames)+1]
			ENDIF
			aKeyNames[ALEN(aKeyNames)] = m.cNewKey 
			nKeyEntry = m.nKeyEntry + 1
		ENDDO

		IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
			m.nErrCode = ERROR_SUCCESS
		ENDIF
		RETURN m.nErrCode
	ENDPROC

	PROCEDURE EnumKeyValues
		* Enumerates through values of a registry key
		LPARAMETER aKeyValues
		
		LOCAL lpszValue,lpcchValue,lpdwReserved
		LOCAL lpdwType,lpbData,lpcbData
		LOCAL nErrCode,nKeyEntry,lArrayPassed

		STORE 0 TO nKeyEntry
		
		IF TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
			RETURN ERROR_BADKEY
		ENDIF
		
		* Sorry, Win32s does not support this one!
		IF THIS.nCurrentOS = OS_W32S
			RETURN ERROR_BADPLAT
		ENDIF
		
		DO WHILE .T.

			STORE 0 TO lpdwReserved,lpdwType,nErrCode
			STORE SPACE(256) TO lpbData, lpszValue
			STORE LEN(lpbData) TO m.lpcchValue
			STORE LEN(lpszValue) TO m.lpcbData

			nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,;
				@lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)
			
			DO CASE
			CASE m.nErrCode = ERROR_EOF
				EXIT
			CASE m.nErrCode # ERROR_SUCCESS
				EXIT
			ENDCASE

			nKeyEntry = m.nKeyEntry + 1

			* Set array values
			DIMENSION aKeyValues[m.nKeyEntry,2]
			aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue)
			DO CASE
			CASE lpdwType = REG_SZ
				aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
			CASE lpdwType = REG_BINARY
				* Don't support binary
				aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC
			CASE lpdwType = REG_DWORD
				* You will need to use ASC() to check values here.
				aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
			OTHERWISE
				aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC
			ENDCASE
		ENDDO
		 
		IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
			m.nErrCode = ERROR_SUCCESS
		ENDIF
		RETURN m.nErrCode
	ENDPROC

ENDDEFINE


DEFINE CLASS oldinireg AS registry

	PROCEDURE GetINISection
		PARAMETERS aSections,cSection,cINIFile
		LOCAL cINIValue, nTotEntries, i, nLastPos
		cINIValue = ""
		IF TYPE("m.cINIFile") # "C"
			cINIFile = ""
		ENDIF
	
		IF THIS.GetINIEntry(@cINIValue,cSection,0,m.cINIFile) # ERROR_SUCCESS
			RETURN ERROR_FAILINI
		ENDIF

		nTotEntries=OCCURS(CHR(0),m.cINIValue)
		DIMENSION aSections[m.nTotEntries]
		nLastPos = 1
		FOR i = 1 TO m.nTotEntries
			nTmpPos = AT(CHR(0),m.cINIValue,m.i)
			aSections[m.i] = SUBSTR(m.cINIValue,m.nLastPos,m.nTmpPos-m.nLastPos)
			nLastPos = m.nTmpPos+1
		ENDFOR

		RETURN ERROR_SUCCESS
	ENDPROC
		
	PROCEDURE GetINIEntry
		LPARAMETER cValue,cSection,cEntry,cINIFile
		
		* Get entry from INI file 
		LOCAL cBuffer,nBufSize,nErrNum,nTotParms
		nTotParms = PARAMETERS()
		
		* Load API functions
		nErrNum= THIS.LoadINIFuncs()
		IF m.nErrNum # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF
		
		* Parameter checks here
		IF m.nTotParms < 3
			m.cEntry = 0
		ENDIF

		m.cBuffer=space(2000)
		
		IF EMPTY(m.cINIFile)
			* WIN.INI file
			m.nBufSize = GetWinINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer))
		ELSE
			* Private INI file
			m.nBufSize = GetPrivateINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer),m.cINIFile)
		ENDIF
		
		IF m.nBufSize = 0 &&could not find entry in INI file
			RETURN ERROR_NOINIENTRY
		ENDIF
		
		m.cValue=LEFT(m.cBuffer,m.nBufSize)
		
		** All is well
		RETURN ERROR_SUCCESS
	ENDPROC
	
	PROCEDURE WriteINIEntry
		LPARAMETER cValue,cSection,cEntry,cINIFile
		
		* Get entry from INI file 
		LOCAL nErrNum
		
		* Load API functions
		nErrNum = THIS.LoadINIFuncs()
		IF m.nErrNum # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF
		
		IF EMPTY(m.cINIFile)
			* WIN.INI file
			nErrNum = WriteWinINI(m.cSection,m.cEntry,m.cValue)
		ELSE
			* Private INI file
			nErrNum = WritePrivateINI(m.cSection,m.cEntry,m.cValue,m.cINIFile)
		ENDIF
				
		** All is well
		RETURN IIF(m.nErrNum=1,ERROR_SUCCESS,m.nErrNum)
	ENDPROC

	PROCEDURE LoadINIFuncs
		* Loads funtions needed for reading INI files
		IF THIS.lLoadedINIs
			RETURN ERROR_SUCCESS
		ENDIF
		
		DECLARE integer GetPrivateProfileString IN Win32API ;
			AS GetPrivateINI string,string,string,string,integer,string

		IF THIS.lhaderror && error loading library
			RETURN -1
		ENDIF

		DECLARE integer GetProfileString IN Win32API ;
			AS GetWinINI string,string,string,string,integer

		DECLARE integer WriteProfileString IN Win32API ;
			AS WriteWinINI string,string,string

		DECLARE integer WritePrivateProfileString IN Win32API ;
			AS WritePrivateINI string,string,string,string

		THIS.lLoadedINIs = .T.
		
		* Need error check here
		RETURN ERROR_SUCCESS
	ENDPROC

ENDDEFINE

DEFINE CLASS foxreg AS registry

	PROCEDURE SetFoxOption
		LPARAMETER cOptName,cOptVal
		RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
	ENDPROC

	PROCEDURE GetFoxOption
		LPARAMETER cOptName,cOptVal
		RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
	ENDPROC

	PROCEDURE EnumFoxOptions
		LPARAMETER aFoxOpts
		RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.)
	ENDPROC

ENDDEFINE

DEFINE CLASS odbcreg AS registry

	PROCEDURE LoadODBCFuncs
		IF THIS.lLoadedODBCs
			RETURN ERROR_SUCCESS
		ENDIF
		
		* Check API file containing functions

		IF EMPTY(THIS.cODBCDLLFile)
			RETURN ERROR_NOODBCFILE
		ENDIF

		LOCAL henv,fDirection,szDriverDesc,cbDriverDescMax
		LOCAL pcbDriverDesc,szDriverAttributes,cbDrvrAttrMax,pcbDrvrAttr
		LOCAL szDSN,cbDSNMax,pcbDSN,szDescription,cbDescriptionMax,pcbDescription

		DECLARE Short SQLDrivers IN (THIS.cODBCDLLFile) ;
			Integer henv, Integer fDirection, ;
			String @ szDriverDesc, Integer cbDriverDescMax, Integer pcbDriverDesc, ;
			String @ szDriverAttributes, Integer cbDrvrAttrMax, Integer pcbDrvrAttr

		IF THIS.lhaderror && error loading library
			RETURN -1
		ENDIF

		DECLARE Short SQLDataSources IN (THIS.cODBCDLLFile) ;
			Integer henv, Integer fDirection, ;
			String @ szDSN, Integer cbDSNMax, Integer @ pcbDSN, ;
			String @ szDescription, Integer cbDescriptionMax,Integer pcbDescription

		THIS.lLoadedODBCs = .T.
		
		RETURN ERROR_SUCCESS
	ENDPROC
	
	PROCEDURE GetODBCDrvrs
		PARAMETER aDrvrs,lDataSources
		LOCAL nODBCEnv,nRetVal,dsn,dsndesc,mdsn,mdesc

		lDataSources = IIF(TYPE("m.lDataSources")="L",m.lDataSources,.F.)

		* Load API functions
		nRetVal = THIS.LoadODBCFuncs()
		IF m.nRetVal # ERROR_SUCCESS
			RETURN m.nRetVal
		ENDIF

		* Get ODBC environment handle
		nODBCEnv=VAL(SYS(3053))

		* -- Possible error messages
		* 527 "cannot load odbc library"
		* 528 "odbc entry point missing"
		* 182 "not enough memory"

		IF INLIST(nODBCEnv,527,528,182)
			* Failed
			RETURN ERROR_ODBCFAIL
		ENDIF

		DIMENSION aDrvrs[1,IIF(m.lDataSources,2,1)]
		aDrvrs[1] = ""
	
		DO WHILE .T.
			dsn=space(100)
			dsndesc=space(100)
			mdsn=0
			mdesc=0

			* Return drivers or data sources
			IF m.lDataSources
				nRetVal = SQLDataSources(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,255,@mdesc)
			ELSE
				nRetVal = SQLDrivers(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,100,@mdesc)
			ENDIF
				
			DO CASE
			CASE m.nRetVal = SQL_NO_DATA
				nRetVal = ERROR_SUCCESS
				EXIT
			CASE m.nRetVal # ERROR_SUCCESS AND m.nRetVal # 1 
				EXIT
			OTHERWISE
				IF !EMPTY(aDrvrs[1])
					IF m.lDataSources
						DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,2]
					ELSE
						DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,1]
					ENDIF
				ENDIF
				dsn = ALLTRIM(m.dsn)
				aDrvrs[ALEN(aDrvrs,1),1] = LEFT(m.dsn,LEN(m.dsn)-1)
				IF m.lDataSources
					dsndesc = ALLTRIM(m.dsndesc)				
					aDrvrs[ALEN(aDrvrs,1),2] = LEFT(m.dsndesc,LEN(m.dsndesc)-1)			
				ENDIF
			ENDCASE
		ENDDO
		RETURN nRetVal
	ENDPROC

	PROCEDURE EnumODBCDrvrs
		LPARAMETER aDrvrOpts,cODBCDriver
		LOCAL cSourceKey
		cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver
		RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.)
	ENDPROC

	PROCEDURE EnumODBCData
		LPARAMETER aDrvrOpts,cDataSource
		LOCAL cSourceKey
		cSourceKey = ODBC_DATA_KEY+cDataSource
		RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.)
	ENDPROC

ENDDEFINE

DEFINE CLASS filereg AS registry

	PROCEDURE GetAppPath
		* Checks and returns path of application
		* associated with a particular extension (e.g., XLS, DOC). 
		LPARAMETER cExtension,cExtnKey,cAppKey,lServer
		LOCAL nErrNum,cOptName
		cOptName = ""

		* Check Extension parameter
		IF TYPE("m.cExtension") # "C" OR LEN(m.cExtension) > 3
			RETURN ERROR_BADPARM
		ENDIF
		m.cExtension = "."+m.cExtension

		* Open extension key
		nErrNum = THIS.OpenKey(m.cExtension)
		IF m.nErrNum  # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF

		* Get key value for file extension
		nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)

		* Close extension key
		THIS.CloseKey()

		IF m.nErrNum  # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF
		RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
	ENDPROC

	PROCEDURE GetLatestVersion
		* Checks and returns path of application
		* associated with a particular extension (e.g., XLS, DOC). 
		LPARAMETER cClass,cExtnKey,cAppKey,lServer
		
		LOCAL nErrNum,cOptName
		cOptName = ""

		* Open class key (e.g., Excel.Sheet)
		nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY)
		IF m.nErrNum  # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF

		* Get key value for file extension
		nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)

		* Close extension key
		THIS.CloseKey()

		IF m.nErrNum  # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF
		RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
	ENDPROC

	PROCEDURE GetApplication
		PARAMETER cExtnKey,cAppKey,lServer

		LOCAL nErrNum,cOptName
		cOptName = ""
		
		* lServer - checking for OLE server.
		IF TYPE("m.lServer") = "L" AND m.lServer
			THIS.cAppPathKey = OLE_PATH_KEY
		ELSE	
			THIS.cAppPathKey = APP_PATH_KEY
		ENDIF

		* Open extension app key
		m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey)
		IF m.nErrNum  # ERROR_SUCCESS
			RETURN m.nErrNum
		ENDIF

		* Get application path
		nErrNum = THIS.GetKeyValue(cOptName,@cAppKey)

		* Close application path key
		THIS.CloseKey()
		
		RETURN m.nErrNum
	ENDPROC

ENDDEFINE