Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Unload/Reload
Message
From
23/07/2002 09:26:58
Hilmar Zonneveld
Independent Consultant
Cochabamba, Bolivia
 
General information
Forum:
Visual FoxPro
Category:
Databases,Tables, Views, Indexing and SQL syntax
Title:
Miscellaneous
Thread ID:
00681531
Message ID:
00681595
Views:
21
>Muito obrigado....

O seguinte programa é o que uso. Vocé terá que fazer algums cambios.

As partes com "vfx" sao da libreria de classes, que eu nao posso incluir aqui.

Hilmar.
* Update the structure of a local database,
* based on the official, empty, database

lParameters tlRealData

#DEFINE DIR_BACKUP		"c:\DataBackup\"
#DEFINE TEMPDIR			"c:\TempData\"
#DEFINE FORCEUPDATE		.F.

local lcEmptyStructure, lcTargetDatabase
lcEmptyStructure = "c:\proyectos\produccion\EmptyStructure\"
lcTargetDatabase = iif(tlRealData, "\\manaco-ibm\pcp\data\", "c:\proyectos\produccion\data\")

UpdateDatabase(lcEmptyStructure, lcTargetDatabase, tlRealData)	&& call main program

cd c:\proyectos\produccion	&& My working folder



FUNCTION UpdateDatabase(tcEmptyStructure, tcTargetDatabase, tlDoBackup)
	if parameters() < 3
		tlDoBackup = .T.	&& assign default
	endif

	* Initialization
	set deleted on
	set safety off
	close databases all
	set talk off
	set procedure to c:\proyectos\produccion\program\vfxfunc additive	&& for vfx_needupdate()
	clear	&& For showing messages on main screen
	if FORCEUPDATE
		? "FORCED UPDATE. ALL TABLES WILL BE UPDATED."
	endif
	* clear all

	* Don't register auditing information (when appending records)
	private pldoaudit
	pldoaudit = .F.

	* Copy data to backup dir
	if tlDoBackup
		? time(), "Copying files to backup folder"
		if not directory(DIR_BACKUP)
			md (DIR_BACKUP)
		endif
		erase (DIR_BACKUP + "*.*")
		copy file (tcTargetDatabase + "*.*") to (DIR_BACKUP + "*.*")
	endif

	* Copy empty structure to temp data
	? time(), "Copying empty structure to " + TEMPDIR
	if not directory(TEMPDIR)
		md TEMPDIR
	endif
	erase (TEMPDIR + "*.*")
	copy file (tcEmptyStructure + "*.*") to (TEMPDIR + "*.*")

	* Create list of tables to be copied
	? time(), "Creating list of tables"
	local array laTables(1,1)
	adir(laTables, tcEmptyStructure + "*.dbf")
	create table TempTableList (table C(30))
	append from array laTables
	replace all table with juststem(table)	&& get rid of extension

#IF .F.
	* Relations no longer required, with TaxRI
	* Create list of relations, for checking order of table copy
	? time(), "Creating list of relations"
	open database tcEmptyStructure + "database"
	local array laRelations(1,1)
	adbobjects(laRelations, "relation")
	create table TempRelations free (child C(30), parent C(30), childtag C(10), parenttag C(10), ri C(10))
	append from array laRelations
	* If a relation doesn't "Restrict" child inserts, it causes no problem.
	* (or, if you use TaxRI, "Allow blanks")
	delete for not substr(ri,3,1) $ "RA"
	index on child tag child
	index on parent tag parent
	close database
#ENDIF

	* Append modified tables; erase others (no need to overwrite non-modified files
	*   back to target data)
	set talk on
	? time(), "Combining data with updated structure"
	local lnNeedUpdate
	local llTablesProcessed
	llTablesProcessed = .T.
	do while llTablesProcessed
		select TempTableList
		llTablesProcessed = .F.
		scan && in TempTableList
			wait window nowait "Searching for next table to copy"
			llTablesProcessed = .T.	&& there still is at least one table in TempTableList
			lcTable = alltrim(TempTableList.table)
			#IF .F.
			select TempRelations
			set order to "child"
			if seek(padr(lcTable, len(child)))
				* Table depends on un-copied parents. Try to copy next table.
				select TempTableList
				loop
			endif
			#ENDIF
			lnNeedUpdate = vfx_needupdate(lcTable + ".dbf", TEMPDIR, tcTargetDatabase)
			if lnNeedUpdate > 0
				? time(), "Table:", padr(lcTable,30, " ."), " "
			endif
			do case
			case lnNeedUpdate = 0 and not FORCEUPDATE	&& no update needed (OS-level copy)
				* ?? "Structure didn't change."
				wait window nowait "Erasing temporary table " + lcTable
				erase (TEMPDIR + lcTable + ".*")
			case lnNeedUpdate = 1 or (lnNeedUpdate = 0 and FORCEUPDATE)	&& need update
				if lnNeedUpdate = 1
					?? "There are changes. Transferring data."
				else
					?? "No changes. Forced update."
				endif
				wait window nowait "Updating table " + lcTable
				select 0
				use (TEMPDIR + lcTable)
				* Disable RI. Assumes TaxRI is installed.
				private _RiMode, _DisableRi
				_RiMode = 0 && None
				_DisableRi = "Ins_" + lcTable  && Disable "Insert" trigger for specified table
				append from (tcTargetDatabase + lcTable)
				use
			case lnNeedUpdate = 2	&& new table
				?? "New table."
				* No additional action is required.
			endcase
			#IF .F.
			select TempRelations
			set order to "parent"
			delete for parent = padr(lcTable, len(parent))
			#ENDIF
			select TempTableList
			delete	&& table has been processed.
		endscan
	enddo

	set talk off
	? time(), "Moving to final destination."

	close database all

	erase TempTableList.*
	erase TempRelations.*

	* Move temp to target data
	* Moving is much faster than copying, if moving occurs on the same disk
	local lnFileCount
	local array laFiles(1,1)
	for lnFileCount = 1 to adir(laFiles, TEMPDIR + "*.*")
		erase (tcTargetDatabase + laFiles(lnFileCount, 1))
		rename (TEMPDIR + laFiles(lnFileCount, 1)) to (tcTargetDatabase + laFiles(lnFileCount, 1))
	next
	? time(), "Done."


	* Cleanup
	rd TEMPDIR
	set safety on
	wait clear
	?? chr(7)
ENDFUNC
Difference in opinions hath cost many millions of lives: for instance, whether flesh be bread, or bread be flesh; whether whistling be a vice or a virtue; whether it be better to kiss a post, or throw it into the fire... (from Gulliver's Travels)
Previous
Reply
Map
View

Click here to load this message in the networking platform