home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Product / Product.zip / oncmd.zip / PHONE.PRG < prev    next >
Text File  |  1995-07-17  |  12KB  |  429 lines
  1. ************************************************************
  2. *                     MAIN.PRG for phone system            *
  3. ************************************************************
  4.  
  5. set exact off
  6. set deleted on
  7. set fullread on
  8. set exclusive off
  9. set scoreboard on
  10. set delimiters on
  11.  
  12. ESC  =27       && escape key
  13.  
  14. * -- create database and/or index if they don't exist
  15. if file( "phone.dbf" ) = .f. 
  16.     do createdbf
  17.     do rebuild
  18. else
  19.     if file("phonenam.ndx") = .f. .or. file ("phonenam.k") = .f.
  20.         do rebuild
  21.     endif
  22. endif
  23.  
  24. use phone index phonenam
  25.  
  26. mainchoice=1
  27.  
  28. * --- main processing loop
  29. do while .t.
  30.  
  31.     clear
  32.     set message to 24
  33.     @  2,20 say "PHONE LIST MANAGER" font 'Helvetica Bold',18
  34.  
  35. * --- set frame menu items
  36.     declare menu1[5]
  37.     declare menu2[4]
  38.  
  39.         
  40.     menu1[1]= .t.   && Horizontal=TRUE Vertical=FALSE
  41.    
  42.     menu1[2]=menu2
  43.     
  44.    menu1[3]="@I3  ~List Database"
  45.     
  46.    menu1[4]="@I4  ~Rebuild Database"
  47.     
  48.    menu1[5]="@I5  ~Quit"
  49.     
  50.     menu2[1]=     "~Maintain Database"
  51.     menu2[2]="@I21 ~Add Phone Number"
  52.     menu2[3]="@I22 ~Change Phone Number"
  53.     menu2[4]="@I23 ~Delete Phone Number"
  54.     
  55. * -- invoke menu and wait for selection
  56.     @ 2,4 menu from menu1 to mainchoice
  57.     
  58. * -- process item selected
  59.     do case
  60.         
  61.         case mainchoice = 0 .or. mainchoice = 5   && QUIT
  62.             exit
  63.         
  64.         case mainchoice=21        && ADD a new record
  65.             do add
  66.         
  67.         case mainchoice=22        && CHANGE an existing record
  68.             do modify with .f.
  69.         
  70.         case mainchoice=23        && DELETE an existing record
  71.             do modify with .t.
  72.         
  73.         case mainchoice=3         && BROWSE records
  74.             do view
  75.         
  76.         case mainchoice=4         && REINDEX database
  77.             do rebuild
  78.             use phone index phonenam
  79.     endcase
  80. enddo
  81.  
  82. clear
  83. use
  84. set scoreboard off
  85. return
  86.  
  87. *********************    END OF MAIN.PRG      *********************
  88.  
  89. ************************************************************
  90. *                    REBUILD                               *
  91. ************************************************************
  92. proc rebuild
  93. clear
  94. ? 'rebuilding...  '
  95.  
  96. use phone
  97.  
  98. ?? dbf(), 'contains', reccount(), 'records...'
  99.  
  100. SET BREAK OFF   && no ctrl breaks please
  101.  
  102. ? 'packing...'
  103. pack
  104. ?? '  done packing'
  105.  
  106. ? 'indexing...'
  107. index on upper(trim(lastname))+','+upper(trim(firstname)) to phonenam
  108.  
  109. ?? '  done indexing...'
  110.  
  111. SET BREAK ON
  112.  
  113. msg( .f., 'done rebuilding.' )
  114.  
  115. use
  116. inkey(1)
  117.  
  118. return
  119. ******************    END OF REBUILD.PRG        ******************
  120.  
  121.  
  122. ******************       ADD                  ******************
  123.  
  124. proc add
  125.  
  126. do while .t.
  127.      
  128. * -- initialize and get data fields
  129.     choice = 0
  130.     m_first=spaces( len(firstname) )
  131.     m_last =spaces( len(lastname)  )
  132.     m_area =spaces( len(areacode)  )
  133.     m_phone=spaces( len(phonenum)  )
  134.  
  135.     @  4,1    to 12,77 clear double  && draw a box
  136.     @  5.0,3  say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
  137.     @  6.8,3  say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
  138.     @  8.6,3  say " Area code: " get m_area  picture '999'
  139.     @  10.4,3 say "   Phone #: " get m_phone picture '999-9999'
  140.     @  4.5,60                    get choice  picture "@*TV ~Add Record;~Quit" size 2.5,15
  141.  
  142.     read
  143.  
  144.     if readkey() = ESC .or. choice = 2     && quit without saving
  145.         exit
  146.      endif
  147.         
  148. * -- edit check for required field
  149.     if empty( m_last )
  150.         msg( .t., "Last name required" )
  151.         loop
  152.     endif
  153.  
  154.     msg( .f., '' )
  155.  
  156. * -- add record and replace fields with data from screen
  157.     append blank
  158.     replace lastname with m_last
  159.     replace firstname with m_first
  160.     replace areacode with m_area
  161.     replace phonenum with m_phone
  162.         
  163.     msg( .f., "Addition of " + trim(m_last) + ", " + trim(m_first) + " successful" )
  164.  
  165. enddo
  166. return
  167. ****************    END OF ADD RECORDS MODULE        ****************
  168.  
  169.  
  170. ************************************************************
  171. *                 CHANGE or DELETE RECORDS IN PHONE DATABASE
  172. ************************************************************
  173. proc modify
  174. para del
  175.  
  176. * -- set action dependent on parameter passed
  177. act = iif( del, 'Delete', 'Change' )
  178.  
  179. do while .t.
  180.  
  181. * -- initialize and get data fields for finding record
  182.     m_first=spaces(len(firstname))
  183.     m_last=spaces(len(lastname))
  184.     m_area=spaces(len(areacode))
  185.     m_phone=spaces(len(phonenum))
  186.  
  187.     choice = 0
  188.  
  189.     @ 4,1 to 12,77 clear double && draw a box
  190.  
  191.     @ 5,3   say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
  192.     @ 6.8,3 say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
  193.     @ 4.5,60  get choice  picture "@*TV ~Find Record;~Quit" size 2.5,15
  194.  
  195.     @ 16,3 say "Whose number will you " + act + "?" font 'Helvetica',15
  196.  
  197.     @ 18,3 say 'Note - this search uses INDEX to find match'
  198.  
  199.     read
  200.  
  201.      @ 13,3 clear
  202.      
  203.     if (readkey() = ESC) .or. (choice = 2)  && quit without saving
  204.         exit
  205.     endif
  206.  
  207. * -- look for exact match for last name, comma, first name
  208.     set exact on                                                
  209.     seek upper( trim(m_last) + ',' + trim(m_first) )
  210.  
  211.     if found()
  212.                     && found exact match - should check
  213.                       && code here to see if a duplicate exists
  214.     else 
  215.             set exact off
  216.             seek upper( trim( m_last ) )
  217.             if .not. found()
  218.                 msgbox('Phone List', 'No exact match or partial match')
  219.                 loop
  220.             else
  221. * -- partial match found, so let user select record to change/delete
  222.                boxrec=boxbrowse(13,8,24,66)
  223.                if lastkey() = 27 .or. boxrec = 0
  224.                    loop
  225.                else
  226.                    goto boxrec
  227.                endif
  228.            endif
  229.     endif
  230.  
  231. * Okay, we found the name specified (or user picked one)
  232.  
  233.    msg( .f., '' )
  234.  
  235. *
  236. * Alert user if they have picked a record from browse that doesn't 
  237. *          match the original search criteria
  238. *
  239.  
  240.    if (lastname  <> m_last  .and. len(trim(m_last))  > 0) .or.    ;
  241.        (firstname <> m_first .and. len(trim(m_first)) > 0) 
  242.       tone( 1000,75 )
  243.       @ 14,3 say 'Above was selected as a match for query on ' ; 
  244.                      + trim(m_last)+ ',' + trim(m_first)
  245.    endif
  246.  
  247. * -- set fields to data from record and prompt user to do a new
  248. * -- search, change/delete, or quit without saving
  249.    m_first=firstname
  250.    m_last=lastname
  251.    m_area=areacode
  252.    m_phone=phonenum
  253.    choice = 0
  254.    @  5,3    say " Last name: " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
  255.    @  6.8,3  say "First name: " get m_first picture '!XXXXXXXXXXXXXX'
  256.    @  8.6,3  say " Area code: " get m_area  picture '999'
  257.    @  10.4,3 say "   Phone #: " get m_phone picture '999-9999'
  258.    @  4.5,60                   get choice  picture "@*TV ~New Search;~"+act+";~Quit" size 2.5,15
  259.    read
  260.  
  261.    if (readkey() = ESC) .or. (choice = 3)
  262.       exit
  263.    endif
  264.  
  265.     if choice = 1       && NEW SEARCH selected
  266.         loop
  267.     endif
  268.         
  269.     if del              && DELETE record
  270.         delete
  271.     else                && CHANGE record
  272.         replace lastname with m_last
  273.         replace firstname with m_first
  274.         replace areacode with m_area
  275.         replace phonenum with m_phone
  276.     endif
  277.  
  278.     msg( .f., act+" of " + trim(m_last) + "," + trim(m_first) + " successful" )
  279.  
  280. enddo
  281.  
  282. return
  283. ************      END OF MODIFY RECORDS MODULE                ************
  284.  
  285.  
  286. ***********************************************************
  287. *  view.prg        VIEW RECORDS IN PHONE DATABASE         *
  288. ***********************************************************
  289. proc view
  290.  
  291. do while .t.
  292.  
  293. * -- initialize and get data fields for selecting records for browse
  294.     m_first=spaces( len(firstname) )
  295.     m_last =spaces( len(lastname)  )
  296.     m_area =spaces( len(areacode)  )
  297.     choice = 0
  298.  
  299.     @  4,1     to 12,77 clear double           && draw a box
  300.     @  5,3     say " Last name = " get m_last  picture '!XXXXXXXXXXXXXXXXXXX'
  301.     @  6.8,3   say "First name = " get m_first picture '!XXXXXXXXXXXXXX'
  302.     @  8.6,3   say " Area code = " get m_area  picture '999'
  303.     @  4.5,60                     get choice  picture "@*TV ~List;~Quit" size 2.5,15
  304.     @  14,3    say "Enter Desired Criteria and select List to display"
  305.  
  306.     @  16,3 say 'Note - this list facility uses filters,'
  307.     @  17,3 say '       therefore you may search multiple fields.'
  308.  
  309.     read 
  310.  
  311.     if (readkey() = ESC) .or. (choice = 2)  && QUIT
  312.         exit
  313.     endif
  314.  
  315. * -- set filter using fields indicated on screen
  316.     flt = ''
  317.      pre = ''
  318.      if .not. empty( m_first )
  319.          flt = "upper(firstname)=upper(m_first)"
  320.          pre = " .AND. "
  321.      endif
  322.  
  323.      if .not. empty( m_last )
  324.          flt = flt + pre + "upper(lastname)=upper(m_last)"
  325.          pre = " .AND. "
  326.      endif
  327.  
  328.      if .not. empty( m_area )
  329.          flt = flt + pre + "areacode=m_area"
  330.      endif
  331.  
  332.      if len( flt ) > 0 
  333.          set filter to &flt
  334.      endif
  335.      
  336. * -- BROWSE records with the filter set, if appropriate
  337.      goto top
  338.      boxrec=boxbrowse(13,1,24,69)
  339.      set filter to
  340.      
  341. enddo
  342.  
  343. return
  344. ***************    END OF VIEW RECORDS MODULE            **************
  345.  
  346.  
  347.  
  348. ****** CREATE THE DATABASE FROM SCRATCH ******
  349. proc createdbf
  350.  
  351. * -- array containing fields in PHONE database
  352. dbfflds = mkarray( mkarray( 'FIRSTNAME', 'C', 15 ), ;
  353.                    mkarray( 'LASTNAME', 'C', 20 ), ;
  354.                    mkarray( 'AREACODE',  'C', 3 ), ;
  355.                    mkarray( 'PHONENUM',  'C', 8 ) )
  356.  
  357.     
  358.     @ 14, 30 say "Creating database ..." + space (20)
  359.     create phone from array dbfflds
  360.  
  361. * -- create list of indices file PHONE.DBX
  362.     if .not. file( 'phone.dbx' )
  363.         fp = fcreate( 'phone.dbx', 1 )
  364.         if fp = -1
  365.             msgbox( 'Phone Index List', 'Problem creating Phone Index List', 7 )
  366.         else
  367.             fseek( fp, 0, 2 )
  368.             fwrite( fp, chr(13) + chr(10) + "phonenam=upper(trim(lastname))+', '+upper(trim(firstname))", 60 )
  369.             fclose( fp )
  370.         endif
  371.     endif
  372.  
  373.     use phone
  374.  
  375. * -- create rec array to hold data for generated records
  376.     declare rec[15]
  377.     rec[ 1]=mkarray('Jean-Luc', 'Picard' ,   '417', '527-7269')
  378.     rec[ 2]=mkarray('William',  'Riker'  ,   '417', '382-7304')
  379.     rec[ 3]=mkarray('',         'Data'   ,   '203', '593-3836')
  380.     rec[ 4]=mkarray('Beverly',  'Crusher',   '417', '284-8286')
  381.     rec[ 5]=mkarray('Deanna',   'Troi',      '417', '729-3783')
  382.     rec[ 6]=mkarray('',         'Worf'   ,   '203', '280-7289')
  383.     rec[ 7]=mkarray('Geordi',   'LaForge',   '417', '774-2843')
  384.     rec[ 8]=mkarray('Lwaxana',  'Troi',      '203', '824-2844')
  385.     rec[ 9]=mkarray('Wesley',   'Crusher',   '809', '587-2798')
  386.     rec[10]=mkarray('',         'Guinan',    '809', '483-2193')
  387.     rec[11]=mkarray('Tasha',    'Yar',       '417', '387-8458')
  388.     rec[12]=mkarray('Miles',    "O'Brien",   '203', '583-3987')
  389.     rec[13]=mkarray('Ro',       'Laren',     '417', '964-2947')
  390.     rec[14]=mkarray('',         'Q',         '666', '840-3928')
  391.     rec[15]=mkarray('Gene',     'Rodenberry','809', '382-4287')
  392.  
  393. * -- loop to add records
  394.     clear
  395.     for i = 1 to len( rec )
  396.         append blank
  397.         @ 1,1 SAY 'Adding ' + STR(recno()) + ',' + rec[i][1] + ',' + rec[i][2] + ',' + rec[i][3] + ',' + rec[i][4] + spaces(10)
  398.         replace lastname  with rec[i][2]
  399.         replace areacode  with rec[i][3]
  400.         replace phonenum  with rec[i][4]
  401.         replace firstname with rec[i][1]
  402.     next
  403.     use
  404. return
  405.  
  406.  
  407. **** MESSAGE FUNC ****
  408. func msg
  409. para err, s
  410.  
  411. if len(s) <> 0
  412.     if .not. err
  413.         * success
  414.         tone( 1000, 100 )
  415.         tone( 1500, 100 )
  416.         tone( 2000, 100 )
  417.     else
  418.         * error
  419.         tone( 2000, 150 )
  420.         tone( 1000, 150 )
  421.     endif
  422. endif
  423.  
  424. @ 13,6 clear
  425. @ 13,6 say s    
  426. return .t.
  427.  
  428. * --- end --- 
  429.