Shareware Overload/ShartewareOverload.cdr/database/dgenius.zip/DGENI002.PRG

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