gendbc.prg

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

ENDIF
Stat_Message()

* Write out database creation routines
UpdateProcArray("DisplayStatus(["+MESSAGE_START_LOC+"])")
UpdateProcArray("CLOSE DATA ALL")
UpdateProcArray("CREATE DATABASE '" + m.g_cDatabase + "'")

**************************
*** Get Tables
**************************
IF m.nTotal_Tables > 0
	FOR m.nLoop = 1 TO m.nTotal_Tables
		DO GetTable WITH ALLTRIM(aAll_Tables(m.nLoop)), "GenDBC.tmp"
		Stat_Message()
		USE GenDBC EXCLUSIVE
		APPEND MEMO Program FROM "GenDBC.tmp"
		USE
		ERASE "GenDBC.tmp"
		UpdateProcArray("DisplayStatus(["+MESSAGE_MAKETABLE_LOC+aAll_Tables(m.nLoop)+MESSAGE_END_LOC+"])")
		UpdateProcArray("MakeTable_"+FixName(aAll_Tables(m.nLoop))+"()")
	ENDFOR
ENDIF

**************************
*** Get Connections
**************************
IF m.nTotal_Connections > 0
	FOR m.nLoop = 1 TO m.nTotal_Connections
		DO GetConn WITH aAll_Connections(m.nLoop), "GenDBC.tmp"
		Stat_Message()
		USE GenDBC EXCLUSIVE
		APPEND MEMO Program FROM "GenDBC.tmp"
		USE
		ERASE "GenDBC.tmp"
		UpdateProcArray("DisplayStatus(["+MESSAGE_MAKECONN_LOC+aAll_Connections(m.nLoop)+MESSAGE_END_LOC+"])")
		UpdateProcArray("MakeConn_"+FIXNAME(aAll_Connections(m.nLoop))+"()")
	ENDFOR
ENDIF

**************************
*** Get Views
**************************
IF m.nTotal_Views > 0
	FOR m.nLoop = 1 TO m.nTotal_Views
		DO GetView WITH ALLTRIM(aAll_Views(m.nLoop)), "GenDBC.tmp"
		Stat_Message()
		USE GenDBC EXCLUSIVE
		APPEND MEMO Program FROM "GenDBC.tmp"
		USE
		ERASE "GenDBC.tmp"
		UpdateProcArray("DisplayStatus(["+MESSAGE_MAKEVIEW_LOC+aAll_Views(m.nLoop)+MESSAGE_END_LOC+"])")
		UpdateProcArray("MakeView_"+FIXNAME(aAll_Views(m.nLoop))+"()")
	ENDFOR
ENDIF

**************************
*** Get Relations
**************************
IF m.nTotal_Relations > 0
	USE GenDBC EXCLUSIVE
	REPLACE Program WITH BEGIN_RELATION_LOC + CRLF ADDITIVE
	UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERELATION_LOC+"])")
	FOR m.nLoop = 1 TO m.nTotal_Relations
		REPLACE Program WITH CRLF + "FUNCTION MakeRelation_"+TRANS(m.nLoop)+CRLF+;
							 "ALTER TABLE '" + aAll_Relations(m.nLoop, 1) +;
							 "' ADD FOREIGN KEY TAG " +;
							 aAll_Relations(m.nLoop, 3) +;
							 " REFERENCES " + ;
							 aAll_Relations(m.nLoop, 2) +;
							 " TAG " + aAll_Relations(m.nLoop, 4) + ;
							 CRLF +"ENDFUNC"+CRLF+CRLF ADDITIVE
		UpdateProcArray("MakeRelation_"+TRANS(m.nLoop)+"()")
	Stat_Message()
	ENDFOR
ENDIF

CLOSE DATABASE  && Because we're going to start peeking into the
				&& table structure of the DBC

**************************
*** Get RI Info
**************************
IF m.nTotal_Relations > 0
	DO GetRI WITH "GenDBC.tmp"
	IF FILE("GenDBC.tmp")
		USE GenDBC EXCLUSIVE
		APPEND MEMO Program FROM "GenDBC.tmp"
		USE
		ERASE "GenDBC.tmp"
		UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERI_LOC+"])")
		UpdateProcArray("MakeRI()")
	ENDIF
ENDIF
UpdateProcArray("DisplayStatus(["+MESSAGE_DONE_LOC+"])")
Stat_Message()

*! Make it a permanent file
USE GenDBC EXCLUSIVE
lcprocstr = ""
FOR i = 1 TO ALEN(g_aprocs)
	lcprocstr = lcprocstr + g_aprocs[m.i] + CRLF
ENDFOR
lcMessageStr =  "FUNCTION DisplayStatus(lcMessage)"+CRLF+;
				"WAIT WINDOW NOWAIT lcMessage"+CRLF+;
				"ENDFUNC"			
REPLACE Program WITH HEADING_1_LOC + "* * " + DTOC(DATE()) +;
					 SPACE(19 - LEN(m.g_cDatabase) / 2) + ;
					 m.g_cDatabase + SPACE(19 - 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, "") + ;
					 CRLF + lcprocstr + CRLF + Program +;
					 CRLF + lcMessageStr +CRLF
										 
COPY MEMO Program TO (m.cOutFile)
USE
ERASE "GenDBC.DBF"
ERASE "GenDBC.FPT"

Stat_Message()

*! Exit Program
COMPILE (m.cOutFile)
GenDBC_CleanUp(.T.)
*********************** END OF PROGRAM ***********************

**************************************************************************
**
** Function Name: GETRI(<ExpC>)
** Creation Date: 1994.12.02
** Purpose:
**
**      To take existing FoxPro 3.0/5.0 RI Infomration, and generate an output
**      program that can be used to "re-create" this.
**
** Parameters:
**
**      cOutFileName - A character string containing the name of the
**                     output file
**
** Modification History:
**
**  1995.01.05  KRT		Created function
**  1995.12.20  KRT		Allow better lookup when trying to find
**						the right record to add the RI information
**************************************************************************
PROCEDURE GetRI
	LPARAMETERS m.cOutFileName

	PRIVATE ALL EXCEPT g_*

	*! Create the output file
	m.hGTFile = FCREATE(m.cOutFileName)
	IF m.hGTFile < 1
		FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
	ENDIF

	*! USE the database
	USE (m.g_cFullDatabase) EXCLUSIVE

	LOCATE FOR ObjectType = "Relation" AND !EMPTY(RiInfo)
	IF FOUND()
		WriteFile(m.hGTFile, "FUNCTION MakeRI")
		WriteFile(m.hGTFile, "***** " + BEGIN_RI_LOC + " *****")
		WriteFile(m.hGTFile, "CLOSE DATABASE")
		WriteFile(m.hGTFile, "USE '" +  m.g_cDatabase + "'")
		DO WHILE FOUND()
			*! Have to get the parent name to verify we are adding
			*! Information to the right record.
			m.nParentID = ParentID
			*! We use select so we won't mess up our LOCATE ... CONTINUE command
			SELECT ObjectName FROM (m.g_cFullDatabase) WHERE ObjectID = nParentID INTO ARRAY aTableName
			m.nStart = 1
			m.cITag = ""
			m.cTable = ""
			m.cRTag = ""
			DO WHILE m.nStart <= LEN(Property)
				nSize = ASC(SUBSTR(Property, m.nStart, 1)) +;
				(ASC(SUBSTR(Property, m.nStart + 1, 1)) * 256) +;
				(ASC(SUBSTR(Property, m.nStart + 2, 1)) * 256^2) + ;
				(ASC(SUBSTR(Property, m.nStart + 3, 1)) * 256^3)

				m.nKey = ASC(SUBSTR(Property, m.nStart + 6, 1))

				DO CASE
					CASE m.nKey = 13
						m.cITag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
					CASE m.nKey = 18
						m.cTable = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
					CASE m.nKey = 19
						m.cRTag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
				ENDCASE
				m.nStart = m.nStart + m.nSize
			ENDDO
			WriteFile(m.hGTFile, "LOCATE FOR ObjectType = 'Table' AND ObjectName = '" + ;
						 ALLTRIM(aTableName(1)) + "'")
			WriteFile(m.hGTFile, "IF FOUND()")
			WriteFile(m.hGTFile, "    nObjectID = ObjectID")
			WriteFile(m.hGTFile, "    LOCATE FOR ObjectType = 'Relation' AND '" + m.cITag + ;
						"'$Property AND '" + m.cTable + "'$Property AND '" + m.cRTag + ;
						"'$Property AND ParentID = nObjectID")
			WriteFile(m.hGTFile, "    IF FOUND()")
			WriteFile(m.hGTFile, "	      REPLACE RiInfo WITH '" + RiInfo + "'")
			WriteFile(m.hGTFile, "    ELSE")
			WriteFile(m.hGTFile, '       ? "' + NO_FIND_LOC + '"')
			WriteFile(m.hGTFile, "    ENDIF")
			WriteFile(m.hGTFile, "ENDIF")
			CONTINUE
		ENDDO
		WriteFile(m.hGTFile, "USE")
		WriteFile(m.hGTFile, "ENDFUNC")
		WriteFile(m.hGTFile, "")
		FCLOSE(m.hGTFile)
	ELSE
		FCLOSE(m.hGTFile)
	ERASE (m.cOutFileName)
	ENDIF
	USE
RETURN

**************************************************************************
**
** Function Name: GETTABLE(<ExpC>, <ExpC>)
** Creation Date: 1994.12.01
** Purpose        :
**
**              To take an existing FoxPro 3.0/5.0 Table, and generate an output
**              program that can be used to "re-create" that Table.
**
** Parameters:
**
**      cTableName   -  A character string representing the name of the
**                      existing Table
**      cOutFileName -  A character string containing the name of the
**                      output file
**
** Modification History:
**
**  1994.12.02  KRT             Created function
**  1994.12.05  KRT             Made it a function and cleaned it up
**  1994.12.08  KRT             Assume Database is open to speed up operation
**  1995.09.15  KRT             Use DBF() to find the real table name
**  1995.09.15  KRT             Take into account CR+LF in comment fields
**  1996.04.12  KRT             Added new properties for Visual FoxPro 5.0
**                              InputMask / Format / DisplayClass
**                              DisplayClassLibrary
**  1996.06.01  KRT             Added support for Collate sequence on index
**************************************************************************
PROCEDURE GetTable
	LPARAMETERS m.cTableName, m.cOutFileName

	PRIVATE ALL EXCEPT g_*

	*! Create the output file
	m.hGTFile = FCREATE(m.cOutFileName)
	IF m.hGTFile < 1
		FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
	ENDIF

	*! Open Table to get field info
	USE (m.cTableName) EXCLUSIVE

	*! Get all the fields
	m.nNumberOfFields = AFIELDS(aAll_Fields)

	*! Header Information
	WriteFile(m.hGTFile, "FUNCTION MakeTable_"+FIXNAME(m.cTableName))
	WriteFile(m.hGTFile, "***** " + BEGIN_TABLE_LOC + m.cTableName + " *****")

	*! NOTE * NOTE * NOTE
	*! If the table is greater than 8 characters then it will fail on platforms that
	*! do not support this (Such as Win32s).
	m.cOldSetFullPath = SET("FULLPATH")
	SET FULLPATH OFF
	m.cTableFileName = DBF(ALIAS())
	SET FULLPATH &cOldSetFullPath
	m.cTableFileName = SUBSTR(m.cTableFileName, RAT(":", m.cTableFileName) + 1)
	m.cCreateTable = "CREATE TABLE '" + m.cTableFileName + "' NAME '" + m.cTableName + "' ("
	
	*! Information about each field that can been written with CREATE TABLE - SQL
	FOR m.nInner_Loop = 1 TO m.nNumberOfFields
		IF m.nInner_Loop = 1
			m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 1) + " "
		ELSE
			m.cCreateTable = SPACE(LEN(m.cTableName) + 15) + ;
							aAll_Fields(m.nInner_Loop, 1) + " "
		ENDIF
		m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 2)
		DO CASE
			CASE aAll_Fields(m.nInner_Loop, 2) == "C"
				m.cCreateTable = m.cCreateTable + "(" + ;
								ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ")"
				IF aAll_Fields(m.nInner_Loop, 6)
					m.cCreateTable = m.cCreateTable + " NOCPTRANS"
				ENDIF
			CASE aAll_Fields(m.nInner_Loop, 2) == "M"
				IF aAll_Fields(m.nInner_Loop, 6)
					m.cCreateTable = m.cCreateTable + " NOCPTRANS"
				ENDIF
			CASE aAll_Fields(m.nInner_Loop, 2) == "N" OR ;
				aAll_Fields(m.nInner_Loop, 2) == "F"
				cCreateTable = m.cCreateTable + "(" + ;
				ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ;
				", " + ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) + ")"
			CASE aAll_Fields(m.nInner_Loop, 2) == "B"
				m.cCreateTable = m.cCreateTable + "(" + ;
				ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) ;
				+ ")"
		ENDCASE

		IF aAll_Fields(m.nInner_Loop, 5)
			m.cCreateTable = m.cCreateTable + " NULL"
		ELSE
			m.cCreateTable = m.cCreateTable + " NOT NULL"
		ENDIF

		*! Get properties for fields
		IF !EMPTY(aAll_Fields(m.nInner_Loop, 7))
			m.cCreateTable = m.cCreateTable + " CHECK " + aAll_Fields(m.nInner_Loop, 7)
		ENDIF

		IF !EMPTY(aAll_Fields(m.nInner_Loop, 8))
			m.cCreateTable = m.cCreateTable + " ERROR " + aAll_Fields(m.nInner_Loop, 8)
		ENDIF

		IF !EMPTY(aAll_Fields(m.nInner_Loop, 9))
			m.cCreateTable = m.cCreateTable + " DEFAULT " + aAll_Fields(m.nInner_Loop, 9)
		ENDIF

		IF m.nInner_Loop <> m.nNumberOfFields
			m.cCreateTable = m.cCreateTable + ", ;"
		ELSE
			m.cCreateTable = m.cCreateTable + ")"
		ENDIF