Thank you very much.
I didn't send those functions, because I thought the message would become very lengthy. I am sending them now ...
Code: Select all
Function Set_prog()
set talk off
set dele on
set date brit
set cent on
set epoch to 1950
SET BROWSESYNC ON
SET NAVIGATION EXTENDED
SET INTERACTIVECLOSE QUERY MAIN
set font to "Arial", 09
REQUEST DBFCDX , DBFFPT
RDDSETDEFAULT( "DBFCDX" )
s_user()
s_accyr()
return nil
Function Setup_tables()
s_acct()
return nil
Function Start_prog()
Login()
wAccyr()
winMain.title := "Control ("+dtoc(_accfrom)+" - "+dtoc(_accto)+")"
return nil
Function Exit_prog()
release window winmain
close all
return nil
Function s_user()
local adbf := {}
aadd(adbf, {"userid", "c", 14, 0})
aadd(adbf, {"password", "c", 14, 0})
if dbcreachk("user", adbf) .or. !file("user.cdx")
if select("user") = 0
use user exclusive
endif
select user
index on userid tag userid
use
endif
if select("user") = 0
use user shared new
endif
select user
if reccount()= 0
append blank
replace userid with "user"
replace password with pass_in("user")
unlock
endif
use
retur nil
Function s_accyr()
local adbf := {}
aadd(adbf, {"accyrid", "c", 10, 0})
aadd(adbf, {"accfrom", "d", 8, 0})
aadd(adbf, {"accto", "d", 8, 0})
if dbCreaChk("accyr", adbf) .or. !file("accyr.cdx")
if select("accyr") = 0
use accyr exclusive
endif
select accyr
index on accyrid tag accyrid
use
endif
return nil
//----------------------------------------- acct.dbf
function s_acct()
local adbf := {}
aadd(adbf, {"acctcd", "c", 10, 0})
aadd(adbf, {"acctnm", "c", 40, 0})
aadd(adbf, {"actype", "c", 1, 0})
aadd(adbf, {"istrad", "l", 1, 0})
aadd(adbf, {"contra", "l", 1, 0})
aadd(adbf, {"istax", "l", 1, 0})
aadd(adbf, {"subled", "l", 1, 0})
aadd(adbf, {"splac", "l", 1, 0})
aadd(adbf, {"opgbal", "n", 12, 2})
aadd(adbf, {"clobal", "n", 12, 2})
if dbCreaChk("acct", adbf) .or. !file("acct.cdx")
if select("acct") = 0
use acct exclusive
endif
index on acctcd tag acctcd
index on upper(acctnm) tag acctnm
use
endif
if select("acct") = 0
use acct
endif
AcctInit()
select acct
use
return nil
function AcctInit()
local aRec := {}, Ctracctcd := 1, Ctracctnm := 2, CtrAcType := 3, ;
CtrIsTrad := 4, CtrContra := 5, CtrIsTax := 6, CtrSubLed := 7, ;
CtrSplAc := 8, i
aadd(aRec, {"CASH", "Cash", "A", .F., .T., .F., .F., .t.})
aadd(aRec, {"BANK", "Bank", "A", .F., .T., .F., .F., .t.})
aadd(aRec, {"CHQIH", "Cheque in Hand", "A", .F., .T., .F., .F., .t.})
aadd(aRec, {"SALE", "Sales", "I", .T., .F., .F., .T., .t.})
aadd(aRec, {"PUR", "Purchase", "E", .T., .F., .F., .T., .t.})
aadd(aRec, {"DBTR", "Sundry Debtors", "A", .F., .F., .F., .T., .t.})
aadd(aRec, {"CRDTR", "Sundry Creditors", "L", .F., .F., .F., .T., .t.})
select acct
set order to tag acctcd
for i = 1 to len(aRec)
seek aRec[i, Ctracctcd]
if !found()
append blank
replace acctcd with aRec[i, Ctracctcd]
replace acctnm with aRec[i, Ctracctnm]
replace AcType with aRec[i, CtrAcType]
replace Contra with aRec[i, CtrContra]
replace isTax with aRec[i, CtrIsTax]
replace SubLed with aRec[i, CtrSubled]
replace SplAc with aRec[i, CtrSplAc]
endif
next
return nil
FUNCTION dbCreaChk(fname, adbf)
local aStruct, option, lChange := .f., lNew := .f., i, newrec, oldrec
fname := upper(fname)
if !file(fname+".dbf")
set exclusive on
dbcreate(fname, adbf)
set exclusive off
return .t.
endif
use (fname)
aStruct = dbstruct()
use
if len(aStruct) != len(adbf)
lChange = .t.
else
i = 1
do while i <= len(aStruct) .and. !lNew .and. !lChange
if len(aStruct[i, DBS_NAME]) != len(adbf[i, DBS_NAME]) ;
.or. upper(aStruct[i, DBS_NAME]) != upper(adbf[i, DBS_NAME]) ;
.or. upper(aStruct[i, DBS_TYPE]) != upper(adbf[i, DBS_TYPE]) ;
.or. aStruct[i, DBS_LEN] != adbf[i, DBS_LEN] ;
.or. aStruct[i, DBS_DEC] != adbf[i, DBS_DEC]
lChange = .t.
endif
i++
enddo
endif
if lChange
if msgyesno(fname+" structure has been changed. Change";
+" the structure ?")
set exclusive on
use (fname)
pack
oldrec = reccount()
use
deletefile("settemp.dbf")
if renamefile(fname+".dbf", "settemp.dbf") != 0
msginfo("Cannot change file structure!",)
QUIT
ENDIF
dbcreate(fname, adbf)
use (fname)
append from settemp
newrec = reccount()
use
if newrec != oldrec
msginfo("Problem in creating file :"+fname+;
". You can get all records in the file SETTEMP.DBF")
quit
endif
deletefile("settemp.dbf")
set exclusive off
return .t.
else
msginfo(fname+" structure mismatch")
quit
endif
endif
return .f.
function NetSelect(cTable)
if select(cTable) = 0
use &cTable shared new
endif
return nil
With best regards.