newapp.prg

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

FUNCTION MkMain(tcCommonPath)
	SELECT TextFile
	LOCATE FOR TextFile.cFileName = "MAIN.PRG"
	IF FOUND()
		REPLACE crsTextFile.mWork WITH STRTRAN(TextFile.mText, "<common_path>", ;
			LEFT(UPPER(tcCommonPath), LEN(tcCommonPath)-1))
		COPY MEMO crsTextFile.mWork TO progs\Main.prg
	ENDIF
	RETURN
ENDFUNC


FUNCTION UpdateAppRefs(tcProject, tcCommonPath, tcDestinationDir, tcMenuFileName)
	LOCAL lnPOS, lcCommon, lcDir, lcStem

	*-- Update database name in project
	SELECT 0
	USE Template.pjx

	lcDir = FULLPATH(tcDestinationDir)
	IF RIGHT(lcDir, 1) == "\"
		lcDir = LEFT (lcDir, LEN(lcDir)-1)
	ENDIF
	REPLACE FOR Type = "H" homedir WITH lcDir + CHR(0), object WITH lcDir + CHR(0), ;
		Name WITH UPPER(lcDir) + "\" + UPPER(tcProject) + ".PJX" + CHR(0), ;
		Reserved1 WITH UPPER(lcDir) + "\" + UPPER(tcProject) + ".PJX" + CHR(0)

	REPLACE FOR (type = "d") AND ("template.dbc" $ name) ;
		name WITH STRTRAN(LOWER(name), "template", LOWER(tcProject))
	*** EGL: 2002.1.1 09:12 -  Added separate views database to project
	REPLACE FOR (type = "d") AND ("templateviews.dbc" $ name) ;
		name WITH STRTRAN(LOWER(name), "templateviews", LOWER(tcProject) + "views")
		
	*** EGL: 2002.1.1 20:16 -  Allow the user to rename the MPR menu
	lcStem = LOWER(JUSTSTEM(tcMenuFileName))
	IF NOT (lcStem == "mainmenu")
		REPLACE FOR (type = "M") AND ("mainmenu.mnx" $ name) ;
			name WITH STRTRAN(LOWER(name), "mainmenu", lcStem)
	ENDIF
		
	*-- Update references to common directory in project
	SCAN
		lnPos = ATC("common\", name)
		IF lnPos > 0
			lcCommon = LEFT(name, lnPos + 6)
			REPLACE name WITH STRTRAN(name, lcCommon, LOWER(tcCommonPath))
		ENDIF
	ENDSCAN

	*-- Update appincl2 name
	REPLACE FOR "appincl2" $ name ;
		name WITH STRTRAN(name, "appincl2", "appincl")
	USE

	RETURN
ENDFUNC


FUNCTION CreateProjectDBC(tcProject, tcCommonPath, tlUseIntegerKeys)

	* This is a standalone program for creating the DBC programmatically.
	MakeDBC(tcProject, tcCommonPath, tlUseIntegerKeys)

	RETURN
ENDFUNC


*!*	FUNCTION UpdateApplicationDBCStoredProcedures()
*!*		LPARAMETERS tcCommonPath, tcProjectName

*!*		*-- Update reference to common directory in stored
*!*		*-- procedures
*!*		USE data\generic.dbc
*!*		LOCATE FOR objectname = "StoredProceduresSource"
*!*		IF FOUND()
*!*			REPLACE code WITH STRTRAN(code, ;
*!*				"<common_path>", ;
*!*				LEFT(UPPER(tcCommonPath), LEN(tcCommonPath) - 1))

*!*			REPLACE code WITH STRTRAN(code, "<pjxname>", UPPER(tcProjectName))
*!*		ENDIF
*!*		USE

*!*		RETURN
*!*	ENDFUNC


*!*	FUNCTION RenameDBCAndUpdateLinkToIDTable()
*!*		LPARAMETERS tcAppNameLoc, tcProject

*!*		LOCAL lcProjectFile, lcProjectIndex, lcProjectMemo

*!*		*-- Rename DBC and update link to ID field
*!*		WAIT CLEAR
*!*		MESSAGEBOX([About to rename database. The back-link information for ] + ;
*!*			[the ID, DUMMY and DEVNOTES table must be updated to ] + ;
*!*			[reflect the new database name. Please answer "Yes" to ] + ;
*!*			[the three dialogs that immediately follows this one.], 64, tcAppNameLoc)

*!*		CD DATA

*!*		lcProjectFile = tcProject + ".DBC"
*!*		lcProjectIndex = tcProject + ".DCX"
*!*		lcProjectMemo = tcProject + ".DCT"

*!*		RENAME generic.dbc TO (lcProjectFile)
*!*		RENAME generic.dcx TO (lcProjectIndex)
*!*		RENAME generic.dct TO (lcProjectMemo)

*!*		OPEN DATA (tcProject)
*!*		USE ID		&& Back link dialog will be displayed at this point
*!*		USE DEVNOTES
*!*		USE DUMMY
*!*		USE
*!*		CLOSE DATA

*!*		*-- Make templates of the DBC and its corresponding ID table
*!*		*-- for use when making multiple .DBC projects as described in
*!*		*-- the article Creating a Codebook (VFP) Database in the
*!*		*-- Software Assets of Virginia, Inc. Development Guide
*!*		COPY FILE (lcProjectFile) TO ("..\DBC_TMPL\" + lcProjectFile)
*!*		COPY FILE (lcProjectIndex) TO ("..\DBC_TMPL\" + lcProjectIndex)
*!*		COPY FILE (lcProjectMemo) TO ("..\DBC_TMPL\" + lcProjectMemo)

*!*		COPY FILE ID.DBF TO ..\DBC_TMPL\ID.DBF
*!*		COPY FILE ID.CDX TO ..\DBC_TMPL\ID.CDX

*!*		COPY FILE DEVNOTES.DBF TO ..\DBC_TMPL\DEVNOTES.DBF
*!*		COPY FILE DEVNOTES.CDX TO ..\DBC_TMPL\DEVNOTES.CDX
*!*		COPY FILE DEVNOTES.DBF TO ..\DBC_TMPL\DEVNOTES.DBF

*!*		COPY FILE DUMMY.DBF TO ..\DBC_TMPL\DUMMY.DBF

*!*		*-- CD ..
*!*		*-- Modification: 08/26/1997 08:32:00 - CTB: added function
*!*		*-- call that fixes problems with the CD .. command
*!*		*-- CDToParentDirectory() located in the UTILITY.PRG
*!*		CDToParentDirectory()

*!*		RETURN
*!*	ENDFUNC


FUNCTION UpdateSecDBCProcs(tcCommonPath)

	*------------------------------------------------------------
	*-- Update reference to common directory in stored procedures
	*-- of the SECURITY database
	*------------------------------------------------------------
	USE security\security.dbc
	REPLACE FOR objectname = "StoredProceduresSource" ;
		code WITH STRTRAN(code, "<common_path>", ;
		LEFT(UPPER(tcCommonPath), LEN(tcCommonPath)-1))
	USE

	RETURN
ENDFUNC


FUNCTION RenameDBC(tcProject)

	*-- Rename project database file
	RENAME Template.pjx TO (tcProject + ".PJX")
	RENAME Template.pjt TO (tcProject + ".PJT")
	RETURN

ENDFUNC


FUNCTION UpdateLocations(tcCommonPath)
	LOCAL lnPOS, lnFile, laFiles[1,5], lcCommon, lcClassLoc, laVCX[1], lcNonCommon
	CD LIBS

	*-- Update CLASSLOC field in all VCXs
	FOR lnFile = 1 TO ADIR(laFiles, "*.vcx")
		USE (laFiles[lnFile, 1]) EXCL ALIAS _vcx
		SCAN
			lnPos = ATC("common\", _vcx.classloc)
			IF lnPos > 0

				IF ADIR(laVCX, ALLTRIM(_vcx.classloc)) > 0
					* Path is correct; no change needed.
				ELSE

					lcCommon = LEFT(_vcx.classloc, lnPos + 6)
					lcClassLoc = STRTRAN(_vcx.classloc, lcCommon, LOWER(tcCommonPath))

					IF ADIR(laVCX, lcClassLoc) > 0
						* Reference is good
						REPLACE _vcx.classloc WITH SYS(2014, lcClassLoc)
					ELSE
						* There are problems, so assume that the common directory is at the
						* same level as the app directory, and set the path relatively.
						lcNonCommon = SUBSTR(_vcx.classloc, lnPos)
						REPLACE _vcx.classloc WITH "..\..\" + lcNonCommon
					ENDIF
					
				ENDIF
			ENDIF
		ENDSCAN

		REPLACE _vcx.reserved8 WITH "..\include\appincl.h" FOR !EMPTY(_vcx.reserved8)

		USE IN _vcx
	ENDFOR

	CDToParentDirectory()

	RETURN
ENDFUNC


FUNCTION UpdateAppClass(tcApplicationClass, tlClassMenus, tcMenuFileName)
	LOCAL lcMenuClass, lcProgram, lcProps

	*-- Update the name of the application class
	USE libs\aapp.vcx 
	LOCATE FOR objname = "template"
	
	* Set the menu properties
	lcMenuClass = IIF(tlClassMenus, "MainMenu", "")
	lcProgram = IIF(tlClassMenus, "", tcMenuFileName)
	lcProps = aapp.Properties + ;
	"cmainmenuclass = " + lcMenuClass + CRLF + ;
	"cmainmenuprogram = " + lcProgram + CRLF + ;
	"luseclassbasedmenus = " + TRANSFORM(tlClassMenus) + CRLF
	
	REPLACE aapp.Properties WITH lcProps, ;
		objname WITH tcApplicationClass
	
	USE

	RETURN
ENDFUNC


FUNCTION RemoveMPRFromPJX(tcProject, tcDestinationDir)
	SELECT 0
	USE (ADDBS(tcDestinationDir) + FORCEEXT(tcProject, "PJX"))
	DELETE FOR LOWER(Type) == "m"
	USE

	RETURN
ENDFUNC


FUNCTION RemoveMenusFromPJX(tcProject, tcDestinationDir)
	SELECT 0
	USE (ADDBS(tcDestinationDir) + FORCEEXT(tcProject, "PJX"))
	DELETE FOR "menus.v" $ Name
	USE

	RETURN
ENDFUNC


FUNCTION SetProperMenuVersion(tlClassMenus, tcDestinationDir, tcMenuFileName)
	* There will be a Pre7Menu and Post7Menu directory off of PROGS. Copy the appropriate files, 
	* then erase them both
	LOCAL lnDotPos, lcVersNum, lcTarget, lcStem, laMPR[1], lcMPR
	llEarlyVers = .T.
	IF NOT tlClassMenus
		lnDotPos = AT(".", VERSION())
		lcVersNum = SUBSTR(VERSION(), lnDotPos-2, 2)
		lcTarget = tcDestinationDir + "PROGS\" + JUSTSTEM(tcMenuFileName) + ".*"
		
		IF ( (lcVersNum == "05") OR (lcVersNum == "06") )
			COPY FILE (tcDestinationDir + "PROGS\Pre7Menu\*.*") TO (lcTarget)
		ELSE
			COPY FILE (tcDestinationDir + "PROGS\Post7Menu\*.*") TO (lcTarget)
		ENDIF
	ENDIF
	
	* The generated MPR contains references to "MAINMENU", which is what it was named when generated
	* If the user has selected a different menu name, we need to replace those references
	lcStem = UPPER(JUSTSTEM(tcMenuFileName))
	IF NOT lcStem == "MAINMENU"
		* There will be only one MPR file in the PROGS directory at this point
		IF ADIR(laMPR, tcDestinationDir + "PROGS\*.MPR") = 1
			lcMPR = tcDestinationDir + "PROGS\" + laMPR[1,1]
			STRTOFILE(STRTRAN(FILETOSTR(lcMPR), "MAINMENU", lcStem), lcMPR)
		ENDIF
	ENDIF
	
	ERASE (tcDestinationDir + "PROGS\Pre7Menu\*.*")
	ERASE (tcDestinationDir + "PROGS\Post7Menu\*.*")
	RD (tcDestinationDir + "PROGS\Pre7Menu\")
	RD (tcDestinationDir + "PROGS\Post7Menu\")
	
	RETURN
ENDFUNC


FUNCTION GetFileText(tcFileName)
	*-- lcAppIncludeFileText = GetFileText("APPINCL.H")
	*-- lcStartCBFileText = GetFileText("STARTCB.PRG")
	*-- lcADATAENVProgramText = GetFileText("ADATAENV.PRG")
	LOCAL lcRetVal

	lcRetVal = ""

	LOCATE FOR TextFile.cFileName = tcFileName
	IF FOUND()
		lcRetVal = ALLTRIM(TextFile.mText)
	ENDIF

	RETURN lcRetVal

ENDFUNC


FUNCTION UpdateDBPaths(tcProject, tcDestinationDir)
	#DEFINE USE_LOCAL_DATA .T.

	*-- Just as a precaution, make sure the developer
	*-- left the DBPATHS.DBF in the TEMPLATE subdirectory
	IF FILE("dbpaths.dbf")
		INSERT INTO dbpaths (cdb_name, cdb_local, cdb_remote, llocaldata, cdb_desc) ;
			VALUES (tcProject, tcDestinationDir + "DATA\", " ", USE_LOCAL_DATA, ;
			"Location of " + tcProject + " Database")

		INSERT INTO dbpaths (cdb_name, cdb_local, cdb_remote, llocaldata, cdb_desc) ;
			VALUES ("SECURITY", tcDestinationDir + "SECURITY\", " ", ;
			USE_LOCAL_DATA, "Location of " + tcProject + " Security Database")

		INSERT INTO dbpaths (cdb_name, cdb_local, cdb_remote, llocaldata, cdb_desc) ;
			VALUES (" ", tcDestinationDir + "CBMETA\", " ", USE_LOCAL_DATA, ;
			"Location of MetaData Table")
	ELSE
		MESSAGEBOX("DBPaths table could not be updated with default database paths", 32, "NewApp Warning Message")
	ENDIF
	RETURN
ENDFUNC


FUNCTION NotifyComplete(tcAppNameLoc, tcDestinationDir)
	*-- Reset default to opening sub-directory
	MESSAGEBOX(tcAppNameLoc + " project files successfully created !!!" + CHR(13) + CHR(13) + ;
		"Before you run your new application ... be sure to: " + CHR(13) + CHR(13) + ;
		"1. CD to the " + tcDestinationDir + " directory" + CHR(13) + CHR(13) + ;
		"2. Ensure DEVELOPMENT is set ON" + CHR(13) + CHR(13) + ;
		"3. Execute STARTCB with the .T. paramater: STARTCB(.T.) " + CHR(13) + CHR(13) + ;
		"4. Type DO MAIN and press the ENTER key" + CHR(13) + CHR(13) + ;
		"5. Ensure your application runs normally", 0, tcAppNameLoc)
	RETURN
ENDFUNC


FUNCTION CBNewID()
	RETURN .T.
ENDFUNC