home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dgenius.zip
/
DGENI003.PRG
< prev
next >
Wrap
Text File
|
1987-02-03
|
24KB
|
1,072 lines
Procedure Getdefa
clear
set defa to a
set path to
set colo to g+/n,w/b
bc=.t.
do while bc
clear
mdrive=space(1)
@ 1,0 say "Place the diskette containing your database files in drive A."
clear
jj=.t.
do while jj
clear
@ 1,0 say "The following database files are available."
dir a:
aname=space(8)
@ 23,5 say "Enter Name of Data Base File you want to use:" get aname
set colo to r+/n
@ 24,5 say "If no database files are displayed, enter RETURN to start over."
set colo to g+/n,w/b
read
if aname=" "
loop
endif
if trim(upper(aname))="RETURN"
do getdefa
else
endif
mname=trim(aname)
if .not. file('&mname..dbf')
do while .not. file('&mname..dbf')
? chr(7)
set colo to gr+/n
@ 23,0 clear
@ 24,0 clear
@ 23,0 say "The file you have specified, "+upper(mname)+" , does not exist."
@ 24,0 say "Enter the file name again =========>" get aname
read
mname=trim(aname)
if .not. file('&mname..dbf')
loop
else
exit
endif
enddo
else
endif
set colo to g+/n,w/b
use &mname
if reccount()=0
clear
? chr(7)
set colo to r+/n
@ 1,0 say "There are no records in this database."
wait
set colo to g+/n,w/b
loop
else
clos data
exit
endif
enddo while jj
clear
@ 1,0 say "Copying the "+trim(upper(mname))+" database........"
run copy a:\&mname..dbf c:\dbase/v
@ 24,0 say "Just a moment...."
set defa to c
set path to c:\dbase
use &mname
num_fields=0
null=""
do while null<field(num_fields+1)
num_fields=num_fields+1
enddo
sel=1
number=1
x=5
y=0
clear
if num_fields>75
@ 1,0 say "There are too many fields to display on the screen at one time."
@ 2,0 say "I will print them out for you. Be sure your printer is turned on!"
wait
clear
set colo to r+/n
@ 1,0 say "Printing......"
set print on
set cons off
set margin to 8
do while number<=num_fields .and. sel<=num_fields
newsel=trim(str(sel))
? ltrim(newsel)+". "+field(number)
sel=sel+1
number=number+1
enddo
set cons on
set prin off
set margin to 0
set colo to g+/n,w/b
else
clear
@ 1,0 say "There are "+ltrim(str(num_fields))+" fields in the "+upper(mname)+" database file."
@ 2,0 say "All fields are listed below:"
do while number<=num_fields .and. sel<=num_fields
if number=16
x=5
y=15
endif
if number=31
x=5
y=30
endif
if number=46
x=5
y=45
endif
if number=61
x=5
y=60
endif
if number=76
wait
@ 5,0 clea to 20,79
x=5
y=0
endif
if number=91
x=5
y=15
endif
if number=106
x=5
y=30
endif
if number=121
x=5
y=45
endif
newsel=trim(str(sel))
@ x,y say ltrim(newsel)+". "+field(number)
sel=sel+1
x=x+1
number=number+1
enddo
endif
rec1=0
@ 23,0 say "Enter number of the field you want to use to put"
@ 24,0 say " the records in order:" get rec1 picture "@Z 999" range ,num_fields
read
set talk off
copy stru exte to strux
use strux
go rec1
mtype=field_type
mfield=field_name
get_box=field_len
mboole=space(get_box)
decims=field_dec
use &mname
@ 24,0 say space(79)
set colo to gr+/n
@ 24,0 say "Creating a new index for the "+upper(mname)+" database."
set talk on
index on &mfield to temp
set talk off
return
enddo
Procedure Actions
Parameters mname,mfield,get_box,mtype,num_fields,field1,field2,field3,field4
cc=.t.
use &mname index temp
do while cc
clear
mpick=space(1)
set colo to b+/n
@ 3,5 say "dGENIUS Reports Generator"
set colo to g+/n
@ 5,5 say "Choose the type of report you want:"
set colo to b+/n,w/b
@ 7,5 say " 1. Create a report based on the "+trim(upper(mfield))+" field."
@ 9,5 say " 2. Create a report using the "+trim(upper(mfield))+" field and other fields."
@ 11,5 say " 3. Create a Report Based on Days,Months,or Years"
@ 13,6 get mpick
@ 13,8 say "<<Enter Selection"
set colo to g+/n
read
do case
case mpick="1"
set colo to gr+/n
no_flds=1
field1=mfield
indfld=mfield
return
case mpick="2"
clear
IF NUM_fields>75
@ 1,0 say "You may select a maximum of four fields for your report."
@ 2,0 say "Use your printout to select the fields you want by number:"
else
endif
sel=1
number=1
x=5
y=0
@ 1,0 say "You may construct a report using a maximum of"
@ 2,0 say "four fields from the following list:"
do while number<=num_fields .and. sel<=num_fields
if number=16
x=5
y=15
endif
if number=31
x=5
y=30
endif
if number=46
x=5
y=45
endif
if number=61
x=5
y=60
endif
if number=76
wait
@ 5,0 clea to 20,79
x=5
y=0
endif
if number=91
x=5
y=15
endif
if number=106
x=5
y=30
endif
if number=121
x=5
y=45
endif
newsel=trim(str(sel))
@ x,y say ltrim(newsel)+". "+field(number)
sel=sel+1
x=x+1
number=number+1
enddo
set colo to bg+/n,w/g
pick_one=0
no_flds=0
@ 24,0 say "How many fields do you want to use?" get no_flds ;
picture "@Z 9" range 1,4
read
@ 24,0 say space(79)
do while pick_one<=no_flds
chosen=0
pick_one=pick_one+1
if pick_one=1 .and. pick_one<=no_flds
@ 24,0 say "Enter number of first field:" get chosen picture "@Z 999";
range ,num_fields
read
field1=field(chosen)
@ 1,50 say "1. "+field1
endif
if pick_one=2 .and. pick_one<=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of second field:" get chosen picture "@Z 999";
range ,num_fields
read
field2=field(chosen)
@ 3,50 say "2. "+field2
endif
if pick_one=3 .and. pick_one<=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of third field:" get chosen picture "@Z 999";
range ,num_fields
read
field3=field(chosen)
@ 5,50 say "3. "+field3
endif
if pick_one=4 .and. pick_one=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of last field:" get chosen picture "@Z 999";
range ,num_fields
read
field4=field(chosen)
@ 7,50 say "4. "+field4
endif
if pick_one>no_flds
@ 24,0 say space(79)
exit
endif
enddo
indfld=mfield
fldno=space(1)
@ 9,40 say "Enter the number of the field you want"
@ 10,40 say "to use to choose the beginning and "
@ 11,40 say "ending limits of your report:" get fldno
read
if fldno="1"
newfield=field1
endif
if fldno="2"
newfield=field2
endif
if fldno="3"
newfield=field3
endif
if fldno="4"
newfield=field4
endif
use strux
index on field_name to strux
use strux index strux
find &newfield
get_box=field_len
mtype=field_type
clos data
return
case mpick="3"
clear
IF NUM_fields>75
@ 1,0 say "You may select a maximum of four fields for your report."
@ 2,0 say "Use your printout to select the fields you want by number:"
else
endif
sel=1
number=1
x=5
y=0
@ 1,0 say "You may construct a report using a maximum of"
@ 2,0 say "four fields from the following list:"
do while number<=num_fields .and. sel<=num_fields
if number=16
x=5
y=15
endif
if number=31
x=5
y=30
endif
if number=46
x=5
y=45
endif
if number=61
x=5
y=60
endif
if number=76
wait
@ 5,0 clea to 20,79
x=5
y=0
endif
if number=91
x=5
y=15
endif
if number=106
x=5
y=30
endif
if number=121
x=5
y=45
endif
newsel=trim(str(sel))
@ x,y say ltrim(newsel)+". "+field(number)
sel=sel+1
x=x+1
number=number+1
enddo
set colo to bg+/n,w/g
pick_one=0
no_flds=0
@ 24,0 say "How many fields do you want to use?" get no_flds ;
picture "@Z 9" range 1,4
read
@ 24,0 say space(79)
do while pick_one<=no_flds
chosen=0
pick_one=pick_one+1
if pick_one=1 .and. pick_one<=no_flds
@ 24,0 say "Enter number of first field:" get chosen picture "@Z 999";
range ,num_fields
read
field1=field(chosen)
@ 1,50 say "1. "+field1
endif
if pick_one=2 .and. pick_one<=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of second field:" get chosen picture "@Z 999";
range ,num_fields
read
field2=field(chosen)
@ 3,50 say "2. "+field2
endif
if pick_one=3 .and. pick_one<=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of third field:" get chosen picture "@Z 999";
range ,num_fields
read
field3=field(chosen)
@ 5,50 say "3. "+field3
endif
if pick_one=4 .and. pick_one=no_flds
@ 24,0 say space(79)
@ 24,0 say "Enter number of last field:" get chosen picture "@Z 999";
range ,num_fields
read
field4=field(chosen)
@ 7,50 say "4. "+field4
endif
if pick_one>no_flds
@ 24,0 say space(79)
exit
endif
enddo
indfld=mfield
fldno=space(1)
@ 9,40 say "Enter the number of the field you want"
@ 10,40 say "to use to choose the beginning and "
@ 11,40 say "ending limits of your report:" get fldno
read
if fldno="1"
newfield=field1
endif
if fldno="2"
newfield=field2
endif
if fldno="3"
newfield=field3
endif
if fldno="4"
newfield=field4
endif
if type(newfield)<>"D"
do while type(newfield)<>"D"
? chr(7)
set colo to g+/n
fldno=space(1)
@ 12,40 say upper(newfield)+" is not a date field!"
@ 13,40 say "Choose another field:" get fldno picture "9"
read
do case
case fldno="1"
newfield=field1
case fldno="2"
newfield=field2
case fldno="3"
newfield=field3
case fldno="4"
newfield=field4
endcase
if type(newfield)="D"
exit
else
loop
endif
enddo
else
endif
use strux
index on field_name to strux
use strux index strux
find &newfield
get_box=field_len
mtype=field_type
clos data
use &mname
if no_flds=1
allfields="set fields to &field1"
endif
if no_flds=2
allfields="set fields to &field1,&field2"
endif
if no_flds=3
allfields="set fields to &field1,&field2,&field3"
endif
if no_flds=4
allfields="set fields to &field1,&field2,&field3,&field4"
endif
df=.t.
do while df
clear
dtopt=space(1)
@ 3,0 say "Date Finder and Reporter"
@ 4,5 say "Choose an Option:"
@ 6,5 say "1. List Records by Name of Month"
@ 7,5 say "2. List Records by Day of Week"
@ 8,5 say "3. List Records by Year"
@ 9,5 say "4. Return to dGENIUS Menu"
@ 10,5 get dtopt pict "9"
@ 10,7 say "<<<Enter Selection"
read
do case
case dtopt="1"
@ 3,0 clea to 11,79
mouwant=0
@ 5,40 say "Choose a MONTH:"
@ 6,40 say "1.January"
@ 7,40 say "2.February"
@ 8,40 say "3.March"
@ 9,40 say "4.April"
@ 10,40 say "5.May"
@ 11,40 say "6.June"
@ 12,40 say "7.July"
@ 13,40 say "8.August"
@ 14,40 say "9.September"
@ 15,40 say "10.October"
@ 16,40 say "11.November"
@ 17,40 say "12.December"
@ 19,40 get mouwant picture "@Z 99"
read
use &mname
set talk on
@ 21,40 say "Searching records....."
copy to holdfile for month(&newfield)=mouwant
use holdfile
if reccount()=0
set talk off
? chr(7)
@ 22,40 say "NO RECORDS FOUND."
wait
loop
else
endif
@ 22,40 say "Indexing records....."
index on &mfield to date
set talk off
use holdfile index date
? chr(7)
@ 22,0 clear to 23,79
@ 23,20 say "Ready to print...Be sure printer is on!"
wait "Press the Enter key to begin printing."
&allfields
set fields on
list off to print
case dtopt="2"
dayoweek=0
@ 3,0 clea to 11,79
@ 5,40 say "Choose a Day of the Week:"
@ 6,40 say "1. Sunday"
@ 7,40 say "2. Monday"
@ 8,40 say "3. Tuesday"
@ 9,40 say "4. Wednesday"
@ 10,40 say "5. Thursday"
@ 11,40 say "6. Friday"
@ 12,40 say "7. Saturday"
@ 14,40 get dayoweek pict "@Z 9"
@ 14,42 say "<<<Enter Selection"
read
use &mname
set talk on
@ 16,40 say "Searching records......"
copy to holdfile for dow(&newfield)=dayoweek
use holdfile
if reccount()=0
set talk off
? chr(7)
@ 17,40 say "NO RECORDS FOUND."
wait
loop
else
endif
@ 17,40 say "Indexing records...."
index on &mfield to date
set talk off
use holdfile index date
@ 17,0 clear to 19,79
@ 18,20 say "Ready to print...Be sure the printer is on!"
wait "Press the Enter key when ready to print."
&allfields
set fields on
list off to print
case dtopt="3"
myear=0
@ 8,40 say "Enter Year:" get myear pict "@Z 9999"
read
use &mname
set talk on
@ 9,40 say "Searching records...."
copy to holdfile for year(&newfield)=myear
use holdfile
if reccount()=0
set talk off
? chr(7)
@ 10,40 say "NO RECORDS FOUND."
wait
loop
else
endif
@ 10,40 say "Indexing records...."
index on &mfield to date
set talk off
use holdfile inde date
? chr(7)
@ 10,0 clea to 12,79
@ 11,20 say "Ready to print.... Be sure printer is on!"
wait "Press the Enter key to begin printing."
&allfields
set fields on
list off to print
case dtopt="4"
exit
endcase
enddo
clear
@ 3,0 say "RETURNING TO MENU......"
clos data
run del c:\dbase\holdfile.dbf
run del c:\dbase\date.ndx
nogo=.t.
return
Procedure Booleans
Parameters mname,newfield,mfield,get_box,mtype,no_flds,field1,field2,field3,field4
zz=.t.
use &mname
copy stru to holdfile
do while zz
clear
use holdfile
zap
clos data
set colo to gr+/n,w/b+
mopt="0"
@ 12,10 say "Select an option:"
@ 13,10 say "1. All records greater than a specific "+upper(newfield)
@ 14,10 say "2. All records less than a specific "+upper(newfield)
@ 15,10 say "3. All records equal to a specific "+upper(newfield)
@ 16,10 say "4. All records greater than or equal to a specific "+upper(newfield)
@ 17,10 say " and less than or equal to a specific "+upper(newfield)
@ 18,10 say "5. All records not equal to a specific "+upper(newfield)
@ 20,10 say "6. Return to the dGENIUS Menu."
@ 22,10 get mopt
@ 22,12 say "<<Enter Selection"
read
@ 23,10 say space(49)
do case
case mopt="1"
@ 12,10 clea to 23,79
mboole=space(get_box)
if mtype="D"
@ 12,20 say "Enter "+upper(trim(newfield))+":" get mboole picture "99/99/99"
endif
if mtype="C" .or. mtype="N"
@ 12,20 say "Enter "+upper(newfield) get mboole
endif
read
if mtype="D"
mboo2=ctod(mboole)
endif
if mtype="C"
mboo2=trim(mboole)
endif
if mtype="N"
mboo2=val(mboole)
endif
USE &MNAME INDEX TEMP
set colo to b+/n
@ 13,20 say "Searching data.........."
reindex
copy to holdfile for &newfield>mboo2
use holdfile
if reccount()=0
aa=1
do while aa<20
set colo to b+/n
@ 21,0 say "No records were found which were greater than "+mboole+"."
aa=aa+1
ifaa=20
set colo to gr+/n,w/b+
else
set talk on
set colo to b+/n
@ 14,20 say "Indexing data......"
index on &mfield to hold
use holdfile index hold
set talk off
if no_flds=1
set fields to &field1
endif
if no_flds=2
set fields to &field1,&field2
endif
if no_flds=3
set fields to &field1,&field2,&field3
endif
if no_flds=4
set fields to &field1,&field2,&field3,&field4
endif
set fields on
set colo to *g+/n
? chr(7)
@ 16,20 say "Ready to print....Be sure printer is turned on!"
wait
set colo to b/n
clear
list off to prin
eject
clear
endif
enddo
endif
case mopt="2"
@ 12,10 clea to 23,79
mboole=space(get_box)
if mtype="D"
@ 12,20 say "Enter "+upper(trim(newfield))+":" get mboole picture "99/99/99"
endif
if mtype="C" .or. mtype="N"
@ 12,20 say "Enter "+upper(newfield) get mboole
endif
read
if mtype="D"
mboo2=ctod(mboole)
endif
if mtype="C"
mboo2=trim(mboole)
endif
if mtype="N"
mboo2=val(mboole)
endif
USE &MNAME INDEX TEMP
set colo to b+/n
@ 13,20 say "Searching data.........."
reindex
copy to holdfile for &newfield<mboo2
use holdfile
if reccount()=0
aa=1
do while aa<20
set colo to b+/n
@ 21,0 say "No records were found which were greater than "+mboole+"."
aa=aa+1
ifaa=20
set colo to gr+/n,w/b+
else
set talk on
set colo to b+/n
@ 14,20 say "Indexing data......"
index on &mfield to hold
use holdfile index hold
set talk off
if no_flds=1
set fields to &field1
endif
if no_flds=2
set fields to &field1,&field2
endif
if no_flds=3
set fields to &field1,&field2,&field3
endif
if no_flds=4
set fields to &field1,&field2,&field3,&field4
endif
set fields on
set colo to *g+/n
? chr(7)
@ 16,20 say "Ready to print....Be sure printer is turned on!"
wait
set colo to b/n
clear
list off to prin
eject
clear
endif
enddo
endif
case mopt="3"
@ 12,10 clea to 23,79
mboole=space(get_box)
if mtype="D"
@ 12,20 say "Enter "+upper(trim(newfield))+":" get mboole picture "99/99/99"
endif
if mtype="C" .or. mtype="N"
@ 12,20 say "Enter "+upper(newfield) get mboole
endif
read
if mtype="D"
mboo2=ctod(mboole)
endif
if mtype="C"
mboo2=trim(mboole)
endif
if mtype="N"
mboo2=val(mboole)
endif
USE &MNAME INDEX TEMP
set colo to b+/n
@ 13,20 say "Searching data.........."
reindex
copy to holdfile for &newfield=mboo2
use holdfile
if reccount()=0
aa=1
do while aa<20
set colo to b+/n
@ 21,0 say "No records were found which were equal to "+mboole+"."
aa=aa+1
ifaa=20
set colo to gr+/n,w/b+
else
set talk on
set colo to b+/n
@ 14,20 say "Indexing data......"
index on &mfield to hold
use holdfile index hold
set talk off
if no_flds=1
set fields to &field1
endif
if no_flds=2
set fields to &field1,&field2
endif
if no_flds=3
set fields to &field1,&field2,&field3
endif
if no_flds=4
set fields to &field1,&field2,&field3,&field4
endif
set fields on
set colo to *g+/n
? chr(7)
@ 16,20 say "Ready to print....Be sure printer is turned on!"
wait
set colo to b/n
clear
list off to prin
eject
clear
endif
enddo
endif
case mopt="4"
@ 12,10 clea to 23,79
mboole1=space(get_box)
mboole2=space(get_box)
if mtype="D"
@ 12,20 say "Enter first "+upper(trim(newfield))+":" get mboole1 picture "99/99/99"
@ 14,20 say "Enter last "+upper(trim(newfield))+":" get mboole2 picture "99/99/99"
endif
if mtype="C" .or. mtype="N"
@ 12,20 say "Enter first "+upper(trim(newfield)) get mboole1
@ 14,20 say "Enter last "+upper(trim(newfield)) get mboole2
endif
read
if mtype="D"
mboo2=ctod(mboole1)
mboo3=ctod(mboole2)
endif
if mtype="C"
mboo2=trim(mboole1)
mboo3=trim(mboole2)
endif
if mtype="N"
mboo2=val(mboole1)
mboo3=val(mboole2)
endif
USE &MNAME INDEX TEMP
set colo to b+/n
@ 15,20 say "Searching data.........."
reindex
copy to holdfile for &newfield>=mboo2 .and. &newfield<=mboo3
use holdfile
if reccount()=0
aa=1
do while aa<20
set colo to b+/n
@ 21,0 say "No records were found which were greater than "+mboo2
@ 22,0 say "and less than "+mboo3
aa=aa+1
ifaa=20
set colo to gr+/n,w/b+
else
set talk on
set colo to b+/n
@ 16,20 say "Indexing data......"
index on &mfield to hold
use holdfile index hold
set talk off
if no_flds=1
set fields to &field1
endif
if no_flds=2
set fields to &field1,&field2
endif
if no_flds=3
set fields to &field1,&field2,&field3
endif
if no_flds=4
set fields to &field1,&field2,&field3,&field4
endif
set fields on
set colo to *g+/n
? chr(7)
@ 18,20 say "Ready to print....Be sure printer is turned on!"
wait
set colo to b/n
clear
list off to prin
eject
clear
endif
enddo
endif
case mopt="5"
@ 12,10 clea to 23,79
mboole=space(get_box)
if mtype="D"
@ 12,20 say "Enter "+upper(trim(newfield))+":" get mbooleì
picture "99/99/99"
endif
if mtype="C" .or. mtype="N"
@ 12,20 say "Enter "+upper(newfield) get mboole
endif
read
if mtype="D"
mboo2=ctod(mboole)
endif
if mtype="C"
mboo2=trim(mboole)
endif
if mtype="N"
mboo2=val(mboole)
endif
USE &MNAME INDEX TEMP
set colo to b+/n
@ 13,20 say "Searching data.........."
reindex
copy to holdfile for &newfield<>mboo2
use holdfile
if reccount()=0
aa=1
do while aa<20
set colo to b+/n
@ 21,0 say "No records were found which were greater than "+mboole+"."
aa=aa+1
ifaa=20
set colo to gr+/n,w/b+
else
set talk on
set colo to b+/n
@ 14,20 say "Indexing data......"
index on &mfield to hold
use holdfile index hold
set talk off
if no_flds=1
set fields to &field1
endif
if no_flds=2
set fields to &field1,&field2
endif
if no_flds=3
set fields to &field1,&field2,&field3
endif
if no_flds=4
set fields to &field1,&field2,&field3,&field4
endif
set fields on
set colo to *g+/n
? chr(7)
@ 16,20 say "Ready to print....Be sure printer is turned on!"
wait
set colo to b/n
clear
list off to prin
eject
clear
endif
enddo
endif
case mopt="6"
clear
run del c:\dbase\&mname..dbf
run del c:\dbase\holdfile.dbf
run del c:\dbase\temp.ndx
run del c:\dbase\hold.ndx
save to dgenius
return
endcase
enddo
