Getting Started with X# -- Converting a VFP Application or DLL

[Jeff Stone]

Hi Robert,

The SET ORDER command does not use the &lfieldname syntax. Instead it is simply: SET ORDER TO TAG pmt_cntrct

FWIW, I am trying to convert a VFP .DLL that was written years ago and is called by both various C programs and Excel macros to enable access to DBF files. Since VFP was 32bits and we are moving to a 64bit world, I am hoping to have X# create a working 64bit .DLL. (I was able to create a 64bit .DLL with Harbour. But, Harbour doesn't support .DBC files, so that .DLL lacked needed functionality.) I've pasted the code below, if anyone cares.

Thanks again for the assistance.

Regards,

Jeff

Code: Select all

#command DELETE FILE <(filename)> => System.IO.File.Delete(<(filename)>)
#command RENAME <(filename1)> TO <(filename2)> => FRENAME(<(filename1)>, <(filename2)>) 

*********************************************************
DEFINE CLASS fpimport AS Relation OLEPUBLIC

TAXDIR = ""
TEMPLTDIR = ""
cCurrentPath = ""
mTOTCAPPMT = 0
mNETCAPPMT = 0
mEXSCAPPMT = 0
**mErrorRptd = 0

FUNCTION setcentury
  set century on    &&just AS a precaution
  && need TO set exact on --- not sure why we never turned it on before, but seeks won't work correctly - AS 5/29/15
  set exact on
ENDFUNC

FUNCTION initdirs
  THIS.TAXDIR = gete("TAXDIR")
  THIS.TEMPLTDIR = gete("TEMPLTDIR")
  IF Len(RTrim(THIS.TEMPLTDIR)) = 0
    THIS.TEMPLTDIR = "D:\TEMPLATE\"   &&FOR jeff
  ENDIF
  IF Len(RTrim(THIS.TAXDIR)) < 5
    THIS.TAXDIR = "E:\BONY\"
  ENDIF
ENDFUNC


FUNCTION setcurrentpath(lcPath)
lcOldPath = SYS(5) + CurDir()
IF !Empty(lcPath)
   cd (lcPath)
   THIS.cCurrentPath = SYS(5) + CurDir()
ELSE
   THIS.cCurrentPath = lcOldPath
ENDIF
RETURN lcOldPath
ENDFUNC

FUNCTION usefile(lcname, laliasname)
&&messagebox("0 use file "+lcname)
IF !File(lcname)
 RETURN 'N'
ENDIF
select 0
***check structure of template to make sure selected file is up-to-date
filetype = Right(lcname,3)
templtfl = THIS.TEMPLTDIR+filetype+"_flds"
use (templtfl)
sum field_len TO xrecsize
xrecsize = xrecsize + 1    &&add 1 FOR mark FOR deletion FIELD
use (lcname) Alias (laliasname)

IF Type("clsg_delay") # "U"  &&The FIELD exists AND the file already holds a good value FOR clsg_delay
  good_clsg_delay = .T.      &&We have TO DO THIS because WHEN the delay_mths go down TO zero, the value of clsg_delay will
ELSE                         &&be reset TO 0 AND that IS bad.  We will populate the clsg_delay only the first time we update it
  good_clsg_delay = .F.
ENDIF

IF (good_clsg_delay = .T.)
  sum clsg_delay TO x
  sum delay_mths TO y FOR (Upper(coll_type)!='D' .or. io_dlymths > 0)
  IF (x = 0 .and. y > 0)
    good_clsg_delay = .F. && IF (x) all of them are 0 AND (y) they should not be, it could be a fresh file
  ENDIF
  go top
ENDIF

IF RecSize() <> xrecsize .or. (good_clsg_delay = .F. .and. upper(filetype) = "CLD") &&update file format IF necessary
  copy TO temp
  &&use (templtfl)
  &&copy STRUCT TO (lcname)
  create (lcname) FROM (templtfl)   && changed THIS since it didn't seem to be working correctly with the fpt file
  &&messagebox("1 Updating file structure for "+lcname)

  IF File(lcname+".dbf")  && add on 8/6/07 FOR USB bad file creation problem --- AS
    use
    delete File &lcname
    rename (lcname+".dbf") TO (lcname)
  ENDIF

  use (lcname) Alias (laliasname)
  append FROM temp
  go top

  IF (good_clsg_delay = .F.)
    IF Upper(filetype) = "CLD" &&added 3/18/05 JAS
     locate FOR clsg_delay = 0
     &&messagebox("2 Updating file structure for "+lcname)
     IF .not. eof()
       IF Upper(SubStr(lcname,6,3)) # 'CLS'
         dealage = Val(SubStr(lcname,6,3))
       ELSE
         dealage = 0
       ENDIF
       **zzzreplace all clsg_delay WITH iif((Upper(coll_type)!='D' .or. io_dlymths > 0) .and. delay_mths > 0, delay_mths + dealage, 0)
       replace clsg_delay WITH iif((Upper(coll_type)!='D' .or. io_dlymths > 0) .and. delay_mths > 0, delay_mths + dealage, 0) all
     ENDIF
    ENDIF
    go top
  ENDIF
  use (lcname) Alias (laliasname)
  delete file temp.dbf
ENDIF
RETURN 'Y'
ENDFUNC


****this function is not used by the C programs
FUNCTION usefile1(lcname, lfiletype, laliasname)
IF !File(lcname)
 RETURN 'N'
ENDIF
select 0
***check structure of template to make sure selected file is up-to-date
&&filetype = Right(lcname,3) ---changed THIS AS 9/19/2003
templtfl = THIS.TEMPLTDIR+lfiletype+"_flds"
use (templtfl)
sum field_len TO xrecsize
xrecsize = xrecsize + 1    &&add 1 FOR mark FOR deletion FIELD
use (lcname) Alias (laliasname)
IF RecSize() <> xrecsize            &&update file format IF necessary
  copy TO temp
  &&use (templtfl)
  &&copy STRUCT TO (lcname)
  create (lcname) FROM (templtfl)   && changed THIS since it didn't seem to be working correctly with the fpt file
  &&messagebox("Updating file structure for "+lcname)
  use (lcname) Alias (laliasname)
  append FROM temp
  go top
  delete file temp.dbf
ENDIF
RETURN 'Y'
ENDFUNC

FUNCTION createfile(lcname, lfiletype, laliasname)
select 0
source = THIS.TEMPLTDIR+lfiletype+"_flds"
create (lcname) FROM (source)
use (lcname) Alias (laliasname)
ENDFUNC


FUNCTION get(laliasname, lcfieldname)
select (laliasname)
RETURN Eval(lcfieldname)
ENDFUNC

FUNCTION getdate(laliasname, lcfieldname)
select (laliasname)
RETURN DToC(Eval(lcfieldname))
ENDFUNC

FUNCTION put(laliasname, lcfieldname, fldvalue)
select (laliasname)
replace (lcfieldname) WITH fldvalue
ENDFUNC

FUNCTION putdate(laliasname, lcfieldname, fldvalue)
select (laliasname)
replace (lcfieldname) WITH CToD(fldvalue)
ENDFUNC

FUNCTION skiprec(laliasname, numskip)
select (laliasname)
skip numskip
**messagebox(laliasname+str(recno(),5))
IF Eof() .or. bof()
 RETURN "Y"
ELSE
 RETURN "N"
ENDIF
ENDFUNC

FUNCTION closefile(laliasname)
select (laliasname)
use
ENDFUNC

FUNCTION gototop(laliasname)
select (laliasname)
goto top
ENDFUNC

FUNCTION newrecord
APPEND BLANK
ENDFUNC

FUNCTION getrecordnum(laliasname)
select (laliasname)
RETURN RecNo()
ENDFUNC

FUNCTION zap
Set Safety Off
Zap
ENDFUNC

FUNCTION usefilenocheck(laliasname)
select (laliasname)
ENDFUNC

FUNCTION export_to_excel(laliasname, lfilename, lperiod)
select (laliasname)
copy TO (lfilename) type xl5 FOR period = lperiod
ENDFUNC

FUNCTION openfile(lcname, laliasname)
IF !File(lcname)
 RETURN 'N'
ENDIF
select 0
use (lcname) Alias (laliasname)
ENDFUNC

FUNCTION isdeleted
IF Deleted()
    RETURN 1
ELSE
    RETURN 0
ENDIF
ENDFUNC

FUNCTION sort(laliasname, lcfieldname, ltempname)
select (laliasname)
index on (lcfieldname) TO (ltempname)
&&index on LOAN_ID TO (ltempname)
copy TO (ltempname)
zap
append FROM (ltempname)
&&close all ************took THIS like OUT on 9/27/10 --- AS
ENDFUNC

FUNCTION erase(lcname)
erase (lcname)
ENDFUNC

****************************************************
***cap related functions are below******************
**note: a reference file (ref) is being used to ensure no problems aligning with deal's capfile
**      with the aggregate caplist file
FUNCTION fpopencap_and_ref_dbfs(lcname)  &&only 5 char deal name AS files are STATIC
lcname = SubStr(lcname,1,5)
lcapname = lcname + 'cap.dbf'
lrefname = lcname + 'ref.dbf'
IF !File(lcapname) .or. !File(lrefname)
 RETURN '1'
ENDIF

select 0
filetype = 'cap'
templtfl = THIS.TEMPLTDIR+filetype+"_flds"
use (templtfl)
sum field_len TO xrecsize
xrecsize = xrecsize + 1    &&add 1 FOR mark FOR deletion FIELD
use (lcapname) alias capfile  &&file IS assumed TO be indexed WITH .CDX file on str of PAYMENTNUM & DEALCONNUM
SET ORDER TO tag pmt_cntrct

IF RecSize() <> xrecsize     &&update file format IF necessary
  copy TO temp
  create (lcapname) FROM (templtfl)
  use (lcapname) alias capfile
  INDEX ON Str(paymentnum,3)+Str(dealconnum,2) tag pmt_cntrct
  SET ORDER TO tag pmt_cntrct
  append FROM temp
  go top
  delete file temp.dbf
ENDIF

select 0
filetype = 'ref'
templtfl = THIS.TEMPLTDIR+filetype+"_flds"
use (templtfl)
sum field_len TO xrecsize
xrecsize = xrecsize + 1    &&add 1 FOR mark FOR deletion FIELD
use (lrefname) alias reffile &&file IS assumed TO be indexed WITH .CDX file on str of DEALCONNUM
SET ORDER TO tag cntractnum

IF RecSize() <> xrecsize     &&update file format IF necessary
  copy TO temp
  create (lrefname) FROM (templtfl)
  use (lrefname) alias reffile
  INDEX ON dealconnum tag cntractnum
  SET ORDER TO tag cntractnum
  append FROM temp
  go top
  delete file temp.dbf
ENDIF

select 0
caplist = THIS.TAXDIR+"Caplist.dbf"
IF !File(caplist)
 RETURN '2'
ENDIF
use (caplist) alias caplist
SET ORDER TO tag refnum

*select capfile    this doesn't seem to work for some reason...  thus will do direct seek btw files
*set relation to DEALCONNUM into reffile
*select reffile
*set relation to REF_NUMBER into caplist

RETURN 'Y'
ENDFUNC

FUNCTION fpposition_cap_record(lperiod, lcontract_num)
 select capfile
 seek Str(lperiod,3)+Str(lcontract_num,2)
 IF Eof()
   RETURN '1'
 ENDIF
 SELECT reffile
 SEEK lcontract_num
 IF Eof()
   RETURN '2'
 ENDIF
 SELECT caplist
 SEEK Upper(reffile->ref_number)
 IF Eof()
   RETURN '3'
 ENDIF
 select capfile
 RETURN 'Y'
ENDFUNC


FUNCTION fpcalc_cap_value(dbegcertbal, icap_code, iactpmttst)
LOCAL cap_libor, cap_days
IF iactpmttst <= 0  &&we're processing an actual payment
  IF Abs(dbegcertbal - capfile->begcertbal) > 0.90  &&begcertbal IN capfile doesn't match passed value
    RETURN -999.99
  ENDIF
  m->cap_libor = capfile->act_libor
  m->cap_days  = capfile->act_days
  m->cap_days1 = capfile->act_days1
ELSE
  m->cap_libor = capfile->proj_libor
  m->cap_days  = capfile->proj_days
  m->cap_days1 = capfile->proj_days1
ENDIF


IF icap_code = 1 &&calc Total cap pmt
 evalstmt = caplist->totcapcalc
 evalrslt = &evalstmt
 THIS.mTOTCAPPMT = evalrslt
ENDIF
IF icap_code = 2 &&calc Net cap pmt
 evalstmt = caplist->netcapcalc
 evalrslt = &evalstmt
 THIS.mNETCAPPMT = evalrslt
ENDIF
IF icap_code = 3 &&calc excess cap pmt
 evalstmt = caplist->exscapcalc
 evalrslt = &evalstmt
 THIS.mEXSCAPPMT = evalrslt
ENDIF
RETURN evalrslt
ENDFUNC

FUNCTION fpget_cap_value(icap_code)
IF icap_code = 1 &&calc Total cap pmt
 RETURN capfile->actcappmt
ENDIF
IF icap_code = 2 &&calc Net cap pmt
 RETURN capfile->netcappmt
ENDIF
IF icap_code = 3 &&calc excess cap pmt
 RETURN capfile->exscappmt
ENDIF
RETURN -1
ENDFUNC

****************************************************
FUNCTION fpopen_loss_accel_dbf(lcname)

xfile = SubStr(lcname,1,5)+"acc.dbf"
IF !File(xfile)
 RETURN 0
ENDIF
select 0
use (xfile) alias accelloss
IF RecCount() = 0
 RETURN 999    &&no loss records yet
ENDIF
RETURN payperiod &&RETURN payperiod FROM first record so we know WHEN first loss IS TO be applied
ENDFUNC

FUNCTION fpget_accel_loss(lrec)
select accelloss
IF RecCount() < lrec   &&check TO make sure selected record exists
  RETURN -1.0
ENDIF
goto lrec
RETURN accel_loss
ENDFUNC

****************************************************
FUNCTION fpseekrecord(laliasname, seekstr)
select (laliasname)
seek seekstr
IF Eof()
 RETURN 'N'
ENDIF
RETURN 'Y'
ENDFUNC

****************************************************
FUNCTION fpsetindex(laliasname, indexname)
select (laliasname)
IF Len(indexname) = 0
  set index TO
ELSE
  IF File(indexname)
    set index TO &indexname
  ELSE
    RETURN 'N'
  ENDIF
ENDIF
RETURN 'Y'
ENDFUNC

FUNCTION lzero(xfield,length)
PRIVATE x, y
x=Replicate('0',length)
y=LTrim(Str(xfield,length))
x=x+y
RETURN (SubStr(x,Len(x)-length+1,length))
ENDFUNC

****************************************************
FUNCTION openfilei(lcname, laliasname, lidxname)
IF !File(lcname)
 RETURN 'N'
ENDIF
select 0

IF Len(lidxname) = 0
 use (lcname) Alias (laliasname)
ELSE
 IF File(lidxname)
   use (lcname) Alias (laliasname)
   set index TO (lidxname)
 ELSE
   RETURN 'N'
 ENDIF
ENDIF
RETURN 'Y'
ENDFUNC

****************************************************
FUNCTION adddoublefield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) B(2)
 ADD_TABLE_COLUMN(laliasname, lfieldname, "B", 8, 2)
ENDFUNC

FUNCTION addpctfield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) B(8)
  ADD_TABLE_COLUMN(laliasname, lfieldname, "B", 8, 8)
ENDFUNC

FUNCTION addlongstringfield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) C(45)
  ADD_TABLE_COLUMN(laliasname, lfieldname, "C", 45, 0)
ENDFUNC

FUNCTION addshortstringfield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) C(12)
   ADD_TABLE_COLUMN(laliasname, lfieldname, "C", 12, 0)
ENDFUNC

FUNCTION addlogicalfield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) L
   ADD_TABLE_COLUMN(laliasname, lfieldname, "L", 1, 0)
ENDFUNC

FUNCTION addintfield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) I
   ADD_TABLE_COLUMN(laliasname, lfieldname, "I", 4, 0)
ENDFUNC

FUNCTION adddatefield(laliasname, lfieldname)
 **alter table (laliasname) ADD COLUMN (lfieldname) D
   ADD_TABLE_COLUMN(laliasname, lfieldname, "D", 8, 0)
ENDFUNC

FUNCTION export_file_to_excel(laliasname, lfilename)
select (laliasname)
copy TO (lfilename) type xl5
ENDFUNC

FUNCTION export_file_to_csv(laliasname, lfilename)
select (laliasname)
copy TO (lfilename) type csv

** delete the .BAK file
bak_file = Left(lfilename, Len(lfilename) - 9) + ".BAK"
delete File (bak_file)

ENDFUNC

****************************************************
FUNCTION openfilefiltered(lcname, laliasname, lfilter, lidxname)
*trace_fpimport("0")
IF !File(lcname)
 RETURN 'N'
ENDIF
*trace_fpimport("1")
select 0
*trace_fpimport("2")

IF Len(lidxname) = 0
 use (lcname) Alias (laliasname)
ELSE
 IF File(lidxname)
   use (lcname) Alias (laliasname)
   set index TO (lidxname)
 ELSE
   RETURN 'N'
 ENDIF
ENDIF
*trace_fpimport("3")
IF Len(lfilter) > 0
 set filter TO &lfilter
ELSE
 set filter TO
ENDIF
*trace_fpimport("4")

RETURN 'Y'
ENDFUNC

**************************************************************
*********** FUNCTIONS FOR DATABASE CONTAINER STRUCTURE *******
**************************************************************
FUNCTION createdbcfile(lcname)
create database (lcname)
ENDFUNC

*************************************************************
FUNCTION createdbctable(lcname, ldbcname, lfiletype, laliasname)
select 0
source = THIS.TEMPLTDIR+lfiletype+"_flds"
create (lcname) database (ldbcname) FROM (source)
use (lcname) Alias (laliasname)
ENDFUNC

FUNCTION putfield(laliasname, lcfieldname, fldvalue, lfieldtype)

select (laliasname)
IF Type(lcfieldname) # "U" && it exists!!!!
 replace (lcfieldname) WITH fldvalue
ELSE
 IF ((lfieldtype) = 'N')
   adddoublefield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'P')
   addpctfield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'T')
   addlongstringfield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'S')
   addshortstringfield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'L')
   addlogicalfield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'I')
   addintfield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF
 IF ((lfieldtype) = 'D')
   adddatefield((laliasname), (lcfieldname))
   replace (lcfieldname) WITH fldvalue
 ENDIF

ENDIF

*************************************************************
FUNCTION index_on(laliasname, lcfieldname, ltempname)
select (laliasname)
index on &lcfieldname TO (ltempname)
ENDFUNC

*************************************************************
FUNCTION delete1(laliasname)
select (laliasname)
delete NEXT 1
ENDFUNC

*************************************************************
FUNCTION deleteall(laliasname, lcfieldname, fldvalue)
select (laliasname)
delete all FOR &lcfieldname = fldvalue
ENDFUNC

*************************************************************
FUNCTION deleteallnot(laliasname, lcfieldname, fldvalue)
select (laliasname)
delete all FOR &lcfieldname # fldvalue
ENDFUNC

*************************************************************
FUNCTION pack(laliasname)
set safety off
select (laliasname)
pack
ENDFUNC

*************************************************************
FUNCTION do_prg_no_arg(lprgname)
compile (lprgname)
DO (lprgname)
ENDFUNC


*************************************************************
FUNCTION project_mods_and_nonmods(colfile, x_mm, x_dd, x_yy)
modfile = Left(colfile,9)+"mod"
payfile = Left(colfile,9)+"pay"
colfile = Left(colfile,9)+"cld"
xperiod = SubStr(colfile,6,3)
xdate = CToD(LTrim(Str(x_mm,2))+"/"+LTrim(Str(x_dd,2))+"/"+Str(x_yy,4))

select 0
use (colfile) alias colfile
&& first, zero OUT INT, prin, AND loss fields FOR paid off / transferred loans
REPLACE act_int WITH 0, act_prin WITH 0, act_loss WITH 0 FOR coll_type='*'

sum mod_gain, c_curr_bal + forbear TO tot_mod_gains, tot_bal_modified FOR mod_gain > 0
sum act_int, act_prin, act_loss TO mod_int, mod_prin, mod_loss FOR ((mod_date > CToD("01/01/2000") .and.;  &&exclude orig mod record FOR re-mod
    retire_dt < CToD("01/01/2000")) .or. retire_dt = xdate)
sum act_prin, act_loss TO curr_mod_prin, curr_mod_loss FOR retire_dt = xdate
tot_bal_modified = tot_bal_modified + curr_mod_prin + curr_mod_loss
sum act_int, act_prin, act_loss TO reg_int, reg_prin, reg_loss FOR !(mod_date > CToD("01/01/2000") .or.;
   retire_dt > CToD("01/01/2000"))
count TO modrecs FOR (mod_date > CToD("01/01/2000") .or. retire_dt > CToD("01/01/2000"))
nonmodrecs = RecCount() - modrecs
copy TO modxx000.cld FOR mod_date > CToD("01/01/2000") .and. retire_dt < CToD("01/01/2000")
copy TO regxx000.cld FOR mod_date < CToD("01/01/2000") .and. retire_dt < CToD("01/01/2000")

use modxx000.cld
replace all c_bal WITH c_curr_bal
use regxx000.cld
replace all c_bal WITH c_curr_bal
use

set altern TO (modfile)
set altern on
?? "***mod data for yld file***"
? "**Total Mod Gains This Period,  Total Bal of Loans Modified This Period"
? Str(tot_mod_gains, 12, 2), Str(tot_bal_modified, 13, 2)
close altern

set altern TO (payfile)
set altern on
?? "*        Payment   Data       for period", xperiod
?  "*ID        Principal  Interest  Loss  Expenses"
? " COL-LT", Str(reg_prin,12,2), Str(reg_int,12,2), Str(reg_loss,12,2)
? " MODCOL", Str(mod_prin,12,2), Str(mod_int,12,2), Str(mod_loss,12,2)
?
close altern

**just in case we have a collamt failure make sure stale 00bs are deleted
delete file modxx000.00b
delete file modxx000.00m
delete file modxx000.001
delete file regxx000.00b
delete file regxx000.00m
delete file regxx000.001

 IF modrecs > 0
  runline = "collamt MODXX000.inp"
 *wait window "" timeout 0.25
  WshShell = CreateObject("WScript.Shell")
  WshShell.Run("cmd /K "+runline+'&exit', 0, 1)
 ENDIF

 IF nonmodrecs > 0
  runline = "collamt REGXX"+SubStr(colfile,6,3)+".inp"   &&collamt IS called WITH period number IN name but will execute period 000
 *wait window "" timeout 0.25
  WshShell = CreateObject("WScript.Shell")
  WshShell.Run("cmd /K "+runline+'&exit', 0, 1)
 ENDIF


ENDFUNC

*******************************************************************
FUNCTION trace_fpimport(tracer)
PRIVATE tracefile
tracefile = SYS(5) + CurDir()+"fp_import_trace.txt"
set altern TO &tracefile additive
set altern on
? tracer
close alternate
ENDFUNC
*******************************************************************

FUNCTION closedbase
close databases
ENDFUNC

FUNCTION closeall
close all
ENDFUNC
    
FUNCTION ADD_TABLE_COLUMN
PARAMETERS TableAlias, fldName, fldType, fldLen, fldDec
LOCAL TempFldsFile 
IF VARTYPE(fldName) <> "C"
	messagebox("Error on call to ADD_TABLE_COLUMN. Field Name must be a Character String")
	RETURN 1
ENDIF
IF Len(fldName) < 1 .or. Len(fldName) > 10
	messagebox("Error on call to ADD_TABLE_COLUMN. Field Name length must be bewteen 1 and 10")
	RETURN 1
ENDIF
CurrWorkArea = Alias()
select (TableAlias)
cDBF = DBF()
cDBFPath = JUSTPATH(cDBF) 
TempFldsFile = cDBFPath+"\temp_flds"
copy STRUCTURE extended TO (TempFldsFile)
Select 0
use (TempFldsFile) alias tempflds
Append Blank
Replace Field_name WITH fldName
Replace Field_type WITH fldType
Replace Field_len WITH fldLen
Replace Field_dec WITH fldDec 
tempdbf = cDBFPath+"\tempdbf.dbf"     
Use
Select (TableAlias)
Create (tempdbf) FROM (TempFldsFile)
Use (tempdbf) Alias (TableAlias)
Append FROM (cDBF)   
DELETE File (cDBF)
DELETE File (TempFldsFile) 
Use
Rename (tempdbf) TO (cDBF)
Select 0
Use (cDBF) Alias (TableAlias)
select (CurrWorkArea)
RETURN 0
END FUNC

ENDDEFINE

[robert]

Jeff,

SET ORDER TO TAG sometag should work.
But as a workaround try OrdSetFocus( "sometag") /
see
https://www.xsharp.eu/runtimehelp/html/ ... tFocus.htm

Robert

[Jeff Stone]

Hi Robert,

I have recoded with your work around and will see how that goes after I get a clean compile. In the meantime, you might want to know that
DELETE ALL FOR &lcfieldname = fldvalue produces a compilation error while
DELETE ALL FOR (lcfieldname) = fldvalue does not.

VFP has a COMPILE command which allowed a .DLL to execute a .PRG on the fly. With X# not being an interpreter, can you confirm that X# will not have this functionality?

Thanks and Happy Holidays,

Jeff

[robert]

Jeff,
The issue with &somename not working is fixed in our internal build.
We do not have COMPILE() but we do have ExecScript() that can take a statement list (it does not support functions or procedures).
If you really need to compile whole PRG then we also have solution, but that is a bit difficult to explain in a forum message.

Robert

[Chris]

Robert,

Jeff,
1) Apparently FoxPro is very forgiving in the order of optional clauses:

Apparently that's the same in VO. For example it allows both those variations of COPY STRUCTURE

Code: Select all

(1)COPY STRUCTURE TO a FIELDS b,c 
(2)COPY STRUCTURE FIELDS b,c TO a

while the relevant definitions for COPY STRUCTURE (there are a few more for COPY without the STRUCTURE clause) in STD.UDC are

Code: Select all

 COPY [STRUCTURE] [TO </file/>] [FIELDS <flds,...>] ;
    => DBCOPYSTRUCT( <(file)>, { <(flds)> } )


 COPY [STRUCTURE] [EXTENDED] [TO </file/>]  ;
    => DBCOPYXSTRUCT( <(file)> )

In X#, only (1) is supported and (2) throws a parser error. Should I log this as a bug, or it's just too complicated to support this in the preprocessor?

[robert]

Chris,
Please post this as a bug.

Robert

[Chris]

Robert,

Done, posted as https://github.com/X-Sharp/XSharpPublic/issues/1410

After closer examination, it seems it's not a preprocessor thing, but just the way the UDCs are defined in X#, compared to VO for example. Personally I prefer the way they are defined in X#, but then again if there's existing code making use of the more loose definitions..