gendbcx.prg

来自「MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功」· PRG 代码 · 共 1,475 行 · 第 1/4 页

PRG
1,475 行
字号
1234
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['CompareMemo', ] + m.clCompareMemo + [)])
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['FetchAsNeeded', ] + m.clFetchAsNeeded + [)])
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['FetchSize', ] + m.cnFetchSize + [)])
	IF !EMPTY(m.cParams)
		=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['ParameterList', "] + m.cParams + [")])
	ENDIF
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['Comment', "] +  m.cComment + [")])
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['BatchUpdateCount', ] + m.cnBatchUpdateCount + [)])
	=WriteFile(m.hOutFile, m.cViewDBSetPrefix + ['ShareConnection', ] + m.clShareConnection + [)])
	IF m.lOffline
		=WriteFile(m.hOutFile, '		CREATEOFFLINE("' + m.cViewName + '")')
	ENDIF
		

	*! GENERATE code to Set Field Level Properties
	USE (DBC()) AGAIN IN 0 ALIAS GenViewCursor EXCLUSIVE
	SELECT GenViewCursor
	LOCATE FOR ALLTRIM(UPPER(GenViewCursor.ObjectName)) == m.cViewName AND ;
    	GenViewCursor.ObjectType = 'View'
	nObjectId = GenViewCursor.ObjectId
	SELECT ObjectName FROM GenViewCursor ;
			WHERE GenViewCursor.ParentId = m.nObjectId ;
			INTO ARRAY aViewFields
	USE in GenViewCursor
	=WriteFile(m.hOutFile, "")
	=WriteFile(m.hOutFile, '		*!* Field Level Properties for ' + m.cViewName)

	IF _TALLY # 0
		FOR m.nLoop = 1 TO ALEN(aViewFields, 1)
			cFieldAlias = m.cViewName + "." + ALLTRIM(aViewFields(nLoop, 1))
			clKeyField = IIF(DBGetProp(m.cFieldAlias, 'Field', 'KeyField'),'.T.','.F.')
			clUpdatable = IIF(DBGetProp(m.cFieldAlias, 'Field', 'Updatable'),'.T.','.F.')
			ccUpdateName = ALLTRIM(DBGetProp(m.cFieldAlias, 'Field', 'UpdateName'))
			cViewFieldSetPrefix = [		=DBSetProp(']+m.cFieldAlias+[', 'Field', ]
			
			=WriteFile(m.hOutFile, '		* Props for the '+m.cFieldAlias+' field.')
			=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['KeyField', ] + m.clKeyField + [)])
			=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['Updatable', ] + m.clUpdatable + [)])
			=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['UpdateName', '] + m.ccUpdateName + [')])
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleExpression")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['RuleExpression', "]+m.cTemp+[")])
			ENDIF
			
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleText")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['RuleText', "]+m.cTemp+[")])
			ENDIF
			*-- SAS
			* cTemp = DBGETPROP(m.cFieldAlias, "Field", "Caption")
			cTemp = ALLTRIM(DBGETPROP(m.cFieldAlias, "Field", "Caption"))
			*-- SAS
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['Caption', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "Comment")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				*! Strip Line Feeds
				cTemp = STRTRAN(m.cTemp, CHR(10)) 
				*! Convert Carriage Returns To Programmatic Carriage Returns
				cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['Comment', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "InputMask")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['InputMask', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "Format")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['Format', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClass")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['DisplayClass', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClassLibrary")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['DisplayClassLibrary', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "DataType")
			IF !EMPTY(m.cTemp)
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['DataType', "] + m.cTemp + [")])
			ENDIF
			cTemp = DBGETPROP(m.cFieldAlias, "Field", "DefaultValue")
			IF !EMPTY(m.cTemp)
				cTemp = STRTRAN(m.cTemp, ["], ['])
				=WriteFile(m.hOutFile, m.cViewFieldSetPrefix + ['DefaultValue', "] + m.cTemp + [")])
			ENDIF
		ENDFOR
	ENDIF

	=WriteFile(m.hOutFile, "	ENDPROC")

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:
**
**      cConnectionName  A character string representing the name of the 
**                       existing connection
**
**      hOutFile         The handle of the output file
**
**      cProcPrefix      The code we prepend to the connection name to create
**                       the name of the procedure within which we wrap the
**                       code that recreates the connection
**
** 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)
**  1997.02.24  SEA      Output code within a PROCEDURE / ENDPROC block to
**                       avoid error when compiling procedures > 64K
**                       database re-creation program a procedure
**  1997.02.24  SEA      Write directly to a single output file, the handle 
**                       of which is passed in hOutFile
***************************************************************************************
PROCEDURE GetConn
	LPARAMETERS cConnectionName, hOutFile, cProcPrefix

	PRIVATE ALL EXCEPT g_*

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

	*! Generate Heading
	=WriteFile(m.hOutFile, "")
	=WriteFile(m.hOutFile, "	**************************************************")
	=WriteFile(m.hOutFile, "	** " + BEGIN_CONNECTIONS_LOC + " " + m.cConnectionName)
	=WriteFile(m.hOutFile, "	**************************************************")
	=WriteFile(m.hOutFile, "	PROCEDURE " + m.cProcPrefix + m.cConnectionName)

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

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

	=WriteFile(m.hOutFile, m.cCreateString)

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

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

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
			OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
			IF m.g_nTotal_Tables_Used > 0
				FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
					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

	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_*
	
	nStat = m.g_nCurrentStat * (160 / g_nMax)
	SET MESSAGE TO REPLICATE("|", m.nStat) + " " + ;
		ALLTRIM(STR(INT(100 * (m.g_nCurrentStat / m.g_nMax)))) + "%"
	g_nCurrentStat = m.g_nCurrentStat + 1
RETURN
1234

gendbcx.prg - 源码说明

本页面展示了「MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能」中的 gendbcx.prg 源码文件，采用 PRG 编程语言编写，共 1,475 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与MSComm相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?