cdataenv.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

		************************************************************
		LOCAL lnRelation
		IF TYPE("This.aRelations[1]") == "C"
			FOR lnRelation = 1 TO ALEN(This.aRelations, 1)
				This.AddObject("o" + This.aRelations[lnRelation], This.aRelations[lnRelation])
			ENDFOR
		ENDIF

	ENDFUNC

	FUNCTION Destroy()
		*-------------------- Location Section ---------------------
		*   Library: cDataEnv.PRG
		*   Class:   cDataEnvironment
		*   Method:  Destroy()
		*--------------------- Usage Section -----------------------
		*)  Description:
		*)    Closes the cursors in the data environment when the
		*)    object is destroyed but only if the developer has
		*)    specified that this should happen.
		*   Scope: PUBLIC
		*   Parameters: None
		*$  Usage:
		*$    cDataEnvironment::Destroy()
		*%  Example:
		*%    This.Destroy()
		*   Returns:  LOGICAL .T. by default
		*------------------ Maintenance Section --------------------
		*@  Inputs:
		*@    1.  cDataEnvironment.AutoCloseTables
		*   Outputs: None
		*   Pre-condition Invariants: None
		*   Post-condition Invariants:
		*     1.  The objects of the data environment are closed
		*         if the developer specified so.
		*?  Notes: None
		*   Collaborating Methods:
		*     1.  DataEnvironment::CloseTables()
		*-- Process:
		*--   1.  IF the developer wants the tables closed when the
		*--       the data environment is destroyed,
		*--   2.     Call the CloseTables method to accomplish this task
		*--       ENDIF
		*   Change Log:
		*      MODIFIED
		*--------- (c) Flash Creative Management, Inc. -------------
		*---------------- Commenting Provided By -------------------
		*   Software Assets of Virginia, Inc. (SAVI)
		*   Charles T. Blankenship, President
		*   Compuserve: 76132,2575
		*     Internet: www.savvysolutions.com
		*      eMail 1: [e-mail]
		*      eMail 2: [e-mail]
		*        Voice: [phone]
		************************************************************
		IF This.AutoCloseTables
			This.CloseTables()
		ENDIF

	ENDFUNC

	FUNCTION OpenTables()
		*** EGL: Does this need to remain?
		
		*-------------------- Location Section ---------------------
		*   Library: cDataEnv.PRG
		*   Class:   cDataEnvironment
		*   Method:  OpenTables()
		*--------------------- Usage Section -----------------------
		*)  Description:
		*)     Programmatically opens the child cursors of the
		*)     data environment.
		*   Scope: PUBLIC
		*   Parameters: None
		*$  Usage:
		*$    cDataEnvironment::OpenTables()
		*%  Example:
		*%    This.OpenTables()
		*   Returns:  LOGICAL .T. by default
		*------------------ Maintenance Section --------------------
		*@  Inputs: None
		*   Outputs: None
		*   Pre-condition Invariants:
		*     1.  The cursors and relations of the data environment
		*         have been properly defined
		*   Post-condition Invariants:
		*     1.  The cursors and relations of the data environment
		*         now exit in a data session.
		*?  Notes: None
		*   Collaborating Methods:
		*     1.  DataEnvironment::OpenTables
		*-- Process:
		*--   1.  Open that tables of the data environment
		*--   2.  Suppress default behavior (we have already opened
		*--       the tables programmatically ... prevent FoxPro
		*--       from trying to do it again).
		*   Change Log:
		*      MODIFIED
		*--------- (c) Flash Creative Management, Inc. -------------
		*---------------- Commenting Provided By -------------------
		*   Software Assets of Virginia, Inc. (SAVI)
		*   Charles T. Blankenship, President
		*   Compuserve: 76132,2575
		*     Internet: www.savvysolutions.com
		*      eMail 1: [e-mail]
		*      eMail 2: [e-mail]
		*        Voice: [phone]
		************************************************************
		DataEnvironment::OpenTables()

		*----------------------------------------------------------------
		*-- Prevent the default OpenTables() event of the DataEnvironment
		*-- object from firing ... its already been called manually.
		*----------------------------------------------------------------
		NODEFAULT

	ENDFUNC


	FUNCTION CloseTables()
		*-------------------- Location Section ---------------------
		*   Library: cDataEnv.PRG
		*   Class:   cDataEnvironment
		*   Method:  CloseTables()
		*--------------------- Usage Section -----------------------
		*)  Description:
		*)    Ensures the data environment tables are closed.  It
		*)    automatically handles the error that arises when you
		*)    try to close the tables of a data environment when
		*)    they have alread been closed.
		*   Scope: PUBLIC
		*   Parameters: None
		*$  Usage:
		*$    cDataEnvironment::CloseTables()
		*%  Example:
		*%    This.CloseTables()
		*   Returns:  LOGICAL .T. by default
		*------------------ Maintenance Section --------------------
		*@  Inputs:
		*   Outputs:
		*   Pre-condition Invariants:
		*   Post-condition Invariants:
		*?  Notes: None
		*   Collaborating Methods: None
		*-- Process:
		*--   1.  Initialize the error variable to a non error condition
		*--   2.  Save the previous on error handler
		*--   3.  Set the error handler to store the number of the error
		*--       to the local variable if an error occurs.
		*--   4.  Directly call the data environment close tables method
		*--       The reason to directly call this method instead of
		*--       sending it up the class hierarchy first is due to
		*--       the error handling.  We don't want any more processing
		*--       than necessary going on between the time the
		*--       error handler is customized and when it is reset to
		*--       the application's default error handler.
		*--   5.  Reset the application's default error handler
		*--   6.  Suppress FoxPro's innate desire to close the tables again
		*--       since we have already done it programmatically.
		*--   7.  IF a real error occurred
		*--   8.     Activate the object's native error handler
		*--   9.  ENDIF
		*   Change Log:
		*      MODIFIED
		*--------- (c) Flash Creative Management, Inc. -------------
		*---------------- Commenting Provided By -------------------
		*   Software Assets of Virginia, Inc. (SAVI)
		*   Charles T. Blankenship, President
		*   Compuserve: 76132,2575
		*     Internet: www.savvysolutions.com
		*      eMail 1: [e-mail]
		*      eMail 2: [e-mail]
		*        Voice: [phone]
		************************************************************
		LOCAL lcOnError, ;
			lnErrorNumber
		*---------------------------------------------------------
		*           LOCAL/PRIVATE VARIABLE DESCRIPTIONS
		*---------------------------------------------------------
		* lcOnError - stores the original ON ERROR handler
		* lnErrorNumber - number of the error if one occurs
		*---------------------------------------------------------

		*--------------------------------------------------
		*-- Initialize this method's error processing.
		*--------------------------------------------------
		lnErrorNumber = 0
		lcOnError = ON('ERROR')
		ON ERROR lnErrorNumber = ERROR()

		*--------------------------------
		*-- Try to close the DE's tables.
		*--------------------------------
		DataEnvironment::CloseTables()

		*-----------------------------------
		*-- Reset the original error handler
		*-----------------------------------
		ON ERROR &lcOnError

		*--------------------------------------------------
		*-- Prevent CloseTables() from being called again.
		*--------------------------------------------------
		NODEFAULT

		*--------------------------------------------------
		*-- If a real error occurred trigger the Class'
		*-- native .Error() method.
		*--------------------------------------------------
		IF lnErrorNumber <> 0 AND lnErrorNumber <> ERROR_DE_ALREADY_UNLOADED
			*-- A "real" error
			Error lnErrorNumber
		ENDIF

	ENDFUNC


	FUNCTION Release()
		RELEASE this
	ENDFUNC

	FUNCTION LoadCursors()
	ENDFUNC

	FUNCTION LoadRelations()
	ENDFUNC


	FUNCTION GetDefaultDatabase(tlViewDatabase)
		LOCAL lcDefaultDatabase, lcKey
		lcDefaultDatabase = ""

		IF TYPE("goApp") == "O"
			*--------------------------------------------------
			*-- If the default databasename has been identified
			*-- to this object.
			*--------------------------------------------------

			IF NOT EMPTY(This.cDefaultDatabaseName)
				*---------------------------------------------------------
				*-- Now that SAVI Codebook applications can support
				*-- multiple databases, the user preferences form
				*-- became obsolete.  Previously, you had one database
				*-- and one choice, local or remote.  Now you can have
				*-- many databases and you can specify that each one
				*-- of them is local or remote.  The trigger for this
				*-- new processing is the presence of a new file
				*-- located in the same directory as the .EXE, DBPATHS.DBF
				*-- If that file exists, this program assumes you are
				*-- using the new preferences form.  If it does not, it
				*-- assumes you are still using the original method.
				*---------------------------------------------------------
				IF FILE( "DBPaths.DBF" )
					This.SAVI_GetLocalORRemoteDatabase( @lcDefaultDatabase )
				ELSE
					This.ORIGINAL_GetLocalORRemoteDatabase( @lcDefaultDatabase )
				ENDIF

				*---------------------------
				*-- Add a BS if it needs it.
				*---------------------------
				*** EGL: 04/01/1999 - Don't add the BS if the default is an empty string.
				*!*	IF RIGHT(lcDefaultDatabase, 1) <> "\"
				*!*		lcDefaultDatabase= lcDefaultDatabase+ "\"
				*!*	ENDIF
				IF NOT EMPTY(lcDefaultDatabase) AND ( RIGHT(lcDefaultDatabase, 1) # "\" )
					lcDefaultDatabase= lcDefaultDatabase+ "\"
				ENDIF

				*--------------------------------------------------
				*-- Create the full drive + pathname + filename of
				*-- this business object's default .DBC.
				*--------------------------------------------------
				*** EGL: 2001.12.27 23:29 -  Added support for separate DBC for Views
				IF tlViewDatabase
					lcDefaultDatabase = lcDefaultDatabase + This.cDefaultViewDatabaseName + ".DBC"
				ELSE
					lcDefaultDatabase = lcDefaultDatabase + This.cDefaultDatabaseName + ".DBC"
				ENDIF

			ENDIF && - !EMPTY(This.cDefaultDatabaseName)
		ELSE
			*--------------------------------------------------------------
			*-- If the application object is not an object, then use the
			*-- currently open database, if one exists. If not, check
			*-- the data directory for a DBC, and use it if found. This is
			*-- done only for debug mode to allow for the creation of data
			*-- environments without the need for the application object.
			*--------------------------------------------------------------

			*-----------------------------------------------------------------
			*-- IF you are in debug mode ... modified this class to allow the
			*-- currently used .DBC to be returned if the program is in
			*-- debug mode or not ... added the .T. to ensure this code fires.
			*-----------------------------------------------------------------
			IF FILE(DEBUGMODEFILE) OR .T.
				*------------------------------------
				*-- If a .DBC is currently in use ...
				*------------------------------------
				IF NOT EMPTY(DBC())
					*-------------------------------------------
					*-- Use the currently used .DBC as a defult.
					*-------------------------------------------
					lcDefaultDatabase = DBC()
				ELSE
					*--------------------------------------------------
					*-- If no .DBC is currently in use, look in the \DATA
					*-- directory and see if a .DBC with the default
					*-- database name is there ... if it is use it ...
					*--------------------------------------------------
					IF tlViewDatabase
						lcDefaultDatabase = "DATA\" + This.cDefaultViewDatabaseName + ".DBC"
					ELSE
						lcDefaultDatabase = "DATA\" + This.cDefaultDatabaseName + ".DBC"
					ENDIF

					IF NOT FILE(lcDefaultDatabase)
						*--------------------------------------------------
						*-- If not, there is no specified default database.
						*--------------------------------------------------
						lcDefaultDatabase = ""
					ENDIF

				ENDIF && - !EMPTY(DBC())

			ENDIF && - FILE(DEBUGMODEFILE)

		ENDIF && - TYPE("goApp") == "O"

		*--------------------------------------------------
		*-- Return the drive, path and name of this objects
		*-- default database.
		*--------------------------------------------------
		RETURN FULLPATH(lcDefaultDatabase)

	ENDFUNC

	*-------------------- Location Section ---------------------
	*   Library: cDataEnv.PRG
	*   Class:   cDataEnvironment
	*   Method:  ORIGINAL_GetLocalORRemoteDatabase()
	*--------------------- Usage Section -----------------------
	*)  Description:
	*   Scope: PUBLIC
	*   Parameters: None
	*$  Usage:
	*%  Example:
	*   Returns:
	*------------------ Maintenance Section --------------------
	*@  Inputs:
	*   Outputs:
	*   Pre-condition Invariants:
	*   Post-condition Invariants:
	*?  Notes:
	*   Collaborating Methods:
	*-- Process:
	*   Change Log:
	*--------- (c) Flash Creative Management, Inc. -------------
	*---------------- Commenting Provided By -------------------
	*   Software Assets of Virginia, Inc. (SAVI)
	*   Charles T. Blankenship, President
	*   Compuserve: 76132,2575
	*     Internet: www.savvysolutions.com