gendbcx.prg

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

** For best results, view this file with: Courier New / Regular / 10
** TabWidth set to: 4
*******************************************************************************
** Program Name  : GenDBCX.PRG (nee GENDBC.PRG)
** Creation Dates: 94.12.01 (GENDBC.PRG)  97.02.01 (sdGenDBC.PRG)
**
** 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:
**   tcOutFile   - The name of the output file.  This can contain path 
**                 information and an extension.
**                 If no extension is supplied, one will be provided.
**
**   tcClassName - The name of the class to create.  If not supplied,
**                 the default 'sdGenDBC' will be used.
**
** Modification History:
**            (KRT = Somebody at MS; SEA = Steve Arnott, SEA Drive;
**             SAS = Steve Sawyer)
**
** GENDBC:
** 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
**
** sdGenDBC:
** 1997.02.01 SEA  Changed "Get Relations" code to build output in a
**                 memory variable to avoid creating 100+MB memo files
**                 when working with large databases
** 1997.02.24 SEA  Added code to avoid the dreaded "Program too large"
**                 error message by making (almost) everything in the
**                 database re-creation program a procedure
** 1997.02.24 SEA  Replaced usage of "Program" memo field with writing
**                 directly to a temporary file to prevent "Out of disk
**                 space" error caused by memo file bloat
** 1997.02.25 SEA  Changed format of CREATE TABLE output code to improve 
**                 (I hope) its readability
** 1997.03.23 SEA  Added code to create the DBC regeneration program as a
**                 class, so that you can recreate specific tables, views
**                 and connections by calling the output class' methods.
**                 To recreate the entire database, you either run the 
**                 program, or call the GenerateAll method.
** 1997.03.24 SEA  Added code to create a class Init routine that checks
**                 for the existence of the target database container and,
**                 if it finds it, loads the names of its tables into an
**                 array that the table creation methods search.  If the
**                 table name exists in the dbc, it's deleted and recreated.
** 1997.04.04 SEA  Added code to allow user to pass the name of the method
**                 to call as a parameter, rather than forcing the user to
**                 instantiate an sdGenDBC object.
** 1997.05.01 SAS  Added code to recreate the dbc in two steps, with a hook
**                 in the middle that allows the user to append existing data
**                 to the new database, or do anything else that the user might
**                 require upon creation of the new database.
** 1997.07.29 SEA  Fixed some minor formatting errors.
**                 Fixed the RI "error" message line so that the number of the
**                 line in the regeneration program is displayed, rather than
**                 the number of the line in this program.
*******************************************************************************
LPARAMETERS tcOutFile, tcClassName
#IF FILE("custproc.h")
	#INCLUDE custproc.h
#ENDIF

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
	g_cSetTalk = "ON"                      && -- nothing gets on screen
ELSE
	g_cSetTalk = "OFF"
ENDIF
g_cFullPath = SET("FULLPATH")             && To restore old FULLPATH setting
g_cOnError = ON("ERROR")                  && To restore old ON ERROR condition
g_cSetDeleted = SET("DELETED")            && To restore SET DELETED later
g_cSetStatusBar = SET("STATUS BAR")       && To restore STATUS bar
g_cStatusText = SYS(2001, "MESSAGE", 1)   && To restore text that may be on it
g_nMax = 7                                && For status line information
g_nCurrentStat = 1                        && For status line information
g_cFilterExp = ""                         && For Non-Supported Filter Info
g_cSetSafety = SET("SAFETY")              && To restore SAFETY setting
SET DELETED ON
SET FULLPATH ON
IF m.g_cSetStatusBar = "OFF"
	SET STATUS BAR ON
ENDIF
SET SAFETY OFF

DEACTIVATE WINDOW "Project Manager"

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

**************************************************************************
** Constants
**************************************************************************
#DEFINE CRLF CHR(13) + CHR(10)
#DEFINE TAB  CHR(9)

**************************************************************************
** Error Messages
**************************************************************************
#DEFINE NO_DATABASE_IN_USE_LOC   "No Database is in use. " + ;
                                 "This program must have a database " + ;
                                 "available."
#DEFINE INVALID_PARAMETERS_LOC   "Invalid Parameters..." + CRLF + ;
                                 "An output file must be specified." + CRLF +;
                                 'ie: DO GENDBC WITH "filename.prg"'
#DEFINE INVALID_DESTINATION_LOC  "Invalid Destination File "
#DEFINE NO_TEMP_FILE_LOC         "Could not create temporary file: "
#DEFINE NO_OUTPUT_WRITTEN_LOC    "Could not create or write to output file"
#DEFINE ERROR_TITLE_LOC          "Aborting GenDBC..."
#DEFINE UNRECOVERABLE_LOC        "Unrecoverable Error: "
#DEFINE AT_LINE_LOC              " At Line: "
#DEFINE NO_FIND_LOC              "Could not set RI Information"
#DEFINE NO_FILE_FOUND_LOC        "Warning! No Procedure File Found!"
#DEFINE GETFILE_GEN_LOC          "Generate..."
#DEFINE NOT_SUPPORTED_LOC        "Filters on PRIMARY keys are not supported at this time. " + ;
                                 "A comment will be added to your output file specifying the filters."
#DEFINE NS_COMMENT_LOC           "****** These filters need to be added manually ******"
#DEFINE WARNING_TITLE_LOC        "sdGenDBC Warning..." 

**************************************************************************
** Comments And Other Information
**************************************************************************
#DEFINE BEGIN_RELATION_LOC       "Relations Setup"
#DEFINE BEGIN_TABLE_LOC          "Table setup for "
#DEFINE BEGIN_INDEX_LOC          "Create each index for "
#DEFINE BEGIN_PROP_LOC           "Change properties for "
#DEFINE BEGIN_VIEW_LOC           "View setup for "
#DEFINE BEGIN_PROC_LOC           "Procedure Re-Creation"
#DEFINE BEGIN_CONNECTIONS_LOC    "Connection Definition"
#DEFINE BEGIN_RI_LOC             "Referential Integrity Setup"
#DEFINE OPEN_DATABASE_LOC        "Select Database..."
#DEFINE SAVE_PRG_NAME_LOC        "Enter output program name..."
#DEFINE NO_MODIFY_LOC            "*** WARNING *** DO NOT MODIFY THIS FILE IN ANY WAY! *** WARNING ***"
#DEFINE TABLE_NAME_LOC           "*        Table Name: "
#DEFINE PRIMARY_KEY_LOC          "*       Primary Key: "
#DEFINE FILTER_EXP_LOC           "* Filter Expression: "
#DEFINE HEADING_LINE             "* *********************************************************************"
#DEFINE HEADING_1_LOC            HEADING_LINE + CRLF + ;
                                 "* *" + CRLF
#DEFINE HEADING_2_LOC            "* *" + CRLF + ;
                                 HEADING_LINE + CRLF + ;
                                 "* *" + CRLF + ;
                                 "* * Description:" + CRLF + ;
                                 "* * This program was automatically generated by sdGenDBC Version 1.0," + CRLF + ;
                                 "* * a modified version of Microsoft's utility GenDBC Version 2.26.67" + CRLF + ;
                                 "* *" + CRLF + ;
                                 HEADING_LINE + CRLF

#DEFINE CREATE_DBC_LOC           "*-- Create the Database Container"
#DEFINE CREATE_TABLES_LOC        "*-- Create Tables"
#DEFINE CREATE_VIEWS_LOC         "*-- Create Views"
#DEFINE CREATE_CONNECTIONS_LOC   "*-- Create Connections"
#DEFINE CALL_CUSTOM_LOC          "*-- Call custom method"
#DEFINE FINISH_TABLES_LOC        "*-- Finish Tables (add rules/trigggers/properties)"

*! Hook for a custom process to run after the DBC and table structures are created
lcHookStr = CRLF + TAB + TAB + CALL_CUSTOM_LOC + CRLF ;
	+ TAB + TAB + "=this.CustomProcess()" + CRLF + CRLF

*! Make sure a database is open
IF EMPTY(DBC())
	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
g_cDatabase = FULLPATH(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
g_cFullDatabase = DBC()

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

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

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

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

	*! Get Real Names of tables opened
	FOR 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
nTotal_Tables = ADBOBJECTS(aAll_Tables, "Table")
g_nMax = m.g_nMax + m.nTotal_Tables
=Stat_Message()

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

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

*! Get number of relations contained in database
nTotal_Relations = ADBOBJECTS(aAll_Relations, "Relation")
*! SEA: We process relations so fast now, it's better not to include them
*! in the "status" line, as they distort the progress indicator
* m.g_nMax = m.g_nMax + m.nTotal_Relations
=Stat_Message()

CLOSE DATABASES ALL

**************************
*** Get Stored Procedures
**************************
*! Create an output file that will be appended to the database
*! as procedures
cFile = UPPER(SUBSTR(m.tcOutFile, 1, AT(".", m.tcOutFile))) + "krt"
cDPTemp = "GenDBC.$$$"
cSPTemp = "GenDBC.k$$"

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

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

*! Now we are going to copy the object and source code
*! For the stored procedures
OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
COMPILE DATABASE (m.g_cFullDatabase)
CLOSE DATABASES ALL
USE (m.g_cFullDatabase) SHARED
LOCATE FOR Objectname = 'StoredProceduresSource'
IF FOUND()
	COPY MEMO Code TO (m.cSPTemp) ADDITIVE
ENDIF
=ADIR(aTemp, m.cSPTemp)
nSourceSize = m.aTemp[1,2] - LEN(NO_MODIFY_LOC)

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

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

hOutFile = FCREATE(cDPTemp)
IF m.hOutFile <= 0
	=FCLOSE(m.hFile)
	=FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
ENDIF

*******************************************************************************
** Create a class that holds all of the database regeneration code as
** public methods that can be called by anyone who can create a reference
** to the class.
**
** The body of the program now consists of two lines: 1) the creation of
** the sdGenDBC class object, and 2) a call to a "summary" method that 
** calls all of the methods that create the database, tables, views and 
** connections, and set relations and referential integrity.
**
** Using this approach, you can now DO the program to recreate the entire
** database, or you can create an object reference to the sdGenDBC class,
** and recreate tables, views and connections by appending the table/view
** name to its related prefix ("tb" for tables, "vw" for views, "cn" for
** connections), relations by calling the SetRelations method, and RI by
** calling the SetRI method.
** 
** Additionally, if you want to execute the code of a method without
** creating an sdGenDBC object, you can call the program with the name of
** a single method to execute.
*******************************************************************************
*! Write the program heading
=WriteFile(m.hOutFile, ;
	HEADING_1_LOC + "* * " + DTOC(DATE()) +;
	SPACE(25 - LEN(m.g_cDatabase) / 2) + ;
	m.g_cDatabase + SPACE(25 - LEN(m.g_cDatabase) / 2) +;
	TIME() + CRLF + HEADING_2_LOC + CRLF + ;
	IIF(!EMPTY(m.g_cFilterExp), NS_COMMENT_LOC +  m.g_cFilterExp + ;
	CRLF + REPLICATE("*", 52) + CRLF, ""))

*! Write the body of the program