Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Utility to copy DBFs from one DBC to another DBC

Databases and tables

Utility to copy DBFs from one DBC to another DBC

by  ramani  Posted    (Edited  )
*********************************************************
** VFP-6 utilities (see no warranty at bottom)
** Author : Subramanian.G
** E-mail: ramani_g@yahoo.com
**
** Used at development time to copy DATABASE files from
** one project to another project
** specify FROM DBC & TO DBC with full path
*********************************************************
** Method to operate...........
** Keep this routine in the project directory as "CopyDbf.prg"
** From the command window issue DO CopyDbf
**
** I had kept the collection of all my utils in a Prcedural file
** and used to call it from that collection.
*********************************************************

** PROCEDURE gs_CopyDBF

DEFINE WINDOW MYWINDOW FROM 5,0 TO 20,80 COLOR SCHEME 5
ACTIVATE WINDOW MYWINDOW

STORE SPACE(40) TO tFromDBC, tToDBC, tDBFname && suitably increase size to your needs

@ 2,5 SAY "Select Source DBC with full path : " Get tFromDBC
@ 4,5 SAY "Select Destination DBC with path : " Get tToDBC
@ 6,5 SAY "Select Source DBF Database name : " Get tDBFname

READ

IF EMPTY(tFromdbc) .OR. EMPTY(tToDBC) .OR. EMPTY(tDBFname)
DEACTIVATE WINDOW MYWINDOW
RETURN
ENDIF
tFromDBC = ALLT(tFromDBC)
tToDBC = ALLT(tToDBC)
tDBFname = ALLT(tDBFname)

CLOSE DATABASES ALL

LOCAL lnObjectId, lnNewId, lnParentId, lcFromDBF, lcToDBF

lcFromDBF = JUSTPATH(tFromDBC)+"\"+tDBFname+".*"
lcToDBF = JUSTPATH(tToDBC)+"\"+tDBFname+".*"

RUN COPY &lcFromDBF &lcToDBF

USE (tToDBC+".DBC") IN 1 ALIAS new
SELECT new
PACK
GO BOTTOM
lnNewId = RECCOUNT()+1
lnParentId = lnNewId

USE (tFromDBC+".DBC") IN 2 ALIAS old
SELECT old
PACK
LOCATE FOR ALLTRIM(UPPER(OBJECTNAME)) == ALLTRIM(UPPER(tDBFNAME))
lnObjectId = ObjectId
SCATTER MEMVAR MEMO
m.ObjectId = lnNewId
SELECT new
APPEND BLANK
GATHER MEMVAR MEMO

SELECT old
SCAN FOR ParentId = lnObjectId
SCATTER MEMVAR MEMO
lnNewId = lnNewId+1
m.ObjectId = lnNewId
m.ParentId = lnParentId

SELECT new
APPEND BLANK
GATHER MEMVAR MEMO
SELECT old
ENDSCAN
CLOSE DATABASES ALL

DEACTIVATE WINDOW MYWINDOW

RETURN

** ENDPROC
*********************************************************
** End
*********************************************************
** NO IMPLIED OR EXPLICITY WARRANTY FOR ABOVE.
** USE TO YOUR CONVENIENCE
** DISTRIBUTE WITH THIS NOTE and in complete.
** Any modification, if you feel, is useful for community,
** please be kind to e-mail me - ramani_g@yahoo.com
*********************************************************

- Ramani
Subramanian.G, FoxAcc Software, (ramani_g@yahoo.com)
********************************************************
Evaluate this to make others know how useful is this :)


Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top