Category : Files from Magazines
Archive   : DBMS0291.ZIP
Filename : FOXPRO1.FEB

 
Output of file : FOXPRO1.FEB contained in archive : DBMS0291.ZIP


************************************************************
* Program ...: FixDBT.prg
* Author ....: P. L. Olympia, Platinum Software Int'l
* Purpose....: Converts a Clipper memo file to FoxPro by
* : (1) Replacing CHR(141) with space
* : (2) Packing the file by removing blank data
* Notes .....: This generic FoxPro program will convert all
* : memo fields in the file. Uses FoxPro
* : low-level file I/O and indirect file ref.
************************************************************

SET TALK OFF
SET SAFE OFF
CLEA ALL
CLOS ALL

PrimName = SPAC(25)
CLEA
TEXT

CONVERT CLIPPER MEMO FILE TO FOXPRO

This program converts all soft returns to spaces in Clipper
memo fields so that FoxPro does not delete them and cause
words from two successive lines to run into each other.

At the prompt below, supply the name of the Clipper .dbt
file to be converted. This file will be renamed with the
extension of .old. You may supply a fully qualified name
including path but do NOT include the .dbt extension
(Example: C:\APERS\PE).

ENDT
@ 20, 0 SAY "Name of .dbt file to convert" GET PrimName
READ

PrimName = ALLTRIM(PrimName)
IF AT(".", PrimName) = 0
new_dbt = PrimName + ".DBT"
ELSE && just in case jokers added the extension anyway
new_dbt = PrimName
PrimName = STUFF(PrimName, AT(".",PrimName), 4, "")
ENDIF

* old_dbt = STUFF(new_dbt, AT(".",new_dbt)+1, 3, "OLD")
old_dbt = PrimName + ".OLD"
bytesize = 2000
bytew = 0

IF FILE(old_dbt)
COPY FILE (new_dbt) TO (old_dbt)
ELSE
RENAME (new_dbt) TO (old_dbt)
ENDIF

CLEA
fh_in = FOPEN(old_dbt)
IF fh_in < 0
? CHR(7), old_dbt, " cannot be opened. Aborting."
RETU
ENDIF

fh_out = FCREATE(new_dbt)

str = FREAD(fh_in, 512) && read & write header
byte = FWRITE(fh_out, str)

DO WHILE !FEOF(fh_in)
str = FREAD(fh_in, bytesize)
oldstr = SUBS(str,1, 512)
str = STRTRAN(str, CHR(141), CHR(32)) && repl soft retn
byte = FWRITE(fh_out, str)
IF byte = 0
? CHR(7), "Error writing to ", new_dbt
ENDIF
bytew = bytew + byte
@ 10, 10 SAY "Bytes written thus far"
@ 10, 40 SAY bytew
ENDDO

***** PART 2 *****

*-- Next, replace all memo field values which are just
*-- whitespace with nulls. Need to cycle thru all memo
*-- fields in the file

CLEA
CLOSE ALL

* Get rid of any existing .fpt file
str = PrimName + ".FPT"
IF FILE(str)
DELE FILE (str)
ENDIF

USE (PrimName) in 1
COPY STRU EXTE TO $temp
SELE 2
USE $temp && in 2

@ 10, 0 SAY "Getting rid of blank memo field data ..."
* Look for all memo fields and replace with nulls
SCAN
IF field_type = "M"
mf = field_name
SELE 1
REPL ALL &mf WITH "" FOR LEN(TRIM(&mf)) = 0
ENDIF
SELE 2
ENDSCAN
USE IN 2

CLEA
@ 10, 0 SAY "File cleanup in progress ..."
* Now we need to copy the file to purge all the nulls
SELE 1
COPY TO $temp
CLOSE ALL

IF .f.
DELE FILE (new_dbt)
new_dbt = PrimName + ".FPT"
COPY FILE $temp.fpt TO (new_dbt)
DELE FILE $temp.dbf
DELE FILE $temp.fpt
ENDIF

str = PrimName + ".DBF"
DELE FILE (str)
RENAME $temp.dbf TO (str)
new_dbt = PrimName + ".FPT"
RENAME $temp.fpt TO (new_dbt)
CLEA

* Ending stuff
CLOSE ALL
SET TALK ON
SET SAFE ON
RETU
*-- eof, FixDbt.Prg