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..

[Jeff Stone]

Hi Chris,

6 months later and I'm finally getting back to the .DLL. As a reminder, I am trying to build the .DLL with Xide64 2.18.4. I have converted the VFP code where needed to comply with X#. I compile successfully and all of the error messages are XS9073: variable '?????' has not been declared. Assuming this is a FIELD or a MEMVER. However, some of these warnings are strange as they relate to X# functions UPPER(), FILE(), STR(), and DtoC(). I'm not sure why this is happening.

Since the .DLL compiled, I tried to register it but got an entry-point DllRegisterServer not found error. I've read Wolfgang's post https://docs.xsharp.it/doku.php?id=com_module_sample but don't quite understand it. In VFP, we could just indicate that project was a module and define a class as OLEPUBLIC to make a COM server. Are there any other instructions that I can follow to build a COM server?

TIA,

Jeff

Code: Select all

#command DELETE FILE <(filename)> => System.IO.File.Delete(<(filename)>)
#command RENAME <(filename1)> TO <(filename2)> => FRENAME(<(filename1)>, <(filename2)>)  
#translate SYS(5) => diskname()+":\"   
#translate THIS. => ::

//USING Xide
USING System   
USING System.Text
USING System.Collections.Generic

*FUNCTION Start( ) AS VOID
*	FoxProMessage := "Hello VFP!"
*	? FoxProMessage
*RETURN

*********************************************************
***DEFINE CLASS fpimport AS Relation OLEPUBLIC
***INTERFACE fpimport
CLASS fpimport
	PUBLIC TAXDIR := "" AS STRING
	PUBLIC TEMPLTDIR := "" AS STRING
	PUBLIC cCurrentPath := "" AS STRING
	PUBLIC mTOTCAPPMT := 0.0 AS Double
	PUBLIC mNETCAPPMT := 0.0 AS Double
	PUBLIC mEXSCAPPMT := 0.0 AS Double  
	
	METHOD start
		RETURN
		
**mErrorRptd = 0
	
//FUNCTION setcentury
METHOD 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
RETURN
//ENDFUNC

//FUNCTION initdirs
METHOD initdirs
	
  ** for testing
  **set altern to "d:\temp.txt"
  **set altern on
  **?? "test1"
  **close altern
  **
	
	THIS.TAXDIR = GetEnv("TAXDIR")
	THIS.TEMPLTDIR = GetEnv("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
RETURN
//ENDFUNC


METHOD setcurrentpath(lcPath AS STRING)
	LOCAL lcOldPath AS STRING
	lcOldPath = CurDrive() + CurDir()   
	IF Len(RTrim(lcPath)) > 0          
		cd (lcPath)
		THIS.cCurrentPath = CurDrive() + CurDir()
	ELSE
		THIS.cCurrentPath = lcOldPath
	ENDIF
RETURN lcOldPath
//ENDFUNC

METHOD usefile(lcname AS STRING, laliasname AS STRING) 
	LOCAL xrecsize AS INT, filetype AS STRING, templtfl AS STRING, good_clsg_delay AS LOGIC, y AS INT, x AS INT
	&&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) alias temp
    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
METHOD usefile1(lcname AS STRING, lfiletype AS STRING, laliasname AS STRING) 
	LOCAL xrecsize AS INT, templtfl AS STRING
	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

METHOD createfile(lcname AS STRING, lfiletype AS STRING, laliasname AS STRING) 
	LOCAL source AS STRING
	select 0
	source = THIS.TEMPLTDIR+lfiletype+"_flds"
	create (lcname) FROM (source)
	use (lcname) Alias (laliasname)
RETURN
//ENDFUNC


METHOD get(laliasname AS STRING, lcfieldname AS STRING)
	select (laliasname)
RETURN Eval(lcfieldname)
//ENDFUNC

METHOD getdate(laliasname AS STRING, lcfieldname AS STRING)
	select (laliasname)
RETURN DToC(Eval(lcfieldname))
//ENDFUNC

METHOD put(laliasname AS STRING, lcfieldname AS STRING, fldvalue AS USUAL)
	select (laliasname)
	replace (lcfieldname) WITH fldvalue
RETURN
//ENDFUNC

METHOD putdate(laliasname AS STRING, lcfieldname AS STRING, fldvalue AS STRING)
	select (laliasname)
	replace (lcfieldname) WITH CToD(fldvalue)
RETURN

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

METHOD closefile(laliasname AS STRING)
	select (laliasname)
	use
RETURN

METHOD gototop(laliasname AS STRING)
	select (laliasname)
	goto top
RETURN

METHOD newrecord
	APPEND BLANK
RETURN

METHOD getrecordnum(laliasname AS STRING)
	select (laliasname)
	RETURN RecNo()
RETURN

METHOD zap
	Set Safety Off
	Zap
RETURN

METHOD usefilenocheck(laliasname AS STRING)
	select (laliasname)
RETURN

METHOD export_to_excel(laliasname AS STRING, lfilename AS STRING, lperiod AS INT)
	select (laliasname)
	copy TO (lfilename) type xl5 FOR period = lperiod
RETURN

METHOD openfile(lcname AS STRING, laliasname AS STRING)
	IF !File(lcname)
		RETURN 'N'
	ENDIF
	select 0
	use (lcname) Alias (laliasname)
RETURN

METHOD isdeleted
	IF Deleted()
		RETURN 1
	ELSE
		RETURN 0
	ENDIF
RETURN

METHOD sort(laliasname AS STRING, lcfieldname AS STRING, ltempname AS STRING)
	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
RETURN

METHOD erase(lcname AS STRING)
	erase (lcname)
RETURN

****************************************************
***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
METHOD fpopencap_and_ref_dbfs(lcname AS STRING)  &&only 5 char deal name AS files are STATIC 
	LOCAL lcapname AS STRING, lrefname AS STRING, filetype AS STRING, templtfl AS STRING, xrecsize AS INT
	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
	DbSetOrder(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
		DbSetOrder(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
	DbSetOrder(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
		DbSetOrder(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
	DbSetOrder(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'


METHOD fpposition_cap_record(lperiod AS INT, lcontract_num AS INT)
	select capfile
	seek Str(lperiod,3,0)+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'



METHOD fpcalc_cap_value(dbegcertbal AS Double, icap_code AS INT, iactpmttst AS INT)
	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


METHOD fpget_cap_value(icap_code AS INT)
	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


****************************************************
METHOD fpopen_loss_accel_dbf(lcname AS STRING)
	LOCAL xfile AS STRING
	
	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


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


****************************************************
METHOD fpseekrecord(laliasname AS STRING, seekstr AS STRING)
	select (laliasname)
	seek seekstr
	IF Eof()
		RETURN 'N'
	ENDIF
RETURN 'Y'


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


METHOD lzero(xfield AS STRING, length AS DWORD)
	PRIVATE x, y
	x=Replicate('0',length)
	y=LTrim(Str(xfield,length))
	x=x+y
RETURN (SubStr(x,Len(x)-length+1,length))


****************************************************
METHOD openfilei(lcname AS STRING, laliasname AS STRING, lidxname AS STRING)
	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'


****************************************************
METHOD adddoublefield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) B(2)
	ADD_TABLE_COLUMN(laliasname, lfieldname, "B", 8, 2)
RETURN

METHOD addpctfield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) B(8)
	ADD_TABLE_COLUMN(laliasname, lfieldname, "B", 8, 8)
RETURN

METHOD addlongstringfield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) C(45)
	ADD_TABLE_COLUMN(laliasname, lfieldname, "C", 45, 0)
RETURN

METHOD addshortstringfield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) C(12)
	ADD_TABLE_COLUMN(laliasname, lfieldname, "C", 12, 0)
RETURN

METHOD addlogicalfield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) L
	ADD_TABLE_COLUMN(laliasname, lfieldname, "L", 1, 0)
RETURN

METHOD addintfield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) I
	ADD_TABLE_COLUMN(laliasname, lfieldname, "I", 4, 0)
RETURN

METHOD adddatefield(laliasname AS STRING, lfieldname AS STRING)
 **alter table (laliasname) ADD COLUMN (lfieldname) D
	ADD_TABLE_COLUMN(laliasname, lfieldname, "D", 8, 0)
RETURN

METHOD export_file_to_excel(laliasname AS STRING, lfilename AS STRING)
	select (laliasname)
	copy TO (lfilename) type xl5
RETURN

METHOD export_file_to_csv(laliasname AS STRING, lfilename AS STRING)
	LOCAL bak_file AS STRING
	
	select (laliasname)
	copy TO (lfilename) type csv
	
** delete the .BAK file
	bak_file = Left(lfilename, Len(lfilename) - 9) + ".BAK"
	delete File (bak_file)
	
RETURN

****************************************************
METHOD openfilefiltered(lcname AS STRING, laliasname AS STRING, lfilter AS STRING, lidxname AS STRING)
*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'


**************************************************************
*********** FUNCTIONS FOR DATABASE CONTAINER STRUCTURE *******
**************************************************************
METHOD createdbcfile(lcname AS STRING)
	create database (lcname)
RETURN

*************************************************************
METHOD createdbctable(lcname AS STRING, ldbcname AS STRING, lfiletype AS STRING, laliasname AS STRING)  
	LOCAL source AS STRING
	select 0
	source = THIS.TEMPLTDIR+lfiletype+"_flds"
*create (lcname) database (ldbcname) FROM (source)
	IF DBUsed(ldbcname)
		create (lcname) FROM (source)
	ELSE
		OPEN DATABASE (ldbcname)
	ENDIF
	use (lcname) Alias (laliasname)
RETURN

METHOD putfield(laliasname AS STRING, lcfieldname AS STRING, fldvalue AS USUAL, lfieldtype AS STRING)
	
	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
RETURN

*************************************************************
METHOD index_on(laliasname AS STRING, lcfieldname AS STRING, ltempname AS STRING)
	select (laliasname)
	index on (lcfieldname) TO (ltempname)
RETURN

*************************************************************
METHOD delete1(laliasname AS STRING)
	select (laliasname)
	delete NEXT 1
RETURN

*************************************************************
METHOD deleteall(laliasname AS STRING, lcfieldname AS STRING, fldvalue AS USUAL)
	select (laliasname)
	delete ALL FOR (lcfieldname) = fldvalue
RETURN

*************************************************************
METHOD deleteallnot(laliasname AS STRING, lcfieldname AS STRING, fldvalue AS USUAL)
	select (laliasname)
	delete all FOR (lcfieldname) != fldvalue
RETURN

*************************************************************
METHOD pack(laliasname AS STRING)
	set safety off
	select (laliasname)
	pack
RETURN

*************************************************************
METHOD do_prg_no_arg(lprgname AS STRING)
*compile (lprgname)
*DO (lprgname)
RETURN


*************************************************************
METHOD project_mods_and_nonmods(colfile AS STRING, x_mm AS INT, x_dd AS INT, x_yy AS INT)  
	LOCAL modfile AS STRING, payfile AS STRING, xperiod AS STRING, xdate AS DATE  
	LOCAL  tot_mod_gains AS Double, tot_bal_modified AS Double, dfile AS STRING, runline AS STRING
	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 c_bal WITH c_curr_bal all
	use regxx000.cld
	replace c_bal WITH c_curr_bal all
	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
	dfile = "modxx000.00b"
	delete File &dfile
	dfile = "modxx000.00m"
	delete File &dfile
	dfile = "modxx000.001"
	delete File &dfile
	dfile = "regxx000.00b"
	delete File &dfile
	dfile = "regxx000.00m"
	delete File &dfile
	dfile = "regxx000.001"
	delete File &dfile
	
	
	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
	
	
RETURN

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

METHOD closedbase
	close databases
RETURN

METHOD closeall
	close all
RETURN

METHOD ADD_TABLE_COLUMN(TableAlias AS STRING, fldName AS STRING, fldType AS STRING, fldLen AS INT, fldDec AS INT)
	LOCAL TempFldsFile, cDBF AS STRING, tempdbf AS STRING, CurrWorkArea AS STRING, cDBFPath AS STRING
	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

*Procedure Error
*    Lparameters nError, cMethod, nLine

*    Local lcError
*    Local lcLine
*    Local lcMarker
*    Local lcMethod
*    Local lcTimeStamp

    **if THIS.mErrorRptd = 0
     *-- Build the strings for the text file.
*     lcMarker = Replicate("-", 35)
*     lcTimeStamp = "Error at …..:" + Ttoc(Datetime())
*     lcLine = "Line ………:" + Alltrim(Str(nLine, 6, 0))
*     lcError = "Error ……..:" + Alltrim(Str(nError, 6, 0))
*     lcMethod = "Method …….:" + cMethod

*     Set Textmerge On
*     Set Textmerge To fp_import_errors.txt Additive
* \<<lcMarker>>
* \<<lcTimeStamp>>
* \<<lcError>>
* \<<lcLine>>
* \<<lcMethod>>
*     Set Textmerge To
*     Set Textmerge Off
*    **endif
* ** THIS.mErrorRptd = 1

*    Return
*Endproc

**ENDDEFINE
**END INTERFACE
END CLASS

[Chris]

Hi Jeff,

Wolfgang is the guru here about COM registering, so will let him comment on that.

About the rest, thanks for posting the code, it shows several issues:

1. Most warnings are correct, they are on using undeclared fields and memvars and the compiler is warning you about this, because it could had also been just a typo, or an unintended missing declaration. If you want you can simply disable this warning, by entering in the app properties, Compiler page, first editbox this:

/nowarn:9073

but it's better to just let the compiler know of which identifiers are fields and which are memvars and help it make better compiler time checks. So you can add somewhere in the beginning of your code:

FIELD field_len, clsg_delay, delay_mths, ...
MEMVAR dealage, caplist, ...

even better, some of those memvars can be declared as LOCALs, in the body of the method where they are only used

2. The warnings on Upper(), Str() etc look like a compiler bug. Will open a report on it to be fixed, but it shouldn't be causing real trouble.

3. Currently there's a problem with the SEEK command, this will not work properly in the current X# build (2.19). Should be fixed in the next build (2.20) though which should be released very soon, so please try again with it.

[wriedmann]

Hi Jeff,
unfortunately I do not know anything how VFP works to register a DLL as COM server, but what I have described in my article is the manual way to do that.
Maybe there could be done something at the compiler level to generate the instructions for COM servers automatically, but since I'm only a basic X# user (programmer) I cannot say if this is possible or if it makes sense to have another application type "COM server" that builds a COM enabled DLL.
Basically it should be enough to include a

Code: Select all

using System.Runtime.InteropServices

in the header of the file and every class declaration with

Code: Select all

[ComVisible(true)];
[Guid("7D1DF22E-3A3D-431C-8BEE-A2F40C53A249")];
InterfaceType(ComInterfaceType.InterfaceIsIDispatch)];
[ProgId("COMTest.COMTester")];
class COMTester implements ICOMTester

But I don't know exactly if that works or is worth the time to implement it in the compiler.
Wolfgang