home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dgenius.zip
/
DGENI002.PRG
< prev
next >
Wrap
Text File
|
1987-01-31
|
7KB
|
337 lines
* System....: dGENIUS
* Program...: dGENI002.prg
* Purpose...: Database File Appender
* Requires..: INSTALDG.prg,STRUX.dbf,SKELETON.dbf
* Author....: Brian Corll
* Dates.....: 01/22/87
* Notice....: copyright 1987 the Author
* Version...: 1.0 (x3)
Procedure Appender
set esca off
clear
set defa to a
set path to
mdrive=space(1)
set colo to gr+/n,w/b+
@ 1,0 say "Place the diskette containing your database in drive A."
wait "Press the Enter key when you are ready."
ap=.t.
do while ap
clear
@ 1,0 say "The following files are available on drive A:"
dir A:
dbfname=space(8)
@ 23,0 say "Which database do you want to append?" get dbfname picture "!!!!!!!!"
@ 24,0 say "Enter RETURN if no database files are shown."
read
if upper(dbfname)="RETURN"
@ 23,0 clea to 24,79
@ 23,0 say "Put the correct diskette in the same drive!"
wait
loop
else
endif
if .not. file('&dbfname..dbf')
do while .not. file('&dbfname..dbf')
? chr(7),chr(7),chr(7)
set colo to r+/n
dbfname=space(8)
@ 24,0 clear
@ 24,0 say "Incorrect file name. Try again:" get dbfname picture "!!!!!!!!"
read
if file('&dbfname..dbf')
exit
else
endif
enddo
else
endif
set colo to gr+/n,w/b+
use &dbfname
bc=.t.
do while bc
clear
am=space(1)
@ 1,0 say "Enter A to add,M to return to the menu:" get am picture "!"
@ 2,0 say "Press the Ctrl and End keys when you are finished adding or editing records."
read
if am="A"
appe blank
brow
endif
if am="M"
clear
ok=space(1)
set colo to bg+/n
@ 1,0 say "Do you want to make a backup copy of your database? (Y or N)" get ok picture "!"
read
if ok="Y"
set colo to rb+/n
@ 3,0 say "Place the backup diskette in drive B."
wait "Press the Enter key when you are ready."
copyname=trim(dbfname)
run copy a:\©name..dbf b:/v
clear
set colo to g+/n
@ 1,0 say "Backup copy complete and verified."
wait "Press the Enter key to return to the menu."
set defa to c
set path to c:\dbase
bc=.f.
exit
endif
if ok="N"
set defa to c
set path to c:\dbase
bc=.f.
exit
endif
endif
enddo
return
Procedure Finder
clear
set colo to gr+/n,n/bg+
set defa to a
set path to
set scor on
@ 1,0 say "Place the diskette containing your database file in ;
drive A."
wait "Press the Enter key when you're ready."
dbfname=space(8)
clear
@ 1,0 say "The following database files are available on drive A:"
dir a:
@ 24,0 say "Which database file do you want to use?" get dbfname ;
picture "!!!!!!!!"
read
if .not. file('&dbfname..dbf')
do while .not. file('&dbfname..dbf')
? chr(7)
@ 24,0 clear
@ 24,0 say "Incorrect file name. Enter again:" get dbfname ;
picture "!!!!!!!!"
read
if file('&dbfname..dbf')
exit
else
loop
endif
enddo
endif
clear
copyname=trim(dbfname)
@ 1,0 say "Copying the "+upper(copyname)+" database file......"
run copy a:\©name..dbf c:\dbase/v
set defa to c
set path to c:\dbase
use ©name
copy stru exte to skeleton
use skeleton
store reccount() to mem1
go top
x=2
y=0
clear
@ 1,0 say "The following fields are available in the "+dbfname+" database file:"
do while .not. eof()
@ x,y say ltrim(str(recno()))+". "+upper(field_name)
x=x+1
if x=24
x=2
y=15
endif
if x=24 .and. y=15
x=2
y=30
endif
if x=24 .and. y=30
x=2
y=45
endif
if x=24 .and. y=45
x=2
y=60
endif
skip
enddo
fldno=0
@ 24,0 say "Enter the number of the field you want to use to find a record:" get fldno ;
picture "@Z 999" range 1,mem1
read
go fldno
mfield=field_name
get_box=field_len
mtype=field_type
@ 24,0 clear
@ 24,0 say "Creating a new index for the "+upper(copyname)+" database."
use ©name
set talk on
index on &mfield to new
set talk off
bc=.t.
do while bc
use ©name index new
clear
findfld=space(get_box)
if mtype="D"
oktogo=space(1)
@ 1,0 say "Enter C to continue,R to return to the menu:" get oktogo pict "!"
read
if oktogo="R"
clear
@ 1,0 say "RETURNING TO MENU...."
exit
else
endif
@ 1,0 clear
@ 1,0 say "Enter the "+trim(upper(mfield))+" you wish to find:" get findfld pict "@D"
read
@ 2,0 say "Searching database...."
loca for &mfield=ctod('&findfld')
if .not. found()
@ 3,0 say "I cannot find a record for the date "+findfld+"."
gonogo=space(1)
@ 4,0 say "Do you want to try again?" get gonogo pict "!"
read
if gonogo="Y"
loop
endif
if gonogo="N"
bc=.f.
exit
endif
else
@ 3,0 say "I found the record you want."
mporvee=space(1)
@ 4,0 say "To print it, enter a P."
@ 5,0 say "To view it , enter a V."
@ 6,0 say "To change it,enter a C."
@ 7,0 say "To delete it, enter a D."
@ 8,0 say "Enter choice here:======>" get mporvee pict "!"
read
do case
case mporvee="P"
disp to prin
case mporvee="V"
clear
disp
wait
case mporvee="C"
brow
case mporvee="D"
dele
@ 24,0 say "REMOVING RECORD FROM DATABASE....."
pack
endcase
endif
endif
if mtype="C" .or. mtype="N"
oktogo=space(1)
@ 1,0 say "Enter C to continue,R to return to the menu:" get oktogo pict "!"
read
if oktogo="R"
clear
@ 1,0 say "RETURNING TO MENU...."
exit
else
endif
@ 1,0 clear
@ 1,0 say "Enter the "+trim(upper(mfield))+" you want to find:" get findfld picture "@!"
read
endif
if mtype="L"
oktogo=space(1)
@ 1,0 say "Enter C to continue,R to return to the menu:" get oktogo pict "!"
read
if oktogo="R"
clear
@ 1,0 say "RETURNING TO MENU...."
exit
else
endif
@ 1,0 clear
@ 1,0 say "Enter the "+trim(upper(mfield))+" you want to find:" get findfld pict "!"
read
endif
if mtype<>"D"
find_me=trim(findfld)
find &find_me
endif
if .not. found()
@ 2,0 say "I cannot locate a record for "+upper(find_me)+"!"
yesno=space(1)
@ 3,0 say "Do you want to try another "+trim(upper(mfield))+"?" get yesno picture "!"
read
if yesno="Y"
loop
endif
if yesno="N"
bc=.f.
exit
endif
else
@ 2,0 say "I found the record you want."
mporvee=space(1)
@ 3,0 say "If you want to print it,enter P."
@ 4,0 say "If you want to view it,enter V."
@ 5,0 say "If you want to change it, enter C."
@ 6,0 say "If you want to delete it,enter D."
@ 7,0 say "Enter choice here:=====>" get mporvee picture "!"
read
do case
case mporvee="P"
disp to prin
case mporvee="V"
clear
disp
mqorno=space(1)
@ 24,0 say "Do you want to look for another record?" get mqorno picture "!"
read
if mqorno="Y"
loop
endif
if mqorno="N"
bc=.f.
exit
endif
case mporvee="C"
brow
case mporvee="D"
@ 24,0 say "REMOVING RECORD FROM DATABASE...."
dele
pack
endcase
endif
enddo
clear
@ 1,0 say "RETURNING TO MENU...."
run copy c:\dbase\©name..dbf a:/v
run del c:\dbase\©name..dbf
run del c:\dbase\new.ndx
return