home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Product
/
Product.zip
/
oncmd.zip
/
PHONE.PRG
< prev
next >
Wrap
Text File
|
1995-07-17
|
12KB
|
429 lines
************************************************************
* MAIN.PRG for phone system *
************************************************************
set exact off
set deleted on
set fullread on
set exclusive off
set scoreboard on
set delimiters on
ESC =27 && escape key
* -- create database and/or index if they don't exist
if file( "phone.dbf" ) = .f.
do createdbf
do rebuild
else
if file("phonenam.ndx") = .f. .or. file ("phonenam.k") = .f.
do rebuild
endif
endif
use phone index phonenam
mainchoice=1
* --- main processing loop
do while .t.
clear
set message to 24
@ 2,20 say "PHONE LIST MANAGER" font 'Helvetica Bold',18
* --- set frame menu items
declare menu1[5]
declare menu2[4]
menu1[1]= .t. && Horizontal=TRUE Vertical=FALSE
menu1[2]=menu2
menu1[3]="@I3 ~List Database"
menu1[4]="@I4 ~Rebuild Database"
menu1[5]="@I5 ~Quit"
menu2[1]= "~Maintain Database"
menu2[2]="@I21 ~Add Phone Number"
menu2[3]="@I22 ~Change Phone Number"
menu2[4]="@I23 ~Delete Phone Number"
* -- invoke menu and wait for selection
@ 2,4 menu from menu1 to mainchoice
* -- process item selected
do case
case mainchoice = 0 .or. mainchoice = 5 && QUIT
exit
case mainchoice=21 && ADD a new record
do add
case mainchoice=22 && CHANGE an existing record
do modify with .f.
case mainchoice=23 && DELETE an existing record
do modify with .t.
case mainchoice=3 && BROWSE records
do view
case mainchoice=4 && REINDEX database
do rebuild
use phone index phonenam
endcase
enddo
clear
use
set scoreboard off
return
********************* END OF MAIN.PRG *********************
************************************************************
* REBUILD *
************************************************************
proc rebuild
clear
? 'rebuilding... '
use phone
?? dbf(), 'contains', reccount(), 'records...'
SET BREAK OFF && no ctrl breaks please
? 'packing...'
pack
?? ' done packing'
? 'indexing...'
index on upper(trim(lastname))+','+upper(trim(firstname)) to phonenam
?? ' done indexing...'
SET BREAK ON
msg( .f., 'done rebuilding.' )
use
inkey(1)
return
****************** END OF REBUILD.PRG ******************
****************** ADD ******************
proc add
do while .t.
* -- initialize and get data fields
choice = 0
m_first=spaces( len(firstname) )
m_last =spaces( len(lastname) )
m_area =spaces( len(areacode) )
m_phone=spaces( len(phonenum) )
@ 4,1 to 12,77 clear double && draw a box
@ 5.0,3 say " Last name: " get m_last picture '!XXXXXXXXXXXXXXXXXXX'
@ 6.8,3 say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
@ 8.6,3 say " Area code: " get m_area picture '999'
@ 10.4,3 say " Phone #: " get m_phone picture '999-9999'
@ 4.5,60 get choice picture "@*TV ~Add Record;~Quit" size 2.5,15
read
if readkey() = ESC .or. choice = 2 && quit without saving
exit
endif
* -- edit check for required field
if empty( m_last )
msg( .t., "Last name required" )
loop
endif
msg( .f., '' )
* -- add record and replace fields with data from screen
append blank
replace lastname with m_last
replace firstname with m_first
replace areacode with m_area
replace phonenum with m_phone
msg( .f., "Addition of " + trim(m_last) + ", " + trim(m_first) + " successful" )
enddo
return
**************** END OF ADD RECORDS MODULE ****************
************************************************************
* CHANGE or DELETE RECORDS IN PHONE DATABASE
************************************************************
proc modify
para del
* -- set action dependent on parameter passed
act = iif( del, 'Delete', 'Change' )
do while .t.
* -- initialize and get data fields for finding record
m_first=spaces(len(firstname))
m_last=spaces(len(lastname))
m_area=spaces(len(areacode))
m_phone=spaces(len(phonenum))
choice = 0
@ 4,1 to 12,77 clear double && draw a box
@ 5,3 say " Last name: " get m_last picture '!XXXXXXXXXXXXXXXXXXX'
@ 6.8,3 say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
@ 4.5,60 get choice picture "@*TV ~Find Record;~Quit" size 2.5,15
@ 16,3 say "Whose number will you " + act + "?" font 'Helvetica',15
@ 18,3 say 'Note - this search uses INDEX to find match'
read
@ 13,3 clear
if (readkey() = ESC) .or. (choice = 2) && quit without saving
exit
endif
* -- look for exact match for last name, comma, first name
set exact on
seek upper( trim(m_last) + ',' + trim(m_first) )
if found()
&& found exact match - should check
&& code here to see if a duplicate exists
else
set exact off
seek upper( trim( m_last ) )
if .not. found()
msgbox('Phone List', 'No exact match or partial match')
loop
else
* -- partial match found, so let user select record to change/delete
boxrec=boxbrowse(13,8,24,66)
if lastkey() = 27 .or. boxrec = 0
loop
else
goto boxrec
endif
endif
endif
* Okay, we found the name specified (or user picked one)
msg( .f., '' )
*
* Alert user if they have picked a record from browse that doesn't
* match the original search criteria
*
if (lastname <> m_last .and. len(trim(m_last)) > 0) .or. ;
(firstname <> m_first .and. len(trim(m_first)) > 0)
tone( 1000,75 )
@ 14,3 say 'Above was selected as a match for query on ' ;
+ trim(m_last)+ ',' + trim(m_first)
endif
* -- set fields to data from record and prompt user to do a new
* -- search, change/delete, or quit without saving
m_first=firstname
m_last=lastname
m_area=areacode
m_phone=phonenum
choice = 0
@ 5,3 say " Last name: " get m_last picture '!XXXXXXXXXXXXXXXXXXX'
@ 6.8,3 say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
@ 8.6,3 say " Area code: " get m_area picture '999'
@ 10.4,3 say " Phone #: " get m_phone picture '999-9999'
@ 4.5,60 get choice picture "@*TV ~New Search;~"+act+";~Quit" size 2.5,15
read
if (readkey() = ESC) .or. (choice = 3)
exit
endif
if choice = 1 && NEW SEARCH selected
loop
endif
if del && DELETE record
delete
else && CHANGE record
replace lastname with m_last
replace firstname with m_first
replace areacode with m_area
replace phonenum with m_phone
endif
msg( .f., act+" of " + trim(m_last) + "," + trim(m_first) + " successful" )
enddo
return
************ END OF MODIFY RECORDS MODULE ************
***********************************************************
* view.prg VIEW RECORDS IN PHONE DATABASE *
***********************************************************
proc view
do while .t.
* -- initialize and get data fields for selecting records for browse
m_first=spaces( len(firstname) )
m_last =spaces( len(lastname) )
m_area =spaces( len(areacode) )
choice = 0
@ 4,1 to 12,77 clear double && draw a box
@ 5,3 say " Last name = " get m_last picture '!XXXXXXXXXXXXXXXXXXX'
@ 6.8,3 say "First name = " get m_first picture '!XXXXXXXXXXXXXX'
@ 8.6,3 say " Area code = " get m_area picture '999'
@ 4.5,60 get choice picture "@*TV ~List;~Quit" size 2.5,15
@ 14,3 say "Enter Desired Criteria and select List to display"
@ 16,3 say 'Note - this list facility uses filters,'
@ 17,3 say ' therefore you may search multiple fields.'
read
if (readkey() = ESC) .or. (choice = 2) && QUIT
exit
endif
* -- set filter using fields indicated on screen
flt = ''
pre = ''
if .not. empty( m_first )
flt = "upper(firstname)=upper(m_first)"
pre = " .AND. "
endif
if .not. empty( m_last )
flt = flt + pre + "upper(lastname)=upper(m_last)"
pre = " .AND. "
endif
if .not. empty( m_area )
flt = flt + pre + "areacode=m_area"
endif
if len( flt ) > 0
set filter to &flt
endif
* -- BROWSE records with the filter set, if appropriate
goto top
boxrec=boxbrowse(13,1,24,69)
set filter to
enddo
return
*************** END OF VIEW RECORDS MODULE **************
****** CREATE THE DATABASE FROM SCRATCH ******
proc createdbf
* -- array containing fields in PHONE database
dbfflds = mkarray( mkarray( 'FIRSTNAME', 'C', 15 ), ;
mkarray( 'LASTNAME', 'C', 20 ), ;
mkarray( 'AREACODE', 'C', 3 ), ;
mkarray( 'PHONENUM', 'C', 8 ) )
@ 14, 30 say "Creating database ..." + space (20)
create phone from array dbfflds
* -- create list of indices file PHONE.DBX
if .not. file( 'phone.dbx' )
fp = fcreate( 'phone.dbx', 1 )
if fp = -1
msgbox( 'Phone Index List', 'Problem creating Phone Index List', 7 )
else
fseek( fp, 0, 2 )
fwrite( fp, chr(13) + chr(10) + "phonenam=upper(trim(lastname))+', '+upper(trim(firstname))", 60 )
fclose( fp )
endif
endif
use phone
* -- create rec array to hold data for generated records
declare rec[15]
rec[ 1]=mkarray('Jean-Luc', 'Picard' , '417', '527-7269')
rec[ 2]=mkarray('William', 'Riker' , '417', '382-7304')
rec[ 3]=mkarray('', 'Data' , '203', '593-3836')
rec[ 4]=mkarray('Beverly', 'Crusher', '417', '284-8286')
rec[ 5]=mkarray('Deanna', 'Troi', '417', '729-3783')
rec[ 6]=mkarray('', 'Worf' , '203', '280-7289')
rec[ 7]=mkarray('Geordi', 'LaForge', '417', '774-2843')
rec[ 8]=mkarray('Lwaxana', 'Troi', '203', '824-2844')
rec[ 9]=mkarray('Wesley', 'Crusher', '809', '587-2798')
rec[10]=mkarray('', 'Guinan', '809', '483-2193')
rec[11]=mkarray('Tasha', 'Yar', '417', '387-8458')
rec[12]=mkarray('Miles', "O'Brien", '203', '583-3987')
rec[13]=mkarray('Ro', 'Laren', '417', '964-2947')
rec[14]=mkarray('', 'Q', '666', '840-3928')
rec[15]=mkarray('Gene', 'Rodenberry','809', '382-4287')
* -- loop to add records
clear
for i = 1 to len( rec )
append blank
@ 1,1 SAY 'Adding ' + STR(recno()) + ',' + rec[i][1] + ',' + rec[i][2] + ',' + rec[i][3] + ',' + rec[i][4] + spaces(10)
replace lastname with rec[i][2]
replace areacode with rec[i][3]
replace phonenum with rec[i][4]
replace firstname with rec[i][1]
next
use
return
**** MESSAGE FUNC ****
func msg
para err, s
if len(s) <> 0
if .not. err
* success
tone( 1000, 100 )
tone( 1500, 100 )
tone( 2000, 100 )
else
* error
tone( 2000, 150 )
tone( 1000, 150 )
endif
endif
@ 13,6 clear
@ 13,6 say s
return .t.
* --- end ---