gendbc.prg

爱师软件工作室的教材管理系统源码

** For best results, view this file with: Courier New / Regular / 10
** TabWidth set to: 4
**************************************************************************
** Program Name : GENDBC.PRG
** Creation Date: 94.12.01
**
** Purpose		:	To take an existing FoxPro 3.0/5.0 database and
**					generate an output program that can be used
**					to "re-create" that database.
** Parameters	:	cOutFile - A character string that contains
**					the name of an output file.  This
**					can contain path information and
**					an extension.  If no extension is
**					supplied, one will be provided.
**
**					lskipdisplay - Whether to include status
**					messages in generated output.
** Modification History:
**
** 1994.12.01 KRT  Created program, runs on Build 329 of VFP
** 1994.12.02 KRT  Added GetView function and cleaned up all code
** 1994.12.05 KRT  Modified some areas and verified run on Build 335
** 1994.12.06 KRT  Added things for international conversion
** 1994.12.08 KRT  Added function ADBOBJECTS() to code
** 1994.12.12 KRT  Added commands COPY PROCEDURES TO
** 1995.01.04 KRT  Added connection properties
** 1995.01.05 KRT  Added support for long filenames - thierryp
** 1995.01.05 KRT  Added support for RI
** 1995.01.06 KRT  Added support for MS-DOS short filenames (NAME clause)
** 1995.01.08 KRT  Added status bar line
** 1995.01.26 KRT  Fixed a few file bugs and localization bug
** 1995.02.19 KRT  Took advantage of AFIELDS() command
** 1995.02.22 KRT  Fixed AUSED() bug
** 1995.03.01 KRT  Removed ON ERROR problem
** 1995.03.20 KRT  Fixed "Exclusive" Error / Procedures created before
**                 Tables
** 1995.03.22 KRT  Allowed user to open database if one is not set current
**                 / Set SAFETY OFF in resulting code to prevent errors
**                   when validating rules/triggers that don't exist
** 1995.04.07 KRT  Put any database procedures into a seperate file to
**                 prevent "Program Too Large" errors
** 1995.04.20 KRT  Only change SAFETY when appending procedures
**
** 3.0b - Changes/Fixes
** 1995.09.15 KRT  Changed ADBOBJECTS() to DBF() in GETTABLE procedure.
**                 This allows for "real" table names instead of alias'
** 1995.09.15 KRT  Take into account CR+LF in comments for fields
** 1995.09.15 KRT  Store Source and Object code into external file
**                 So the code can be executed from the run-time version
** 1995.10.23 KRT  Changed DBF(cTableName ) to DBF(ALIAS() ) because
**                 VFP will automatically add underscores where spaces
**                 should be and I need to know what it did to the alias
**                 [Regress]
** 1995.10.25 KRT  Added OVERWRITE to append memo's [Regress]
** 1995.10.25 KRT  Added support for CR+LF in comments for Table
** 1995.10.25 KRT  Close all tables in generated code before adding
**                 Source and Object code from external file[Regress]
** 1995.10.25 KRT  Added warning about filter indices on Unique and
**                 Candidate keys (Not supported via language )
** 1995.12.20 KRT  Better lookup for adding RI information to database
** 1995.12.20 KRT  Added support for filter expressions on CANDIDATE keys
** 
** 5.0 - Changes/Fixes
** 1996.03.27 KRT  Added "exact match" support for Locate command
** 1996.04.12 KRT  Added new properties for Views, Fields and Connections
** 1996.05.14 KRT  Adjusted for some logical properties return spaces
** 1996.05.16 KRT  Added even more new properties for Views
** 1996.05.16 KRT  Add M. in front of all memory variables to prevent
**                 confusion with table fields and names
** 1996.06.01 KRT  Added support for Collate sequence on index files
** 1996.06.26 KRT  Added support for ParameterList in Views
** 1996.07.19 KRT  Added support for Offline Views
** 1996.08.07 KRT  Added support for comments and default values in views
** 1997.10.22 RB   Breakup data creation into procedures to eliminate 64K proc limit
**************************************************************************
LPARAMETERS cOutFile,lskipdisplay

PRIVATE ALL EXCEPT g_*
*! Public Variables
IF SET("TALK") = "ON"						&& To restore SET TALK after use
	SET TALK OFF							&& -- Have to do it this way so
	m.g_cSetTalk = "ON"						&& -- nothing get's on screen
ELSE
	m.g_cSetTalk = "OFF"
ENDIF
m.g_lskipdisplay = IIF(vartype(lskipdisplay)#"L",.F.,lskipdisplay)
m.g_cFullPath = SET("FULLPATH")				&& To restore old FULLPATH setting
m.g_cOnError = ON("ERROR")					&& To restore old ON ERROR condition
m.g_cSetDeleted = SET("DELETED")			&& To restore SET DELETED later
m.g_cSetStatusBar = SET("STATUS BAR")		&& To restore STATUS bar
m.g_cStatusText = SYS(2001, "MESSAGE", 1)	&& To restore text that may be on it
m.g_nMax = 7								&& For status line information
m.g_nCurrentStat = 1							&& For status line information
m.g_cFilterExp = ""                         && For Non-Supported Filter Info
DIMENSION g_aProcs[1]
SET DELETED ON
SET FULLPATH ON
IF m.g_cSetStatusBar = "OFF"
	SET STATUS BAR ON
ENDIF

*! Our generic error handling routine
ON ERROR DO GenDBC_Error WITH MESSAGE(), LINENO()

**************************************************************************
** Constants
**************************************************************************
#DEFINE CRLF CHR(13) + CHR(10)
#DEFINE DBCS_LOC 			"81 82 86 88"

**************************************************************************
** Error Messages
**************************************************************************
#DEFINE NO_DATABASE_IN_USE_LOC	"没有打开任何数据库。" +								"本程序运行时必须要有一个数据库可用。"


#DEFINE INVALID_PARAMETERS_LOC	"无效参数..." + CRLF +								"应该指定一个输出文件" + CRLF +								'ie: DO GENDBC WITH "filename.prg"'


#DEFINE INVALID_DESTINATION_LOC	"无效的目标文件"
#DEFINE NO_TEMP_FILE_LOC		"不能创建临时文件: "
#DEFINE NO_OUTPUT_WRITTEN_LOC   "不能创建输出文件或不能向输出文件写内容"
#DEFINE ERROR_TITLE_LOC			"放弃 GenDBC..."
#DEFINE UNRECOVERABLE_LOC		"不可恢复的错误："
#DEFINE AT_LINE_LOC				" 行: "
#DEFINE NO_FIND_LOC				"不能设置 RI 信息。"
#DEFINE NO_FILE_FOUND_LOC		"警告！找不到过程文件！"
#DEFINE GETFILE_GEN_LOC			"生成..."
#DEFINE NOT_SUPPORTED_LOC		"主索引上的筛选器现在不起作用。" +"注释将被加入到输出文件中以指明这些筛选器。"

#DEFINE NS_COMMENT_LOC			"****** 这些筛选器必须人工添加 ******"
#DEFINE WARNING_TITLE_LOC		"GenDBC 警告..."

**************************************************************************
** Comments And Other Information
**************************************************************************
#DEFINE MESSAGE_START_LOC	"正在创建数据库..."
#DEFINE MESSAGE_DONE_LOC	"已完成。"
#DEFINE MESSAGE_MAKETABLE_LOC 	"正在创建表 "
#DEFINE MESSAGE_MAKEVIEW_LOC	"正在创建视图 "
#DEFINE MESSAGE_MAKECONN_LOC	"正在创建连接 "
#DEFINE MESSAGE_MAKERELATION_LOC	"正在创建永久关系..."
#DEFINE MESSAGE_MAKERI_LOC	"正在创建关系完整性规则..."
#DEFINE MESSAGE_END_LOC		"..."
#DEFINE BEGIN_RELATION_LOC		"*************** 开始关系设置 **************"
#DEFINE BEGIN_TABLE_LOC			"建立表为"
#DEFINE BEGIN_INDEX_LOC			"创建每一索引为 "
#DEFINE BEGIN_PROP_LOC			"改变属性为 "
#DEFINE BEGIN_VIEW_LOC			"建立视图为"
#DEFINE BEGIN_PROC_LOC			"重新创建过程"
#DEFINE BEGIN_CONNECTIONS_LOC	"连接定义"
#DEFINE BEGIN_RI_LOC			"建立参照完整性"
#DEFINE OPEN_DATABASE_LOC		"选择数据库..."
#DEFINE SAVE_PRG_NAME_LOC		"输出程序名..."
#DEFINE NO_MODIFY_LOC			"*** 警告 *** 请不要对此文件做任何修改 *** 警告 ***"
#DEFINE TABLE_NAME_LOC			"*        表名: "
#DEFINE PRIMARY_KEY_LOC			"*      主关键字: "
#DEFINE FILTER_EXP_LOC			"* 筛选表达式: "
#DEFINE HEADING_1_LOC	"* *********************************************************" + CRLF +"* *" + CRLF

#DEFINE HEADING_2_LOC	"* *" + CRLF +"* *********************************************************" + CRLF +						"* *" + CRLF +						"* * 说明:" + CRLF +						"* * 此程序是 GENDBC 自动生成的" + CRLF +						"* * Version 2.26.67" + CRLF +						"* *" + CRLF +						"* *********************************************************" + CRLF








*! Make sure a database is open
IF EMPTY(DBC())
	m.g_cFullDatabase = GETFILE("DBC", OPEN_DATABASE_LOC, GETFILE_GEN_LOC, 0)
	IF EMPTY(m.g_cFullDatabase)
		FatalAlert(NO_DATABASE_IN_USE_LOC, .F.)
	ENDIF
	OPEN DATABASE (m.g_cFullDatabase)
ENDIF

*! Set global variable to the database name and format it
m.g_cDatabase = DBC()
IF RAT("\", m.g_cDatabase) > 0
	m.g_cDatabase = SUBSTR(m.g_cDatabase, RAT("\", m.g_cDatabase) + 1)
ENDIF

*! Get the fullpath of database
m.g_cFullDatabase = DBC()

*! Check for valid parameters
IF PARAMETERS() < 1 OR TYPE("cOutFile")#"C" OR EMPTY(cOutFile)
	m.cOutFile = ""
	m.cOutFile = PUTFILE(SAVE_PRG_NAME_LOC, (SUBSTR(m.g_cDatabase, 1, RAT(".", m.g_cDatabase)) + "PRG"), "PRG")
	IF EMPTY(cOutFile)
		FatalAlert(INVALID_PARAMETERS_LOC, .F.)
	ENDIF
ENDIF

*! Check for proper extensions or add one if none specified
IF RAT(".PRG", m.cOutFile) = 0 AND RAT(".", m.cOutFile) = 0
	m.cOutFile = m.cOutFile + ".PRG"
ENDIF

*! Make sure the output file is valid
m.hFile = FCREATE(m.cOutFile)
IF m.hFile <= 0
	FatalAlert(INVALID_DESTINATION_LOC + m.cOutFile, .F.)
ENDIF

FCLOSE(m.hFile)
ERASE (m.cOutFile)

*! Remember all our tables that are open for this database
m.g_nTotal_Tables_Used = AUSED(g_aAlias_Used)
IF m.g_nTotal_Tables_Used > 0
	DIMENSION m.g_aTables_Used(m.g_nTotal_Tables_Used)

	*! Get Real Names of tables opened
	FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
		g_aTables_Used(m.nLoop) = DBF(g_aAlias_Used(m.nLoop, 1))
	ENDFOR
ENDIF

*! Get number of tables contained in database
m.nTotal_Tables = ADBOBJECTS(aAll_Tables, "Table")
m.g_nMax = m.g_nMax + m.nTotal_Tables
Stat_Message()

*! Get number of views contained in database
m.nTotal_Views = ADBOBJECTS(aAll_Views, "View")
m.g_nMax = m.g_nMax + m.nTotal_Views
Stat_Message()

*! Get number of connections contained in database
m.nTotal_Connections = ADBOBJECTS(aAll_Connections, "Connection")
m.g_nMax = m.g_nMax + m.nTotal_Connections
Stat_Message()

*! Get number of relations contained in database
m.nTotal_Relations = ADBOBJECTS(aAll_Relations, "Relation")
m.g_nMax = m.g_nMax + m.nTotal_Relations
Stat_Message()
CLOSE DATABASE

SELECT 0
*! Check for this database... If it's there, we must have left it
*! here because of an error last time.
IF FILE("GENDBC.DBF")
	ERASE "GENDBC.DBF"
	ERASE "GENDBC.FPT"
ENDIF

CREATE TABLE GenDBC (Program M)
APPEND BLANK
USE

**************************
*** Get Stored Procedures
**************************
*! Create an output file that will be appended to the database
*! as procedures
m.cFile = UPPER(SUBSTR(m.cOutFile, 1, RAT(".", m.cOutFile))) + "krt"

*! Place Header Information For Source/Object
m.hFile = FCREATE(m.cFile)
IF m.hFile <= 0
	FCLOSE(m.hFile)
	FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
ENDIF

FPUTS(m.hFile, NO_MODIFY_LOC)
FCLOSE(m.hFile)

*! No we are going to copy the object and source code
*! For the stored procedures
COMPILE DATABASE (m.g_cFullDatabase)
USE (m.g_cFullDatabase)
LOCATE FOR Objectname = 'StoredProceduresSource'
IF FOUND()
	COPY MEMO Code TO (m.cFile) ADDITIVE
ENDIF
ADIR(aTemp, m.cFile)
m.nSourceSize = aTemp(1, 2) - LEN(NO_MODIFY_LOC)

LOCATE FOR Objectname = 'StoredProceduresObject'
IF FOUND()
	COPY MEMO Code TO (m.cFile) ADDITIVE
ENDIF
USE

*! Open the database again
OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE

ADIR(aTemp, m.cFile)

*! Check for actual output file being created sans header
IF aTemp(1, 2) > LEN(NO_MODIFY_LOC) + 2
	**************************
	*** Make the output file
	*** re-create the proced-
	*** ure file via code.
	**************************
	m.hOutFile = FCREATE("GenDBC.$$$")
	IF m.hOutFile <= 0
		= FCLOSE(m.hFile)
		= FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
	ENDIF
	WriteFile(m.hOutFile, "")
	WriteFile(m.hOutFile, "********* " + BEGIN_PROC_LOC + " *********")
	WriteFile(m.hOutFile, "IF !FILE([" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "])")
	WriteFile(m.hOutFile, "    ? [" + NO_FILE_FOUND_LOC + "]")
	WriteFile(m.hOutFile, "ELSE")
	WriteFile(m.hOutFile, "	CLOSE DATABASE")
	WriteFile(m.hOutFile, "	USE '" +  m.g_cDatabase + "'")
	WriteFile(m.hOutFile, "	g_SetSafety = SET('SAFETY')")
	WriteFile(m.hOutFile, "	SET SAFETY OFF")
	WriteFile(m.hOutFile, "	LOCATE FOR Objectname = 'StoredProceduresSource'")
	WriteFile(m.hOutFile, "	IF FOUND()")
    WriteFile(m.hOutFile, "        APPEND MEMO Code FROM [" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "] OVERWRITE")
	WriteFile(m.hOutFile, "	    REPLACE Code WITH SUBSTR(Code, " + ALLTRIM(STR(LEN(NO_MODIFY_LOC) + 3)) + ", " + ALLTRIM(STR(m.nSourceSize - 2)) + ")")
	WriteFile(m.hOutFile, "	ENDIF")
	WriteFile(m.hOutFile, "	LOCATE FOR Objectname = 'StoredProceduresObject'")
	WriteFile(m.hOutFile, "	IF FOUND()")
    WriteFile(m.hOutFile, "        APPEND MEMO Code FROM [" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "] OVERWRITE")
	WriteFile(m.hOutFile, "        REPLACE Code WITH SUBSTR(Code, " + ALLTRIM(STR(LEN(NO_MODIFY_LOC) + m.nSourceSize + 1)) + ")")
	WriteFile(m.hOutFile, "	ENDIF")
	WriteFile(m.hOutFile, "    SET SAFETY &g_SetSafety")
	WriteFile(m.hOutFile, "	USE")
	WriteFile(m.hOutFile, "	OPEN DATABASE [" + m.g_cDatabase + "]")
	WriteFile(m.hOutFile, "ENDIF")
	WriteFile(m.hOutFile, "")
	FCLOSE(m.hOutFile)
	USE GenDBC EXCLUSIVE
	APPEND MEMO Program FROM "GENDBC.$$$"
	ERASE "GENDBC.$$$"
	USE
ELSE
	ERASE (m.cFile)