templatecode.krt

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

#INCLUDE "<common_path>\INCLUDE\FRAMEWRK.H"

*========== Database Defined Constants =========
#DEFINE DATABASE_NAME "<pjxname>"
#DEFINE DATABASE_DIR GetPath(DATABASE_NAME)

FUNCTION CBNewID(tcAlias)
LOCAL lcAlias, luID, lnOldReprocess, lnOldArea

lnOldArea = SELECT(0)

*-- If no alias was provided, use the current alias
IF PCOUNT() < 1
	lcAlias = ALIAS()
	IF CURSORGETPROP("SOURCETYPE") = DB_SRCLOCALVIEW

		*-- Attempt to get base table
		lcAlias = UPPER(CURSORGETPROP("TABLES"))

		*-- Modified 10/18/1997 21:34 - CTB:
		*-- A view returned an lcBaseTable of "Emloyee!EmpRight,Employee!Section"
		*-- Therefore, if a "," comma exists in the lcBaseTable variable,
		*-- parse out the first DATABASE!TABLE name and use that as the
		*-- base table information. This change also had to be made in all
		*-- CBNewID() functions in all databases.
		IF OCCURS(",", lcAlias) > 0
			lcAlias = SUBSTR(lcAlias, 1, AT(",", lcAlias) - 1)
		ENDIF

		lcAlias = SUBSTR(lcAlias, AT("!", lcAlias) + 1)
	ENDIF
ELSE
	lcAlias = UPPER(tcAlias)
ENDIF

luID = ""
lnOldReprocess = SET("REPROCESS")

*-- Lock until user presses Esc
SET REPROCESS TO AUTOMATIC

*-- IF a NextPK table is already in use, close it down
*-- and force this procedure to use its database
*-- NextPK table
IF USED("NextPK")
	USE IN NextPK
ENDIF

*-- The following situations must be taken into account.
*-- 1) Default Codebook setup has been implemented and the
*-- .EXE or .APP is located one subdirectory above
*-- the database directory (which is defined in the
*-- DATABASE_DIR defined constant)
*-- 2) The .EXE resides on a client machine and the
*-- data resides on the server (local or remote). In
*-- this case, the first IF statement fails and the
*-- second one uses the DBPaths.DBF to locate the
*-- database.

*-- Situation #1: Codebook Default Setup
IF FILE(DATABASE_DIR + "NextPK.DBF")
	USE (DATABASE_DIR + "NextPK.DBF") IN 0 ALIAS NextPK
ELSE
	*-- Situation #2: .EXE Is Located Somewhere Else
	LOCAL lcNextPKTablePath
	GetTablePath(DATABASE_NAME, @lcNextPKTablePath)
	IF FILE(lcNextPKTablePath + "NextPK.DBF")
		USE (lcNextPKTablePath + "NextPK.DBF") IN 0 ALIAS NextPK
	ENDIF
ENDIF

IF NOT USED("NextPK")
	MESSAGEBOX("The NextPK table for this database could not be " + ;
		"found. The new record you just tried to add does not " + ;
		"have a system generated key. Please Cancel this new record " + ;
		"and contact your developer for maintenance.", 0, ;
		DATABASE_NAME + " Database Error")
ELSE
	SELECT NextPK

	*** EGL: 08/23/2000 - If the entry isn't present, add it. The new NextPK record will inherit the defaults
	***   set up when the NewApp was generated.
	IF NOT SEEK(lcAlias, "NextPK", "cKeyName")
		INSERT INTO NextPK (cKeyName) VALUES (lcAlias)
	ENDIF

	*-- Generate the NextPK for the new record
	IF RLOCK()
		luID = NextPK.cValue

		*** EGL: 08/22/2000 - Just increment if type is Integer
		IF NextPK.cType == "I"
			* Cast to Integer type
			luID = INT(VAL(luID))
			REPLACE NextPK.cValue WITH PADL(TRANSFORM(luID + 1), NextPK.iMaxLength, "0")
		ELSE
			REPLACE NextPK.cValue WITH EVAL(NextPK.cIncrementProcedure)
		ENDIF

		UNLOCK
	ENDIF
	*!*	ELSE
	*!*		*-- If the new ID could not be generated, message
	*!*		*-- the developer.
	*!*		MESSAGEBOX("The alias " + lcAlias + " could not be found " + ;
	*!*			"in the NextPK Table, as a result, the primary key could not " + ;
	*!*			"be generated. Please Cancel the newly added record and " + ;
	*!*			"contact your developer for maintenance.", 0, ;
	*!*			DATABASE_NAME + " Database Error")
	*!*	ENDIF

	*-- Trim trailing blanks only if the generated key is character
	IF TYPE("luID") == "C"
		luID = RTRIM(luID)
		AttachPrefix(@luID)
	ENDIF
ENDIF

SET REPROCESS TO lnOldReprocess
SELECT (lnOldArea)

RETURN luID

ENDFUNC


FUNCTION AttachPrefix(tuID)
*-- Test to see if the PREFIX column exists in the
*-- ID table AND that the developer wants a prefix
*-- attached to the identifier.
IF TYPE("NextPK.cPrefix") == "C" AND NOT EMPTY(NextPK.cPrefix)
	LOCAL lcPrefix
	lcPrefix = ALLTRIM(NextPK.cPrefix)
	tuID = lcPrefix + tuID
ENDIF

RETURN
ENDFUNC


FUNCTION GetPath(tcDatabaseName, tcLocalRemote)
LOCAL lnSelect, lcPath
lnSelect = SELECT(0)

*-- Assume the default Codebook database path
lcPath = ".\DATA\"

IF FILE("DBPATHS.DBF")

	IF USED("DbPaths")
		SELECT DbPaths
	ELSE
		SELECT 0
		USE DbPaths AGAIN SHARED ALIAS DbPaths
	ENDIF

	IF SEEK(tcDatabaseName, "DbPaths", "cDB_Name")
		DO CASE
			CASE TYPE("tcLocalRemote") = "L"
				IF DbPaths.lLocalData
					lcPath = ALLTRIM(DbPaths.cDB_Local)
				ELSE
					lcPath = ALLTRIM(DbPaths.cDB_Remote)
				ENDIF

			CASE UPPER(tcLocalRemote) = "LOCAL"
				lcPath = ALLTRIM(DbPaths.cDB_Local)

			CASE UPPER(tcLocalRemote) = "REMOTE"
				lcPath = ALLTRIM(DbPaths.cDB_Remote)

		ENDCASE
	ENDIF

	SELECT (lnSelect)

	IF USED("DbPaths")
		USE IN DbPaths
	ENDIF

ENDIF

RETURN lcPath

ENDFUNC


FUNCTION IncrementBase62(tcValue)
*-- Unique IDs are stored as a base 62 number. In a 6-byte
*-- character string, this gives us 62^6 possible values. Since
*-- 62^6 is greater than the maximum number of records allowed
*-- in a Foxpro table (2 billion), we will never reach this limit.
*-- Base 62 numbers include the following range of values:
*-- "0" - "9"
*-- "A" - "Z"
*-- "a" - "z"
*-- Top value of each range
#DEFINE NINE		57		&& ASC("9")
#DEFINE CAP_Z		90		&& ASC("Z")
#DEFINE LOW_Z		122		&& ASC("z")

LOCAL lnDigit, lnStringLength, lnChar, lcChar, lcID, lcValue
lcValue = tcValue
lcID = ""

*-- Loop backwards through the string only as
*-- many times as necessary to increment the value.
lnStringLength = LEN(lcValue)
FOR lnDigit = lnStringLength TO 1 STEP -1
	lnChar = ASC(SUBSTR(lcValue, lnDigit, 1))
	IF lnChar = LOW_Z

		*-- Make the char "0". We'll need to loop again.
		lcValue = LEFT(lcValue, lnDigit - 1) + "0" + ;
			RIGHT(lcValue, lnStringLength - lnDigit)
	ELSE
		*-- Figure out new value of lcChar. We'll automatically
		*-- exit the loop since no other chars have to be
		*-- incremented.
		DO CASE
			CASE lnChar = NINE
				lcChar = "A"

			CASE lnChar = CAP_Z
				lcChar = "a"

			CASE lnChar = KEY_SPACE
				lcChar = "1"

			OTHERWISE
				lcChar = CHR(lnChar + 1)

		ENDCASE
		lcID = LEFT(lcValue, lnDigit - 1) + lcChar + ;
			RIGHT(lcValue, lnStringLength - lnDigit)
		EXIT
	ENDIF
ENDFOR

*-- If lcID is empty, then we have reached the maximum allowable
*-- value, so replace everything with zeros.
IF EMPTY(lcID)
	lcID = REPLICATE("0", lnStringLength - 1) + "1"
ENDIF

RETURN lcID
ENDFUNC


FUNCTION IncrementBase10(tcValue)
*-- Increments a base 10 number. This function assumes that
*-- the length of tcValue represents the maximum number of
*-- possible digits for this base 10 number.
LOCAL lnStringLength

lnStringLength = LEN(tcValue)
RETURN PADL(RIGHT(ALLT(STR(VAL(tcValue) + 1)), lnStringLength), lnStringLength)

ENDFUNC