I needed to rename a field in a foxpro table programatically and without touching the data. I wrote the following code which modifies the header information.
Disclaimer: Back up your data! This code uses low-level functions to manipulate the database header. I can't accept any responsibility for damage to your data.
CLOSE ALL
jcDBFName = 'enter path and filename of dbf file here (including .DBF)'
jcOldVal = 'enter old field name here (max 10 chars)'
jcNewVal = 'enter new Field name here(max 10 chars)'
jnRetVal = changeFld(dbfName, jcOldVal, jcNewVal)
do case
case jnRetVal = -1
jcMessage = 'Incorrect number of parameters passed'
case jnRetVal = -2
jcMessage = 'Could not open or create output file'
case jnRetVal = -3
jcMessage = 'Field not found'
case jnRetVal > 0
jcMessage = alltrim(str(jnRetVal)) + ' bytes replaced successfully'
otherwise
jcMessage = 'Unknown error returned.'
endcase
wait window jcMessage
********************************************************
FUNCTION ChangeFld
********************************************************
*
* Written by: Nick G - September 2004
*
* Parameters: DBF Name (full path and filename)
* Old Field Name (character)
* New Field Name (character)
* Returns: number of bytes written, or
* negative error value
*
********************************************************
FUNCTION changeFld
PARAMETERS dbfname, jcOldVal, jcNewVal
IF EMPTY(dbfname) OR EMPTY(jcOldVal) OR EMPTY(jcNewVal)
RETURN -1
ELSE
fh = FOPEN(dbfname,12)
ENDIF
IF fh < 0
WAIT 'Cannot open or create output file' WINDOW NOWAIT
RETURN -2
ELSE
* Locate the offset position of the start of the data itself
=FSEEK(fh, 8,0)
jcdataoff = FREAD(fh, 2)
jcoffset = dec2hex(ASC(RIGHT(jcdataoff, 1))) + dec2hex(ASC(LEFT(jcdataoff, 1)))
jnoffset = hex2dec(ALLTRIM(STR(VAL(jcoffset))))
* Scan through Fields until match found, then replace it with new value
FOR mvcount = 32 TO (jnoffset-33) STEP 32
=FSEEK(fh, mvcount, 0)
jcField = ALLTRIM(STRTRAN(FREAD(fh, 11), CHR(0), ''))
* wait window jcField
IF ALLTRIM(UPPER(jcField)) == ALLTRIM(UPPER(jcOldVal))
* Field found, replace it with 'jcNewVal'
=FSEEK(fh, mvcount, 0)
lnBytes=FWRITE(fh, STRTRAN(PADR(jcNewVal, 10), ' ', CHR(0)))
=FCLOSE(fh)
RETURN lnBytes
ENDIF
ENDFOR
ENDIF
RETURN -3
********************************************************
FUNCTION dec2hex
********************************************************
*
* Written by: Ralph P. Morse Jr. (c) 1995
* RalphMorse@msn.com
*
* Parameter: Numeric Input From 0 To 255
*
* Returns: Character string from "00" to "FF"
*
********************************************************
PARAMETER pminput
PRIVATE jcbit1, jcbit2
STORE INT(pminput/16) TO jcbit1
STORE pminput - (jcbit1 * 16) TO jcbit2
RETURN CHR(IIF(jcbit1 > 9, 55, 48) + jcbit1) + ;
CHR(IIF(jcbit2 > 9, 55, 48) + jcbit2)
********************************************************
FUNCTION hex2dec
********************************************************
*
* Written by: Ralph P. Morse Jr. (c) 1995
* RalphMorse@msn.com
*
* Parameter: Character string from "00" to "FF"
*
* Returns: Numeric value (0-255)
*
********************************************************
PARAMETER pchexcode
PRIVATE jchex1, jchex2
STORE ASC(UPPER(SUBSTR(pchexcode, 1, 1))) TO jchex1
STORE ASC(UPPER(SUBSTR(pchexcode, 2, 1))) TO jchex2
STORE jchex1 - IIF(jchex1 > 60, 55, 48) TO jchex1
STORE jchex2 - IIF(jchex2 > 60, 55, 48) TO jchex2
RETURN jchex1 * 16 + jchex2
Disclaimer: Back up your data! This code uses low-level functions to manipulate the database header. I can't accept any responsibility for damage to your data.
CLOSE ALL
jcDBFName = 'enter path and filename of dbf file here (including .DBF)'
jcOldVal = 'enter old field name here (max 10 chars)'
jcNewVal = 'enter new Field name here(max 10 chars)'
jnRetVal = changeFld(dbfName, jcOldVal, jcNewVal)
do case
case jnRetVal = -1
jcMessage = 'Incorrect number of parameters passed'
case jnRetVal = -2
jcMessage = 'Could not open or create output file'
case jnRetVal = -3
jcMessage = 'Field not found'
case jnRetVal > 0
jcMessage = alltrim(str(jnRetVal)) + ' bytes replaced successfully'
otherwise
jcMessage = 'Unknown error returned.'
endcase
wait window jcMessage
********************************************************
FUNCTION ChangeFld
********************************************************
*
* Written by: Nick G - September 2004
*
* Parameters: DBF Name (full path and filename)
* Old Field Name (character)
* New Field Name (character)
* Returns: number of bytes written, or
* negative error value
*
********************************************************
FUNCTION changeFld
PARAMETERS dbfname, jcOldVal, jcNewVal
IF EMPTY(dbfname) OR EMPTY(jcOldVal) OR EMPTY(jcNewVal)
RETURN -1
ELSE
fh = FOPEN(dbfname,12)
ENDIF
IF fh < 0
WAIT 'Cannot open or create output file' WINDOW NOWAIT
RETURN -2
ELSE
* Locate the offset position of the start of the data itself
=FSEEK(fh, 8,0)
jcdataoff = FREAD(fh, 2)
jcoffset = dec2hex(ASC(RIGHT(jcdataoff, 1))) + dec2hex(ASC(LEFT(jcdataoff, 1)))
jnoffset = hex2dec(ALLTRIM(STR(VAL(jcoffset))))
* Scan through Fields until match found, then replace it with new value
FOR mvcount = 32 TO (jnoffset-33) STEP 32
=FSEEK(fh, mvcount, 0)
jcField = ALLTRIM(STRTRAN(FREAD(fh, 11), CHR(0), ''))
* wait window jcField
IF ALLTRIM(UPPER(jcField)) == ALLTRIM(UPPER(jcOldVal))
* Field found, replace it with 'jcNewVal'
=FSEEK(fh, mvcount, 0)
lnBytes=FWRITE(fh, STRTRAN(PADR(jcNewVal, 10), ' ', CHR(0)))
=FCLOSE(fh)
RETURN lnBytes
ENDIF
ENDFOR
ENDIF
RETURN -3
********************************************************
FUNCTION dec2hex
********************************************************
*
* Written by: Ralph P. Morse Jr. (c) 1995
* RalphMorse@msn.com
*
* Parameter: Numeric Input From 0 To 255
*
* Returns: Character string from "00" to "FF"
*
********************************************************
PARAMETER pminput
PRIVATE jcbit1, jcbit2
STORE INT(pminput/16) TO jcbit1
STORE pminput - (jcbit1 * 16) TO jcbit2
RETURN CHR(IIF(jcbit1 > 9, 55, 48) + jcbit1) + ;
CHR(IIF(jcbit2 > 9, 55, 48) + jcbit2)
********************************************************
FUNCTION hex2dec
********************************************************
*
* Written by: Ralph P. Morse Jr. (c) 1995
* RalphMorse@msn.com
*
* Parameter: Character string from "00" to "FF"
*
* Returns: Numeric value (0-255)
*
********************************************************
PARAMETER pchexcode
PRIVATE jchex1, jchex2
STORE ASC(UPPER(SUBSTR(pchexcode, 1, 1))) TO jchex1
STORE ASC(UPPER(SUBSTR(pchexcode, 2, 1))) TO jchex2
STORE jchex1 - IIF(jchex1 > 60, 55, 48) TO jchex1
STORE jchex2 - IIF(jchex2 > 60, 55, 48) TO jchex2
RETURN jchex1 * 16 + jchex2