gendbc.prg

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

			m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DataType")
			IF !EMPTY(m.cTemp)
				WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DataType', "] + m.cTemp + [")])
			ENDIF
			m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DefaultValue")
			IF !EMPTY(m.cTemp)
				m.cTemp = STRTRAN(m.cTemp, ["], ['])
				WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DefaultValue', "] + m.cTemp + [")])
			ENDIF
		ENDFOR
	ENDIF

	WriteFile(m.nFileHand, "ENDFUNC")
	WriteFile(m.nFileHand, " ")

	*! Close output file
	FCLOSE(m.nFileHand)

RETURN

**************************************************************************
**
** Function Name: GETCONN(<ExpC>, <ExpC>)
** Creation Date: 1995.01.03
** Purpose        :
**
**              To take an existing FoxPro 3.0/5.0 Connection, and generate
**              an output program that can be used to "re-create" that connection.
**
** Parameters:
**
**      cConnectName -  A character string representing the name of the 
**                      existing connection
**      m.cOutFileName -  A character string containing the name of the 
**                      output file
**
** Modification History:
**
**  1995.01.03  JHL     Created Program, runs on Build 329 of FoxPro 3.0
**  1995.01.05  KRT     Incorporated into GenDBC with modifications
**  1996.04.12  KRT     Added new property for Visual FoxPro 5.0 (Database)
***************************************************************************************
PROCEDURE GetConn
	LPARAMETERS cConnectionName, m.cOutFileName

	PRIVATE ALL EXCEPT g_*

	m.nFileHand = FCREATE(m.cOutFileName, 0)
	IF m.nFileHand < 1
		FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
	ENDIF

	*! Get Connection Information for later use
	m.clAsynchronous = IIF(DBGetProp(m.cConnectionName, 'Connection', 'Asynchronous'),'.T.','.F.')
	m.clBatchMode = IIF(DBGetProp(m.cConnectionName, 'Connection', 'BatchMode'),'.T.','.F.')
	m.ccComment = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Comment'))
	m.ccConnectString = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'ConnectString'))
	m.cnConnectTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'ConnectTimeOut')))
	m.ccDataSource = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'DataSource'))
	m.cnDispLogin = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'DispLogin')))
	m.clDispWarnings = IIF(DBGetProp(m.cConnectionName, 'Connection', 'DispWarnings'),'.T.','.F.')
	m.cnIdleTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'IdleTimeOut')))
	m.ccPassword = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Password'))
	m.cnQueryTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'QueryTimeOut')))
	m.cnTransactions = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'Transactions')))
	m.ccUserId = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'UserId'))
	m.cnWaitTime = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'WaitTime')))
	m.ccDatabase = DBGetProp(m.cConnectionName, 'Connection', 'Database')

	*! Generate Comment Block
	m.cCommentBlock = "***************** " + BEGIN_CONNECTIONS_LOC + " " + m.cConnectionName + ;
		" ***************" + CRLF

	WriteFile(m.nFileHand, "FUNCTION MakeConn_"+FIXNAME(m.cConnectionName))
	WriteFile(m.nFileHand, m.cCommentBlock)

	*! Generate CREATE Connection command
	m.cCreateString = 'CREATE CONNECTION '+ALLTRIM(m.cConnectionName)+' ; '+CRLF

	IF EMPTY(ALLTRIM(m.ccConnectString))  && If connectstring not specified
		m.cCreateString = m.cCreateString + '   DATASOURCE "' + ALLT(m.ccDataSource) + '" ; ' + CRLF
		m.cCreateString = m.cCreateString + '   USERID "' + ALLT(m.ccUserId) + '" ; ' + CRLF
		m.cCreateString = m.cCreateString + '   PASSWORD "'+ ALLT(m.ccPassword) + '"' + CRLF
	ELSE
		m.cCreateString = m.cCreateString + '   CONNSTRING "' + ALLT(m.ccConnectString) + '"'
	ENDIF

	WriteFile(m.nFileHand, m.cCreateString)

	*! GENERATE code to Set Connection Level Properties
	m.cConnectionDBSetPrefix = [DBSetProp(']+m.cConnectionName+[', 'Connection', ]

	m.cConnectionProps = '****' + CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['Asynchronous', ] + m.clAsynchronous + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['BatchMode', ] + m.clBatchMode + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['Comment', '] + m.ccComment + [')]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['DispLogin', ] + m.cnDispLogin + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['ConnectTimeOut', ] + m.cnConnectTimeOut + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['DispWarnings', ] + m.clDispWarnings + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['IdleTimeOut', ] + m.cnIdleTimeOut + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['QueryTimeOut', ] + m.cnQueryTimeOut + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
						['Transactions', ] + m.cnTransactions + [)]+ CRLF
	m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
					    ['Database', '] + m.ccDatabase + [')] + CRLF
					    
	WriteFile(m.nFileHand, m.cConnectionProps)
	*! Close output file
	WriteFile(m.nFileHand, "ENDFUNC")
	WriteFile(m.nFileHand, " ")

	FCLOSE(m.nFileHand)
RETURN

**************************************************************************
**
** Function Name: FATALALERT(<ExpC>)
** Creation Date: 1994.12.02
** Purpose:
**
**              Place a message box to alert user of a fatal error.
**
** Parameters:
**
**      cAlert_Message - Message to display to user
**      lCleanup       - If we should try to restore environment
**
** Modification History:
**
**      1994.12.02  KRT  Added to GenDBC
**************************************************************************
PROCEDURE FatalAlert
	LPARAMETERS cAlert_Message, lCleanup

	MESSAGEBOX(m.cAlert_Message, 16, ERROR_TITLE_LOC)

	GenDBC_CleanUp(m.lCleanup)

	CANCEL
RETURN

**************************************************************************
**
** Function Name: GenDBC_CleanUp(<ExpL>)
** Creation Date: 1995.03.01
** Purpose:
**
**              Restore the environment
**
** Parameters:
**
**      lCleanup - If we should try to restore tables open
**
** Modification History:
**
**      1994.03.01  KRT         Added to GenDBC
**************************************************************************
PROCEDURE GenDBC_CleanUp
	LPARAMETERS lCleanup

	*! Restore everything
	IF !EMPTY(m.g_cOnError)
		ON ERROR &g_cOnError
	ELSE
		ON ERROR
	ENDIF
	
	IF !EMPTY(m.g_cSetTalk)
		SET TALK &g_cSetTalk
	ENDIF
	
	IF !EMPTY(m.g_cSetDeleted)
		SET DELETED &g_cSetDeleted
	ENDIF
	
	IF m.g_cSetStatusBar = "OFF"
		SET STATUS BAR OFF
	ENDIF
	
	IF !EMPTY(m.g_cStatusText)
		SET MESSAGE TO (m.g_cStatusText)
	ELSE
		SET MESSAGE TO
	ENDIF
	
	SET FULLPATH &g_cFullPath
	CLOSE ALL

	IF m.lCleanUp
		IF !EMPTY(m.g_cFullDatabase) AND m.lCleanUp == .T.
			OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
			IF m.g_nTotal_Tables_Used > 0
				FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
					IF UPPER(JUSTEXT(m.g_aTables_Used(m.nLoop)))="TMP"
						LOOP
					ENDIF
					USE (m.g_aTables_Used(m.nLoop)) IN (m.g_aAlias_Used(m.nLoop, 2)) EXCLUSIVE;
						ALIAS (m.g_aAlias_Used(m.nLoop, 1))
				ENDFOR
			ENDIF
		ENDIF
	ENDIF
RETURN

**************************************************************************
**
** Function Name: WRITEFILE(<ExpN>, <ExpC>)
** Creation Date: 1994.12.02
** Purpose        :
**
**              Centralized file output routine to check for proper output
**
** Parameters:
**
**      hFileHandle - Handle of output file
**      cText       - Contents to write to file
**
** Modification History:
**
**      1994.12.02  KRT         Added to GenDBC
**************************************************************************
PROCEDURE WriteFile
	LPARAMETERS hFileHandle, cText

	m.nBytesSent = FPUTS(m.hFileHandle, m.cText)
	IF  m.nBytesSent < LEN(m.cText)
		FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
	ENDIF
RETURN

**************************************************************************
**
** Function Name: GenDBC_Error(<expC>, <expN>)
** Creation Date: 1994.12.02
** Purpose        :
**
**              Generalized Error Routine
**
** Parameters:
**
**      cMess   - Message to give user
**      nLineNo - Line Number Error Occurred
**
** Modification History:
**
**      1994.12.02  KRT         Added to GenDBC
**************************************************************************
PROCEDURE GenDBC_Error
	LPARAMETERS cMess, nLineNo

	FatalAlert(UNRECOVERABLE_LOC + CRLF + m.cMess + CRLF + ;
				  AT_LINE_LOC + ALLTRIM(STR(m.nLineNo)), .T.)
RETURN

**************************************************************************
**
** Function Name: Stat_Message()
** Creation Date: 1994.01.08
** Purpose        :
**
**              Generalized Status Bar Progression
**
** Parameters:
**
**              None
**
** Modification History:
**
**      1994.01.08  KRT         Added to GenDBC
**************************************************************************
PROCEDURE Stat_Message
	PRIVATE ALL EXCEPT g_*
	
	m.nStat = m.g_nCurrentStat * (160 / g_nMax)
	SET MESSAGE TO REPLICATE("|", m.nStat) + " " + ;
		ALLTRIM(STR(INT(100 * (m.g_nCurrentStat / m.g_nMax)))) + "%"
	m.g_nCurrentStat = m.g_nCurrentStat + 1
RETURN

**************************************************************************
**
** Function Name: UpdateProcArray(<ExpC>)
** Creation Date: 1997.10.22
** Purpose        :
**
**              Update g_aprocs array with procedure name
**
** Parameters:
**
**      cText       - Name of procedure to add to array
**
** Modification History:
**
**      1997.10.22  RB         Added to GenDBC
**************************************************************************
PROCEDURE UpdateProcArray(lcProcName)
	IF g_lskipdisplay AND ATC("DisplayStatus",lcprocname)#0
		RETURN
	ENDIF 
	IF !EMPTY(g_aprocs[ALEN(g_aprocs)])
		DIMENSION g_aprocs[ALEN(g_aprocs)+1]
	ENDIF
	g_aprocs[ALEN(g_aprocs)] = lcProcName
ENDPROC

**************************************************************************
**
** Function Name: FixName(<ExpC>)
** Creation Date: 1997.10.22
** Purpose        :
**
**              Fixes procedure name to remove bad chars
**
** Parameters:
**
**      cText       - Name of procedure to add fix
**
** Modification History:
**
**      1997.10.22  RB         Added to GenDBC
**************************************************************************
PROCEDURE FixName(lcProcName)
	lcProcName=ALLTRIM(lcProcName)
	IF VERSION(3) $ DBCS_LOC
		cbadchars = '/,-=:;!@#$%&*.<>()?[]\'+;
		   '+'+CHR(34)+CHR(39)+" "
	ELSE
		cbadchars = '亗儎厗噲墛媽帍悜挀敃枟槞殸、￥