scctext.prg

程序包 解压安装即可 很好用的 请大家放心用

*+--------------------------------------------------------------------------
*
*	File:		SCCTEXT.PRG
*
*	Copyright:	(c) 1995, Microsoft Corporation.
*				All Rights Reserved.
*
*	Contents:	Routines for creating text representations of .SCX, .VCX,
*				.MNX, .FRX, and .LBX files for the purpose of supporting
*				merge capabilities in source control systems.
*
*   Author:		Sherri Kennamer
*
*	Parameters:	cTableName	C	Fully-qualified name of the SCX/VCX/MNX/FRX/LBX
*				cType		C	Code indicating the file type
*								(See PRJTYPE_ constants, defined below)
*				cTextName	C	Fully-qualified name of the text file
*				lGenText	L	.T. Create a text file from the table
*								.F. Create a table from the text file
*
*	Returns:	0		File or table was successfully generated
*				-1		An error occurred
*
*	History:	17-Aug-95	sherrike	written
*				20-Nov-95	sherrike	use smart defaults for single filename
*				02-Dec-95	sherrike	return values for merge support
*
*---------------------------------------------------------------------------

#include "foxpro.h"

#define C_DEBUG .F.

* If merge support is 1 and C_WRITECHECKSUMS is .T., write a checksum (sys(2007)) instead of
* converting binary to ascii. This drastically improves performance because OLE controls can
* be large and time-consuming to convert.
#define C_WRITECHECKSUMS .T.

#define SCCTEXTVER_LOC "SCCTEXT Version 4.0.0.2"

#define ALERTTITLE_LOC "Microsoft Visual FoxPro"
#define ERRORTITLE_LOC "Program Error"
#define ERRORMESSAGE_LOC ;
	"Error #" + alltrim(str(m.nError)) + " in " + m.cMethod + ;
	" (" + alltrim(str(m.nLine)) + "): " + m.cMessage

#define ERR_FOXERROR_11_LOC "Function argument value, type, or count is invalid."
#define ERR_NOTABLE_LOC "A table name is required."
#define ERR_FILENOTFOUND_LOC "File not found: "
#define ERR_UNSUPPORTEDFILETYPE_LOC "File type not supported: "
#define ERR_BIN2TEXTNOTSUPPORTED_LOC "Text file generation not supported for type '&cType' files."
#define ERR_TEXT2BINNOTSUPPORTED_LOC "Binary file generation not supported for type '&cType' files."
#define ERR_UNSUPPORTEDFIELDTYPE_LOC "Field type not supported: "
#define ERR_INVALIDTEXTNAME_LOC "Invalid TEXTNAME parameter."
#define ERR_INVALIDREVERSE_LOC "Invalid REVERSE parameter."
#define ERR_NOTEXTFILE_LOC "Text file name is required to create a table."
#define ERR_FCREATE_LOC "FCREATE() error: "
#define ERR_FOPEN_LOC "FOPEN() error: "
#define ERR_FIELDLISTTOOLONG_LOC "Field list is too long."
#define ERR_BADVERSION_LOC "Bad SCCTEXT version."
#define ERR_LINENOACTION_LOC "No action was taken on line: "
#define ERR_ALERTCONTINUE_LOC "Continue?"
#define ERR_OVERWRITEREADONLY_LOC "File &cParameter1 is read-only. Overwrite it?"
#define ERR_MAXBINLEN_LOC "MAXBINLEN value must be a multiple of 8. Program aborted."

#define CRLF chr(13) + chr(10)
#define MAXBINLEN	96		&& this value must be a multiple of 8!!!

#define FILE_ATTRIBUTE_NORMAL	128

* Text file support for each file type
*	0 indicates no text file support
*	1 indicates one-way support (to text)
*	2 indicates two-way support (for merging)
#define SCC_FORM_SUPPORT	1
#define SCC_LABEL_SUPPORT	1
#define SCC_MENU_SUPPORT	1
#define SCC_REPORT_SUPPORT	1
#define SCC_VCX_SUPPORT		1
#define SCC_DBC_SUPPORT		0

* These are the extensions used for the text file
#define SCC_ASCII_FORM_EXT		"SCA"
#define SCC_ASCII_LABEL_EXT		"LBA"
#define SCC_ASCII_MENU_EXT		"MNA"
#define SCC_ASCII_REPORT_EXT	"FRA"
#define SCC_ASCII_VCX_EXT		"VCA"
#define SCC_ASCII_DBC_EXT		"DBA"

* These are the extensions used for the binary file
#define SCC_FORM_EXT		"SCX"
#define SCC_LABEL_EXT		"LBX"
#define SCC_MENU_EXT		"MNX"
#define SCC_REPORT_EXT		"FRX"
#define SCC_VCX_EXT			"VCX"
#define SCC_DBC_EXT			"DBC"

* These are the extensions used for the binary file
#define SCC_FORM_MEMO		"SCT"
#define SCC_LABEL_MEMO		"LBT"
#define SCC_MENU_MEMO		"MNT"
#define SCC_REPORT_MEMO		"FRT"
#define SCC_VCX_MEMO		"VCT"
#define SCC_DBC_MEMO		"DBT"

* These are the project type identifiers for the files
#define PRJTYPE_FORM		"K"
#define PRJTYPE_LABEL		"B"
#define PRJTYPE_MENU		"M"
#define PRJTYPE_REPORT		"R"
#define PRJTYPE_VCX			"V"
#define PRJTYPE_DBC			"d"

* These are the extensions used for table backups
#define SCC_FORM_TABLE_BAK		"SC1"
#define SCC_FORM_MEMO_BAK		"SC2"
#define SCC_LABEL_TABLE_BAK		"LB1"
#define SCC_LABEL_MEMO_BAK		"LB2"
#define SCC_MENU_TABLE_BAK		"MN1"
#define SCC_MENU_MEMO_BAK		"MN2"
#define SCC_REPORT_TABLE_BAK	"FR1"
#define SCC_REPORT_MEMO_BAK		"FR2"
#define SCC_VCX_TABLE_BAK		"VC1"
#define SCC_VCX_MEMO_BAK		"VC2"
#define SCC_DBC_TABLE_BAK		"DB1"
#define SCC_DBC_MEMO_BAK		"DB2"
#define SCC_DBC_INDEX_BAK		"DB3"

* These are the extensions used for text file backups
#define SCC_FORM_TEXT_BAK		"SCB"
#define SCC_LABEL_TEXT_BAK		"LBB"
#define SCC_MENU_TEXT_BAK		"MNB"
#define SCC_REPORT_TEXT_BAK		"FRB"
#define SCC_VCX_TEXT_BAK		"VCB"
#define SCC_DBC_TEXT_BAK		"DBB"

* These are used for building markers used to parse the text back into a table
#define MARKMEMOSTARTWORD	"[START "
#define MARKMEMOSTARTWORD2	"]"
#define MARKMEMOENDWORD		"[END "
#define MARKMEMOENDWORD2	"]"
#define MARKBINSTARTWORD	"[BINSTART "
#define MARKBINSTARTWORD2	"]"
#define MARKBINENDWORD		"[BINEND "
#define MARKBINENDWORD2		"]"
#define MARKFIELDSTART		"["
#define MARKFIELDEND		"] "
#define MARKEOF				"[EOF]"
#define MARKRECORDSTART		"["
#define MARKRECORDEND		" RECORD]"
#define MARKCHECKSUM		"CHECKSUM="

#define SKIPEMPTYFIELD		.T.

* These are used to override default behavior for specific fields
#define VCX_EXCLUDE_LIST		" OBJCODE TIMESTAMP "
#define VCX_MEMOASCHAR_LIST		" CLASS CLASSLOC BASECLASS OBJNAME PARENT "
#define VCX_MEMOASBIN_LIST		" OLE OLE2 "
#define VCX_CHARASBIN_LIST		""
#define VCX_MEMOVARIES_LIST		" RESERVED4 RESERVED5 "

#define FRX_EXCLUDE_LIST		" TIMESTAMP "
#define FRX_MEMOASCHAR_LIST		" NAME STYLE PICTURE ORDER FONTFACE "
#define FRX_MEMOASBIN_LIST		" TAG TAG2 "
#define FRX_CHARASBIN_LIST		""
#define FRX_MEMOVARIES_LIST		""

#define MNX_EXCLUDE_LIST		" TIMESTAMP "
#define MNX_MEMOASCHAR_LIST		" NAME PROMPT COMMAND MESSAGE KEYNAME KEYLABEL "
#define MNX_MEMOASBIN_LIST		""
#define MNX_CHARASBIN_LIST		" MARK "
#define MNX_MEMOVARIES_LIST		""

#define DBC_EXCLUDE_LIST		""
#define DBC_MEMOASCHAR_LIST		""
#define DBC_MEMOASBIN_LIST		""
#define DBC_CHARASBIN_LIST		""
#define DBC_MEMOVARIES_LIST		" PROPERTY CODE USER "

* Used by the thermometer
#define C_THERMLABEL_LOC		"Generating &cThermLabel"
#define C_THERMCOMPLETE_LOC		"Generate &cThermLabel complete!"
#DEFINE WIN32FONT				"MS Sans Serif"
#DEFINE WIN95FONT				"Arial"
#define C_BINARYCONVERSION_LOC	"Converting binary data: &cBinaryProgress.%"

parameters cTableName, cType, cTextName, lGenText
LOCAL iParmCount
iParmCount = parameters()

LOCAL  obj, iResult
m.iResult = -1
if m.iParmCount = 1 .and. type('m.cTableName') = 'C'
	* Check to see if we've been passed only a PRJTYPE value. If so, return a
	* value to indicate text support for the file type.
	*	0 indicates no text file support
	*	1 indicates one-way support (to text)
	*	2 indicates two-way support (for merging)
	*  -1 indicates m.cTableName is not a recognized file type
	m.iResult = TextSupport(m.cTableName)
endif
if m.iResult = -1 && .and. file(m.cTableName)
	m.obj = createobj("SccTextEngine", m.cTableName, m.cType, m.cTextName, m.lGenText, m.iParmCount)
	if type("m.obj") = "O" .and. .not. isnull(m.obj)
		obj.Process()
		if type("m.obj") = "O" .and. .not. isnull(m.obj)
			m.iResult = obj.iResult
		endif
	endif
	release m.obj
endif
return (m.iResult)

procedure TextSupport
	parameters cFileType
	do case
	* Check to see if we've been passed only a PRJTYPE value. If so, return a
	* value to indicate text support for the file type.
	*	0 indicates no text file support
	*	1 indicates one-way support (to text)
	*	2 indicates two-way support (for merging)
	case m.cFileType == PRJTYPE_FORM
		return SCC_FORM_SUPPORT
	case m.cFileType == PRJTYPE_LABEL
		return SCC_LABEL_SUPPORT
	case m.cFileType == PRJTYPE_MENU
		return SCC_MENU_SUPPORT
	case m.cFileType == PRJTYPE_REPORT
		return SCC_REPORT_SUPPORT
	case m.cFileType == PRJTYPE_VCX
		return SCC_VCX_SUPPORT
	case m.cFileType == PRJTYPE_DBC
		return SCC_DBC_SUPPORT
	otherwise
		return -1
	endcase
endproc

define class SccTextEngine as custom
	HadError = .f.
	iError = 0
	cMessage = ""
	SetErrorOff = .f.

	iResult = -1 && Fail
	cTableName = ""
	cMemoName = ""
	cIndexName = ""
	cTextName = ""
	
	lMadeBackup = .F.
	cTableBakName = ""
	cMemoBakName = ""
	cIndexBakName = ""
	cTextBakName = ""
	
	cVCXCursor = ""		&& If we're generating text for a .VCX, we create a temporary
						&& file with the classes sorted.
	
	cType = ""
	lGenText = .t.
	iHandle = -1
	dimension aEnvironment[1]
	
	oThermRef = ""
	
	procedure Init(cTableName, cType, cTextName, lGenText, iParmCount)
		local iAction
		
		if m.iParmCount = 1 .and. type('m.cTableName') = 'C'
			* Interpret the single parameter as a filename and be smart about defaults
			if this.IsBinary(m.cTableName)
				m.cType = this.GetPrjType(m.cTableName)
				m.cTextName = this.ForceExt(m.cTableName, this.GetAsciiExt(m.cType))
				m.lGenText = .t.
			else
				if this.IsAscii(m.cTableName)
					m.cType = this.GetPrjType(m.cTableName)
					m.cTextName = m.cTableName
					m.cTableName = this.ForceExt(m.cTextName, this.GetBinaryExt(m.cType))
					m.lGenText = .f.
				endif
			endif
		endif
		
		this.cTableName = m.cTableName
		this.cType = m.cType
		this.cTextName = m.cTextName
		this.lGenText = m.lGenText
		
		* Verify that we've got valid parameters
		if type('this.cTableName') <> 'C' .or. type('this.cType') <> 'C' ;
			.or. type('this.cTextName') <> 'C' .or. type('this.lGenText') <> 'L'
			this.Alert(ERR_FOXERROR_11_LOC)
			return .f.
		endif
		
		* REC00XYS Verify parameters before calling this.ForceExt
		this.cMemoName = this.ForceExt(this.cTableName, this.GetBinaryMemo(this.cType))

		* Verify that we support the requested action
		m.iAction = iif(m.lGenText, 1, 2)
		do case
		case m.cType == PRJTYPE_FORM .and. SCC_FORM_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		case m.cType == PRJTYPE_LABEL .and. SCC_LABEL_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		case m.cType == PRJTYPE_MENU .and. SCC_MENU_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		case m.cType == PRJTYPE_REPORT .and. SCC_REPORT_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		case m.cType == PRJTYPE_VCX .and. SCC_VCX_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		case m.cType == PRJTYPE_DBC .and. SCC_DBC_SUPPORT < m.iAction
			m.iAction = m.iAction * -1
		endcase

		if m.iAction = -1
			this.Alert(ERR_BIN2TEXTNOTSUPPORTED_LOC)
			return .f.
		endif
		if m.iAction = -2
			this.Alert(ERR_TEXT2BINNOTSUPPORTED_LOC)
			return .f.
		endif
			
		if .not. this.Setup()
			return .f.
		endif
		
		if (MAXBINLEN % 8 <> 0)
			this.Alert(ERR_MAXBINLEN_LOC)
			return .f.
		endif
	endproc

	procedure Erase
		parameters cFilename
		if !empty(m.cFilename) .and. file(m.cFilename)
			=SetFileAttributes(m.cFilename, FILE_ATTRIBUTE_NORMAL)
			erase (m.cFilename)
		endif
	endproc
	
	procedure MakeBackup
		* Fill in the names of the backup files
		do case
		case this.cType = PRJTYPE_FORM
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_FORM_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_FORM_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_FORM_MEMO_BAK)
		case this.cType = PRJTYPE_REPORT
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_REPORT_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_REPORT_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_REPORT_MEMO_BAK)
		case this.cType = PRJTYPE_VCX
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_VCX_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_VCX_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_VCX_MEMO_BAK)
		case this.cType = PRJTYPE_MENU
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_MENU_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_MENU_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_MENU_MEMO_BAK)
		case this.cType = PRJTYPE_LABEL
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_LABEL_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_LABEL_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_LABEL_MEMO_BAK)
		case this.cType = PRJTYPE_DBC
			this.cTextBakName = this.ForceExt(this.cTextName, SCC_DBC_TEXT_BAK)
			this.cTableBakName = this.ForceExt(this.cTableName, SCC_DBC_TABLE_BAK)
			this.cMemoBakName = this.ForceExt(this.cMemoName, SCC_DBC_MEMO_BAK)
			this.cIndexBakName = this.ForceExt(this.cIndexName, SCC_DBC_INDEX_BAK)
		endcase
		
		* Delete any existing backup
		this.DeleteBackup()
		
		* Create new backup files
		if this.lGenText
			if file(this.cTextName)
				copy file (this.cTextName) to (this.cTextBakName)
			endif
		else
			if file(this.cTableName) .and. file(this.cMemoName)
				copy file (this.cTableName) to (this.cTableBakName)
				copy file (this.cMemoName) to (this.cMemoBakName)
				if !empty(this.cIndexName) .and. file(this.cIndexName)
					copy file (this.cIndexName) to (this.cIndexBakName)
				endif
			endif
		endif

		this.lMadeBackup = .T.
	endproc
	
	procedure RestoreBackup
		if this.lGenText
			this.Erase(this.cTextName)
		else
			this.Erase(this.cTableName)
			this.Erase(this.cMemoName)
			if .not. empty(this.cIndexName)
				this.Erase(this.cIndexName)
			endif
		endif
		
		if this.lGenText
			if file(this.cTextBakName)
				copy file (this.cTextBakName) to (this.cTextName)
			endif
		else
			if file(this.cTableBakName) .and. file(this.cMemoBakName)
				copy file (this.cTableBakName) to (this.cTableName)
				copy file (this.cMemoBakName) to (this.cMemoName)
				if !empty(this.cIndexBakName) .and. file(this.cIndexBakName)
					copy file (this.cIndexBakName) to (this.cIndexName)
				endif
			endif
		endif
	endproc
	
	procedure DeleteBackup
		if this.lGenText
			this.Erase(this.cTextBakName)
		else
			this.Erase(this.cTableBakName)
			this.Erase(this.cMemoBakName)
			if !empty(this.cIndexBakName)
				this.Erase(this.cIndexBakName)
			endif
		endif
	endproc
	
	procedure GetAsciiExt
		parameters cType
		do case
		case m.cType = PRJTYPE_FORM
			return SCC_ASCII_FORM_EXT
		case m.cType = PRJTYPE_REPORT
			return SCC_ASCII_REPORT_EXT
		case m.cType = PRJTYPE_VCX
			return SCC_ASCII_VCX_EXT
		case m.cType = PRJTYPE_MENU
			return SCC_ASCII_MENU_EXT
		case m.cType = PRJTYPE_LABEL
			return SCC_ASCII_LABEL_EXT
		case m.cType = PRJTYPE_DBC
			return SCC_ASCII_DBC_EXT
		endcase
	endproc
	
	procedure GetBinaryExt
		parameters cType
		do case
		case m.cType = PRJTYPE_FORM
			return SCC_FORM_EXT
		case m.cType = PRJTYPE_REPORT
			return SCC_REPORT_EXT
		case m.cType = PRJTYPE_VCX
			return SCC_VCX_EXT
		case m.cType = PRJTYPE_MENU
			return SCC_MENU_EXT
		case m.cType = PRJTYPE_LABEL
			return SCC_LABEL_EXT
		case m.cType = PRJTYPE_DBC
			return SCC_DBC_EXT
		endcase
	endproc
	
	procedure GetBinaryMemo
		parameters cType
		do case
		case m.cType = PRJTYPE_FORM
			return SCC_FORM_MEMO
		case m.cType = PRJTYPE_REPORT
			return SCC_REPORT_MEMO
		case m.cType = PRJTYPE_VCX
			return SCC_VCX_MEMO
		case m.cType = PRJTYPE_MENU
			return SCC_MENU_MEMO
		case m.cType = PRJTYPE_LABEL
			return SCC_LABEL_MEMO
		case m.cType = PRJTYPE_DBC
			return SCC_DBC_MEMO
		endcase
	endproc
	
	procedure GetPrjType
		parameters cFileName
		local m.cExt
		m.cExt = upper(this.JustExt(m.cFileName))
		do case
		case inlist(m.cExt, SCC_ASCII_FORM_EXT, SCC_FORM_EXT)
			return PRJTYPE_FORM
		case inlist(m.cExt, SCC_ASCII_REPORT_EXT, SCC_REPORT_EXT)
			return PRJTYPE_REPORT
		case inlist(m.cExt, SCC_ASCII_VCX_EXT, SCC_VCX_EXT)
			return PRJTYPE_VCX
		case inlist(m.cExt, SCC_ASCII_MENU_EXT, SCC_MENU_EXT)
			return PRJTYPE_MENU
		case inlist(m.cExt, SCC_ASCII_LABEL_EXT, SCC_LABEL_EXT)
			return PRJTYPE_LABEL
		case inlist(m.cExt, SCC_ASCII_DBC_EXT, SCC_DBC_EXT)
			return PRJTYPE_DBC
		otherwise
			return ''
		endcase
	endproc
	
	procedure IsAscii
		parameters cFileName
		local m.cExt
		m.cExt = upper(this.JustExt(m.cFileName))
		return inlist(m.cExt, SCC_ASCII_FORM_EXT, SCC_ASCII_REPORT_EXT, SCC_ASCII_VCX_EXT, ;
			SCC_ASCII_MENU_EXT, SCC_ASCII_LABEL_EXT, SCC_ASCII_DBC_EXT)
	endproc
	
	procedure IsBinary
		parameters cFileName
		local m.cExt
		m.cExt = upper(this.JustExt(m.cFileName))
		return inlist(m.cExt, SCC_FORM_EXT, SCC_REPORT_EXT, SCC_VCX_EXT, ;
			SCC_MENU_EXT, SCC_LABEL_EXT, SCC_DBC_EXT)
	endproc
	
	procedure Setup
		
		dimension this.aEnvironment[5]
		
		this.aEnvironment[1] = set("deleted")
		this.aEnvironment[2] = select()
		this.aEnvironment[3] = set("safety")