home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / clipper / nannws14.arc / MININET.PRG < prev    next >
Text File  |  1987-05-28  |  13KB  |  376 lines
  1. * MININET.PRG
  2. *
  3. * Date:       April, 1987
  4. * Author:  David Morgan
  5. * Notes:   Mini-program to demonstrate, in Clipper,
  6. *           1)  when private data control is and isn't needed 
  7. *               on a network, and
  8. *           2)  programming techniques for using the two tools
  9. *               that achieve private control (namely, locks on 
  10. *               files under shared use; and exclusive use)
  11. *
  12. *        To compile and link, required files are: 
  13. *             MININET.PRG  LOCKS.PRG  CLIPPER.LIB  DBU.LIB
  14. *           Syntax:
  15. *             CLIPPER MININET
  16. *             LINK MININET,,,CLIPPER DBU
  17. *
  18. *           Uses test file STATES.DBF containing records
  19. *            for the 13 original states
  20. *
  21. *           Structure of STATES.DBF
  22. *
  23. *           Field  Field Name  Type       Width    Dec
  24. *           1  ST_ABBREV   Character      2
  25. *           2  ST_NAME     Character     20
  26. *           3  ST_CAPITAL  Character     20
  27. *           4  ST_UPDATED  Numeric       10
  28. *
  29. *              4th field is update marker (signature field)
  30. *               for flagging all writes to the record
  31. *
  32. *           Corresponding Index Files     Key Expression
  33. *           STATES1.NTX                   ST_ABBREV
  34. *           STATES2.NTX                   ST_NAME 
  35. *           STATES3.NTX                   ST_CAPITAL
  36. *
  37.  
  38. CLEAR
  39. SET PROCEDURE TO LOCKS
  40. SET MESSAGE TO 23
  41. SET KEY -1 TO VIEW_FILE
  42. SET EXCLUSIVE OFF
  43. bell = CHR(7)
  44. st_list = "AK AL AR AZ CA CO CT DC DE FL GA HI IA ID IL IN KS ";
  45.         + "KY LA MA MD ME MI MN MO MS MT NC ND NE NH NJ NM NV ";
  46.         + "NY OH OK OR PA RI SC SD TN TX UT VA VT WA WI WV WY "
  47. IF NET_USE("STATES",.F.,5)
  48.  SET INDEX TO STATES1,STATES2,STATES3
  49. ELSE
  50.  ? 'File not avaiable for shared use. Program terminated.'
  51.  RETURN
  52. ENDIF
  53. @ 1,0 SAY CENTER("===  MININET: Miniature Clipper Network Application  ===",80)
  54. @ 4,45 SAY 'F2 key to view file contents'
  55.  
  56. DO WHILE .T.
  57.  @  8,25 PROMPT "1. ADD RECORD"  MESSAGE CENTER(">>> NO LOCKING Needed for APPEND BLANK <<<",80)
  58.  @  9,25 PROMPT "2. EDIT RECORD"  MESSAGE CENTER(">>> Record Locking Needed to REPLACE <<<",80)
  59.  @ 10,25 PROMPT "3. EXAMINE/PRINT/REPORT"  MESSAGE CENTER(">>> NO LOCKING Needed for These Passive Operations <<<",80)
  60.  @ 11,25 PROMPT "4. MAINTAIN FILE"  MESSAGE CENTER(">>> File Locking or Exclusive Use Needed <<<",80)
  61.  @ 12,25 PROMPT "5. QUIT"
  62.  MENU TO choice1
  63.  @ 8,0 CLEAR TO 12,79
  64.  @ 23,0
  65.  DO CASE
  66.   CASE choice1 = 1
  67.    DO ADD
  68.   CASE choice1 = 2
  69.    DO EDIT
  70.   CASE choice1 = 3
  71.    SET INDEX TO STATES2
  72.    DO EXAMINE
  73.    SET INDEX TO STATES1,STATES2,STATES3
  74.   CASE choice1 = 4
  75.    DO MAINTAIN
  76.   CASE choice1 = 5
  77.    EXIT
  78.  ENDCASE
  79.  @ 15,0 CLEAR TO 20,79
  80. ENDDO
  81. CLEAR
  82. RETURN
  83. *======================================================================================================================
  84.  
  85. PROCEDURE ADD
  86. m_abbrev='  '
  87. @ 15,10 SAY 'Give abbreviation for this state' GET m_abbrev VALID CHECK_ST()
  88. READ
  89. IF EMPTY(m_abbrev)
  90.  RETURN
  91. ELSE
  92.  IF ADD_REC(5)
  93.   REPLACE st_abbrev WITH UPPER(m_abbrev)      && ADD_REC already RLOCKed for us
  94.   @ 23,0 SAY CENTER("Record added.",80)
  95.  ELSE
  96.   @ 23,0 SAY CENTER("Can't add record.",80)
  97.  ENDIF
  98.  ?? bell
  99.  INKEY(1)
  100.  RETURN
  101. ENDIF
  102.  
  103. FUNCTION CHECK_ST                             && must be a real state
  104. m_abbrev = UPPER(m_abbrev)                    && not already in file
  105. SEEK m_abbrev
  106. RETURN( IF(.NOT.FOUND().AND.(m_abbrev+' ')$st_list,.T.,.F.) )
  107. *----------------------------------------------------------------------------------------------------------------------
  108.  
  109. PROCEDURE EDIT
  110.  DO WHILE .T.                                &&         ^
  111.   *************************************                    &&        |
  112.   * Select a record to edit                        &&          |
  113.   *************************************                    &&         |
  114. *-contingency branch point A              <-------------------------------------    |
  115.   choice2=0                                                             &&      |   |
  116.   choice3=0                                &&      |   |
  117.   m_abbrev = '  '                            &&      |   |
  118.   @ 15,10 SAY 'Which state do you want (give abbreviation)?' GET m_abbrev &&    |   |
  119.   READ                                    &&      |   |
  120.   @ 15,10                                &&      |   |
  121.   SEEK UPPER(m_abbrev)                            &&      |   |
  122.   IF .NOT.FOUND()                            &&      |   |
  123.    @ 15,10 SAY 'No such state.'                     &&      |   |
  124.    INKEY(2)                                &&      |   |
  125.    @ 15,0 CLEAR TO 20,79                        &&      |   |
  126.    EXIT                                    &&      |   |
  127.   ENDIF                                    &&      |   |
  128.   *************************************                    &&      |   |
  129.   * Edit selected record                        &&      |   |
  130.   *************************************                    &&      |   |   
  131.   DO WHILE .T.                                &&      |   |
  132. *-contingency branch point B          <----------------------------------------------
  133.    m_updated = st_updated                        &&      |   |   |
  134.    m_name = st_name                            &&      |   |   |
  135.    m_capital = st_capital                        &&      |   |   |
  136.    @ 16,10 SAY 'State abbreviation: '+st_abbrev                &&      |   |   |
  137.    @ 18,10 SAY 'Edit state name:    ' GET m_name            &&      |   |   |
  138.    @ 19,10 SAY 'Edit state capital: ' GET m_capital            &&      |   |   |
  139.    READ                                    &&      |   |   |
  140.    DO WHILE .T.                                &&      |   |   |
  141. *-contingency branch point C                        &&      |   |   |
  142.     ***************************************                &&      |   |   |
  143.     * Can't LOCK record - optional branches                &&      |   |   |
  144.     *************************************** &&                        <--------    |   |   |
  145.     IF .NOT.REC_LOCKER(5)                        &&  |   |   |   |
  146.      @ 18,0                                &&  |   |   |   |
  147.      @ 19,10 SAY 'Record NOT AVAILABLE now. Choose a contingency plan: '&&  |   |   |   |
  148.      @ 20,12 PROMPT "1. Retry the lock. Maybe it will free up." &&__________|   |   |   |
  149.      @ 21,12 PROMPT "2. Go back and try locking a different record." &&_________|   |   |
  150.      @ 22,12 PROMPT "3. Abort. Leave edit session, back to main menu."  &&__________|   |
  151.      MENU TO choice2                            &&        |   |
  152.      @ 19,0 CLEAR TO 22,79                        &&        |   |
  153.                         DO CASE            && branch control
  154.                          CASE choice2=1        &&        |   |
  155.                           LOOP            && to pt C direct
  156.                          CASE choice2=2        &&        |   |
  157.                           EXIT            && to pt A indirect
  158.                          OTHERWISE        &&        |   |
  159.                           RETURN        &&        |   |
  160.                         ENDCASE            &&        |   |
  161.     ENDIF                                &&        |   |
  162.     *********************************************            &&        |   |
  163.     * Record contents altered - optional branches            &&        |   |
  164.     *********************************************            &&        |   |
  165.     IF m_updated <> st_updated                        &&        |   |
  166.      UNLOCK                                && relinquish record
  167.      @ 18,0                                &&        |   |
  168.      @ 19,10 SAY "You LOCKED record BUT it's CHANGED. Choose a contingency plan: "&&|   |
  169.      @ 20,12 PROMPT "1. Let me re-edit the new contents of current record." &&__________
  170.      @ 21,12 PROMPT "2. Put my changes in TEMP file. Apply to main file later." &&  |
  171.      @ 22,12 PROMPT "3. Abort. Leave edit session, back to main menu." &&___________|
  172.      MENU TO choice3
  173.      @ 19,0 CLEAR TO 22,79
  174.                         DO CASE            && branch control
  175.                          CASE choice3=1
  176.                           EXIT            && to pt B direct
  177.                          CASE choice3=2
  178.                           *DO TEMP_STORE        && your routine
  179.                           RETURN
  180.                          OTHERWISE
  181.                           RETURN
  182.                         ENDCASE
  183.     ENDIF
  184.   *************************************
  185.   * REPLACE fields in locked record
  186.   *************************************
  187.     REPLACE st_name WITH m_name
  188.     REPLACE st_capital WITH m_capital
  189.     REPLACE st_updated WITH st_updated+1
  190.     UNLOCK
  191.     @ 23,0 SAY CENTER('Data Written To File',80)
  192.     ?? bell
  193.     INKEY(1)
  194.     RETURN          && edit has been completed
  195.    ENDDO :C
  196.                         IF choice2=2    && branch control
  197.                          EXIT        && to pt A direct
  198.                         ENDIF
  199.   ENDDO :B
  200.  ENDDO :A
  201. RETURN
  202. *----------------------------------------------------------------------------------------------------------------------
  203.  
  204. PROCEDURE EXAMINE
  205. PRIVATE top,left,bottom,right,row,end_file
  206. top    = 11
  207. left   = 17
  208. bottom = 20
  209. right  = 60
  210. SAVE SCREEN
  211. CLEAR
  212. TEXT
  213.  You can read through a lock. Locks at other stations don't affect
  214.   passive operations like:
  215.  
  216.   LIST  SEEK/SKIP/GOTO  REPORT  @..SAY <fieldname>
  217.  
  218.  And this station doesn't need to do any locking to execute such commands.
  219.  
  220.  For example, this display runs identically regardless of others' locks in
  221.   the file being displayed: 
  222. ENDTEXT
  223. @ top,left TO bottom,right DOUBLE
  224. row = top+1
  225. FOR I = 1 to (bottom-top-1)
  226.  SAYIT(row)
  227.  row = row  + 1
  228.  SKIP                && unaffected by others' locks
  229. NEXT                    
  230. GO TOP
  231. end_file = .F.
  232. DO WHILE .NOT.end_file
  233.  INKEY(.3)
  234.  SKIP (bottom-top-1)
  235.  IF EOF()
  236.   SKIP -(bottom-top-1)
  237.   end_file = .T.
  238.  ELSE
  239.   SCROLL(top+1,left+1,bottom-1,right-1,1)
  240.   SAYIT(bottom-1)
  241.   SKIP -(bottom-top-2)
  242.  ENDIF
  243. ENDDO
  244. @ 24,2 SAY 'Press any key to continue . . . '
  245. INKEY(0)
  246. RESTORE SCREEN
  247. RETURN
  248.  
  249. FUNCTION SAYIT
  250. PRIVATE row
  251. PARAMETERS row
  252.  f2=FIELDNAME(2)
  253.  f3=FIELDNAME(3)
  254.  @ row,left+2 say &f2.            && unaffected by others'
  255.  @ row,left+(right-left)/2 SAY &f3.    &&  locks
  256. RETURN("")
  257. *----------------------------------------------------------------------------------------------------------------------
  258.  
  259. PROCEDURE MAINTAIN
  260. @ 19,12 PROMPT "1. Reset Update Marker Field to Zero, all records" MESSAGE CENTER(">>> Requires a File Lock <<<",80)
  261. @ 20,12 PROMPT "2. Reindex File" MESSAGE CENTER(">>> Requires Exclusive USE <<<",80)
  262. @ 21,12 PROMPT "3. PACK to 13 Original States" MESSAGE CENTER(">>> Requires Exclusive USE <<<",80)
  263. MENU TO choice2
  264. @ 19,0 CLEAR TO 23,79
  265. DO CASE
  266.  CASE choice2 = 1
  267.   IF FIL_LOCK(5)
  268.    REPLACE ALL st_updated WITH 0
  269.    UNLOCK
  270.    @ 23,0 SAY CENTER("All Update Markers Reset.",80)
  271.   ELSE
  272.    @ 23,0 SAY CENTER("Did not REPLACE fields because can't lock file.",80)
  273.   ENDIF
  274.  CASE choice2 = 2
  275.   IF NET_USE("STATES",.T.,5)
  276.    SET INDEX TO STATES1,STATES2,STATES3
  277.    REINDEX
  278.    @ 23,0 SAY CENTER("File Reindexed.",80)
  279.   ELSE
  280.    @ 23,0 SAY CENTER("Did not REINDEX because can't get exclusive use.",80)
  281.   ENDIF
  282.   DO RESHARE
  283.  CASE choice2 = 3
  284.   IF NET_USE("STATES",.T.,5)
  285.    SET INDEX TO STATES1,STATES2,STATES3
  286.    DELETE FOR RECNO() > 13
  287.    PACK
  288.    @ 23,0 SAY CENTER("File PACKed to original contents.",80)
  289.   ELSE
  290.    @ 23,0 SAY CENTER("Did not PACK because can't get exclusive use.",80)
  291.   ENDIF
  292.   DO RESHARE
  293. ENDCASE
  294. ?? bell
  295. INKEY(1)
  296. RETURN
  297.  
  298. PROCEDURE RESHARE
  299. * Attempt to re-establish shared use after having relinquished it
  300. *  through an attempt to get exclusive use
  301. IF NET_USE("STATES",.F.,5)
  302.  SET INDEX TO STATES1,STATES2,STATES3
  303. ELSE
  304.  CLEAR
  305.  ? 'File not recoverable for shared mode use. Program terminated.'
  306.  CLOSE
  307.  ? bell
  308.  QUIT
  309. ENDIF
  310. RETURN
  311. *----------------------------------------------------------------------------------------------------------------------
  312.  
  313. PROCEDURE VIEW_FILE
  314. PARAMETERS A,B,C
  315. SAVE SCREEN
  316. @ 3,0 CLEAR TO 24,79
  317. @ 4,42 SAY  '<Esc> key to go back to demo program'
  318. DECLARE field_list[4]
  319. field_list[1] = FIELDNAME(2)
  320. field_list[2] = FIELDNAME(1)
  321. field_list[3] = FIELDNAME(3)
  322. field_list[4] = FIELDNAME(4)
  323. SET INDEX TO STATES2
  324. DBEDIT(5, 0, 22, 79, field_list, "ed")
  325. SET INDEX TO STATES1,STATES2,STATES3
  326. RESTORE SCREEN
  327. RETURN
  328.  
  329. FUNCTION ed
  330. * user defined function to be called from DBEDIT
  331. PARAMETERS mode,i
  332. DO CASE
  333.  CASE mode < 3
  334.   @ 4,10 SAY "Record " + SUBSTR('     '+STR(RECNO()),LEN('     '+STR(RECNO()))-4)
  335.   RETURN(1)
  336.  CASE LASTKEY() = 27
  337.   RETURN(0)
  338.  OTHERWISE
  339.   RETURN(1)
  340. ENDCASE
  341. *----------------------------------------------------------------------------------------------------------------------
  342.  
  343. FUNCTION CENTER
  344. * Syntax....:CENTER(<expC>,<expN>)
  345. * Notes.....:Returns the expC centered in the width expN by
  346. *           padding leading blanks.
  347. PRIVATE string, width
  348. PARAMETERS string, width
  349. IF LEN(string) >= width         && Too long to center
  350.    RETURN (string)
  351. ENDIF
  352. RETURN (SPACE(INT(width/2) -  INT(LEN(string)/2)) + string)
  353. *----------------------------------------------------------------------------------------------------------------------
  354.  
  355. FUNCTION REC_LOCKER 
  356. *
  357. * altered version of REC_LOCK() that allows interruption by Esc key
  358. *
  359. PARAMETERS wait
  360. PRIVATE forever
  361. IF RLOCK()
  362.  RETURN (.T.)
  363. ENDIF
  364. forever = (wait = 0)
  365. DO WHILE (forever .OR. wait > 0)
  366.  IF RLOCK()
  367.   RETURN (.T.)
  368.  ENDIF
  369.  IF INKEY(.5) = 27        && here are the only differences
  370.   EXIT                &&  between this function and
  371.  ENDIF                &&  REC_LOCK() in LOCKS.PRG
  372.  wait = wait - .5
  373. ENDDO
  374. RETURN (.F.)
  375. *----------------------------------------------------------------------------------------------------------------------
  376.