home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / DBU.LIF / DBU.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  15.3 KB  |  662 lines
  1. ************
  2. *
  3. *    Program....:  DBU
  4. *    Filename...:  DBU.PRG
  5. *    Author.....:  Dennis L. Dias
  6. *    Date.......:  06/18/86, 06/18/90
  7. *    Purpose....:  Main Module
  8. *
  9. *    Copyright (c) 1986-1990 Nantucket Corp., All Rights Reserved.
  10. *
  11. ************
  12.  
  13. PARAMETERS param1, param2
  14.  
  15. PUBLIC n_files,keystroke,lkey,frame,sframe,cur_dir,more_up,more_down,;
  16.        kf1,kf2,kf3,kf4,kf5,kf6,need_field,need_ntx,need_relat,need_filtr,;
  17.        help_code,view_err,cur_area,cur_dbf,cur_ntx,cur_fields,error_on,;
  18.        exit_str,page,sysfunc,func_sel,cur_func,local_func,local_sel,box_open,;
  19.        color1,color2,color3,color4,color5,color6,color7,color8,color9,;
  20.        color10,color11,color12,com_line,curs_on,helpfile
  21.  
  22. ******
  23. *    The parameters are optional and have the following meaning:
  24. *
  25. *    - filename (.VEW or .DBF) to Browse
  26. *
  27. *    - color directive where:
  28. *        /C = use color even if monochrome
  29. *        /M = monochrome (don't use color)
  30. *
  31. *    Parameters may be specified in either order
  32. ******
  33.  
  34. * avoid a type mismatch
  35. IF TYPE("param1") <> "C"
  36.     param1 = ""
  37.  
  38. ENDIF
  39.  
  40. IF TYPE("param2") <> "C"
  41.     param2 = ""
  42.  
  43. ENDIF
  44.  
  45. * accept parameters in either order
  46. IF "/C" $ UPPER(param1) .OR. "/M" $ UPPER(param1)
  47.     * color directive in param1..swap
  48.     com_line = param2
  49.     param2 = param1
  50.  
  51. ELSE
  52.     * normal order
  53.     com_line = param1
  54.  
  55. ENDIF
  56.  
  57. SET CURSOR OFF                    && cursors are for gets
  58. SAVE SCREEN                        && the screen you save...
  59. SET SCOREBOARD OFF                && who's keeping score, anyhow
  60. SET KEY 28 TO                    && some folks need help
  61.  
  62. IF (ISCOLOR() .OR. "/C" $ UPPER(param2)) .AND. .NOT. "/M" $ UPPER(param2)
  63.     * make it pretty
  64.     color1 = "W+/B,N/W,B"            && normal
  65.     color2 = "B/W"                    && item hilite
  66.     color3 = "W+/R"                    && error or high intensity
  67.     color4 = "W+/B,B/W,,,W+/B"        && achoice/list array..unselected is norm
  68.     color5 = "B/BG,B/W,,,W/BG"        && achoice/sysmenu..true unselected
  69.     color6 = "W+/BG"                && menu frame
  70.     color7 = "B/BG,B/W"                && browse, modify structure, set relation
  71.     color8 = "B/W,B/BG,,,B/W"        && memos, dialogue
  72.     color9 = "W+/B,N/BG"            && memo titles
  73.     color10 = "B/BG"                && dialogue box hilite
  74.     color11 = "W+/BG"                && menu title hilite
  75.     color12 = "W+/B"                && set relation hilite
  76.  
  77. ELSE
  78.     * monochrome
  79.     color1 = "W/N,N/W"
  80.     color2 = "N/W"
  81.     color3 = "W+/N"
  82.     color4 = "W/N,N/W,,,W/N"
  83.     color5 = "W+/N,N/W,,,W/N"
  84.     color6 = "W/N"
  85.     color7 = "W/N,N/W"
  86.     color8 = "W/N,N/W,,,W/N"
  87.     color9 = "N/W,N/W"
  88.     color10 = "N/W"
  89.     color11 = "N/W"
  90.     color12 = "W+/N"
  91.  
  92. ENDIF
  93.  
  94. * let's get this baby off the ground
  95. SetColor(color1)
  96. CLEAR
  97.  
  98. * system constants
  99. more_up = CHR(24)            && visual up arrow
  100. more_down = CHR(25)            && visual down arrow
  101. frame = "╒═╕│╛═╘│"            && box characters
  102. lframe = "╤═╕│╛═╧│"
  103. mframe = "┬─┬│┘─└│"
  104. sframe = "┌─┐│┘─└│"
  105.  
  106. * global variables
  107. STORE .F. TO need_field,need_ntx,need_relat,need_filtr,box_open
  108. STORE "" TO kf1,kf2,kf3,kf4,kf5,kf6
  109. help_code = 0                && let them eat cake
  110. curs_on = .F.                && what cursor?
  111. cur_dir = ""                && current directory
  112. cur_dbf = ""                && current data file
  113. cur_ntx = ""                && current controlling index file
  114. cur_fields = ""                && fields array for current area
  115. cur_area = 0                && current work area
  116. page = 1                    && active view screen
  117. n_files = 0                    && 14 user files max
  118. view_file = ""                && file to save view
  119. view_err = ""                && displayed by "set_view"
  120.  
  121. view_err = "DBU - Copyright (c) 1986-1990 Nantucket Corp., " +;
  122.            "All Rights Reserved"
  123.  
  124. * search for help file
  125. IF FILE("dbu.hlp")
  126.     helpfile = "dbu.hlp"
  127.  
  128. ELSE
  129.  
  130.     IF FILE("\clipper\dbu.hlp")
  131.         helpfile = "\clipper\dbu.hlp"
  132.  
  133.     ELSE
  134.         * no help
  135.         helpfile = ""
  136.  
  137.     ENDIF
  138. ENDIF
  139.  
  140. **
  141. *    Arrays declared in main module are considered public and
  142. *    may be accessed or altered by any module in the system. The
  143. *    matrix defines 6 work areas with 7 indexes and 64 fields
  144. *    for each. 15 relations are also provided. All elements are
  145. *    initialized to avoid a type mismatch.
  146. **
  147.  
  148. * names of data files
  149. DECLARE dbf[6]
  150.  
  151. * names of index files
  152. DECLARE ntx1[7]
  153. DECLARE ntx2[7]
  154. DECLARE ntx3[7]
  155. DECLARE ntx4[7]
  156. DECLARE ntx5[7]
  157. DECLARE ntx6[7]
  158.  
  159. * 15 relations
  160. DECLARE s_relate[15]        && source of relation
  161. DECLARE k_relate[15]        && key to relation
  162. DECLARE t_relate[15]        && target of relation
  163.  
  164. * individual field names for active list
  165. DECLARE field_n1[64]
  166. DECLARE field_n2[64]
  167. DECLARE field_n3[64]
  168. DECLARE field_n4[64]
  169. DECLARE field_n5[64]
  170. DECLARE field_n6[64]
  171.  
  172. * master field list..128 fields overall max
  173. DECLARE field_list[128]
  174.  
  175. * first and last row of each screen section
  176. DECLARE row_a[3]                && first row of each screen section
  177. DECLARE row_x[3]                && last row of each screen sectionn
  178.  
  179. * constant values
  180. row_a[1] = 6
  181. row_x[1] = 6
  182. row_a[2] = 10
  183. row_x[2] = 12
  184. row_a[3] = 16
  185. row_x[3] = 22
  186.  
  187. * col() of data file columns
  188. DECLARE column[6]
  189.  
  190. * current row for each data column and each screen section
  191. DECLARE cr1[3]
  192. DECLARE cr2[3]
  193. DECLARE cr3[3]
  194. DECLARE cr4[3]
  195. DECLARE cr5[3]
  196. DECLARE cr6[3]
  197.  
  198. * current element for each data column and each screen section
  199. DECLARE el1[3]
  200. DECLARE el2[3]
  201. DECLARE el3[3]
  202. DECLARE el4[3]
  203. DECLARE el5[3]
  204. DECLARE el6[3]
  205.  
  206. * titles for function keys and help screens
  207. DECLARE func_title[8]
  208. DECLARE menu_deflt[8]
  209. DECLARE help_title[22]
  210.  
  211. **
  212. * initialize arrays
  213. **
  214.  
  215. * active data files
  216. afill(dbf, "")
  217.  
  218. * index files for each data file
  219. afill(ntx1, "")
  220. afill(ntx2, "")
  221. afill(ntx3, "")
  222. afill(ntx4, "")
  223. afill(ntx5, "")
  224. afill(ntx6, "")
  225.  
  226. * fields for each data file
  227. afill(field_n1, "")
  228. afill(field_n2, "")
  229. afill(field_n3, "")
  230. afill(field_n4, "")
  231. afill(field_n5, "")
  232. afill(field_n6, "")
  233.  
  234. * source, key, and target for relations
  235. afill(s_relate, "")
  236. afill(k_relate, "")
  237. afill(t_relate, "")
  238.  
  239. * master field list
  240. afill(field_list, "")
  241.  
  242. * titles for function keys
  243. func_title[1] = "Help"
  244. func_title[2] = "Open"
  245. func_title[3] = "Create"
  246. func_title[4] = "Save"
  247. func_title[5] = "Browse"
  248. func_title[6] = "Utility"
  249. func_title[7] = "Move"
  250. func_title[8] = "Set"
  251.  
  252. afill(menu_deflt, 1)
  253.  
  254. * draw top of screen rows 0 thru 3
  255. @ 0,0 SAY " F1        F2        F3        F4        F5        F6        " +;
  256.           "F7        F8       "
  257. show_keys()
  258. @ 2,0 SAY REPLICATE("─", 80)
  259. error_msg(view_err)
  260.  
  261. * when to bubble up
  262. exit_str = "356"
  263.  
  264. * pop-up menus with parallel boolean arrays for achoice()
  265. DECLARE help_m[1]
  266. DECLARE help_b[1]
  267. help_m[1] = "Help"
  268. help_b[1] = .T.
  269.  
  270. DECLARE open_m[3]
  271. DECLARE open_b[3]
  272. open_m[1] = "Database"
  273. open_m[2] = "Index"
  274. open_m[3] = "View"
  275. open_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  276. open_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  277. open_b[3] = "sysfunc = 0 .AND. .NOT. box_open"
  278.  
  279. DECLARE create_m[2]
  280. DECLARE create_b[2]
  281. create_m[1] = "Database"
  282. create_m[2] = "Index"
  283. create_b[1] = "sysfunc = 0"
  284. create_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  285.  
  286. DECLARE save_m[2]
  287. DECLARE save_b[2]
  288. save_m[1] = "View"
  289. save_m[2] = "Struct"
  290. save_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  291. save_b[2] = "sysfunc = 3 .AND. func_sel = 1 .AND. .NOT. box_open"
  292.  
  293. DECLARE browse_m[2]
  294. DECLARE browse_b[2]
  295. browse_m[1] = "Database"
  296. browse_m[2] = "View"
  297. browse_b[1] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  298. browse_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(dbf[1])"
  299.  
  300. DECLARE utility_m[6]
  301. DECLARE utility_b[6]
  302. utility_m[1] = "Copy"
  303. utility_m[2] = "Append"
  304. utility_m[3] = "Replace"
  305. utility_m[4] = "Pack"
  306. utility_m[5] = "Zap"
  307. utility_m[6] = "Run"
  308. afill(utility_b, "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)", 1, 5)
  309. utility_b[6] = "sysfunc = 0"
  310.  
  311. DECLARE move_m[4]
  312. DECLARE move_b[4]
  313. move_m[1] = "Seek"
  314. move_m[2] = "Goto"
  315. move_m[3] = "Locate"
  316. move_m[4] = "Skip"
  317. afill(move_b, "sysfunc = 5 .AND. .NOT. box_open")
  318. move_b[1] = move_b[1] + " .AND. .NOT. EMPTY(cur_ntx)"
  319.  
  320. DECLARE set_m[3]
  321. DECLARE set_b[3]
  322. set_m[1] = "Relation"
  323. set_m[2] = "Filter"
  324. set_m[3] = "Fields"
  325. set_b[1] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(dbf[2])"
  326. set_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  327. set_b[3] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  328.  
  329. * titles for help screens
  330. help_title[1] = "GENERAL INFORMATION"
  331. help_title[2] = "FIELDS LISTS"
  332. help_title[3] = "BROWSE"
  333. help_title[4] = "CREATE / MODIFY STRUCTURE"
  334. help_title[5] = "CREATE INDEX"
  335. help_title[6] = "OPEN DATABASE"
  336. help_title[7] = "FILTERS"
  337. help_title[8] = "OPEN INDEX"
  338. help_title[9] = "SET RELATIONSHIP"
  339. help_title[10] = "LOCATE EXPRESSION"
  340. help_title[11] = "SDF / DELIMITED"
  341. help_title[12] = "COPY"
  342. help_title[13] = "SEEK EXPRESSION"
  343. help_title[14] = "GO TO RECORD NUMBER"
  344. help_title[15] = "APPEND"
  345. help_title[16] = "FOR / WHILE"
  346. help_title[17] = "SCOPE"
  347. help_title[18] = "DOS WINDOW"
  348. help_title[19] = "MEMO EDITOR"
  349. help_title[20] = "SKIP <n> RECORDS"
  350. help_title[21] = "SAVE / RESTORE VIEW"
  351. help_title[22] = "REPLACE"
  352.  
  353. * arrays for file names in default directory
  354. DECLARE dbf_list[adir("*.DBF") + 20]            && directory of data files
  355. DECLARE ntx_list[adir("*" + INDEXEXT()) + 20]    && directory of index files
  356. DECLARE vew_list[adir("*.VEW") + 20]            && directory of view files
  357.  
  358. * fill the arrays with filenames
  359. array_dir("*.DBF",dbf_list)
  360. array_dir("*" + INDEXEXT(),ntx_list)
  361. array_dir("*.VEW",vew_list)
  362.  
  363. * default to set view
  364. local_func = 0                && local menu
  365. local_sel = 1                && local menu item
  366. keystroke = 0                && current keystroke
  367. lkey = 0                    && previous keystroke
  368. sysfunc = 0                    && system menu
  369. func_sel = 1                && system menu item
  370.  
  371. * clean up and process command line if entered
  372. com_line = LTRIM(TRIM(UPPER(com_line)))
  373.  
  374. IF .NOT. EMPTY(com_line)
  375.  
  376.     DO CASE
  377.  
  378.         CASE RAT(".", com_line) > RAT("\", com_line)
  379.             * file extension entered
  380.             IF .NOT. FILE(com_line)
  381.                 * file must exist
  382.                 com_line = ""
  383.  
  384.             ENDIF
  385.  
  386.         CASE FILE(com_line + ".VEW")
  387.             * look for file name with .VEW extension
  388.             com_line = com_line + ".VEW"
  389.  
  390.         CASE FILE(com_line + ".DBF")
  391.             * look for file name with .DBF extension
  392.             com_line = com_line + ".DBF"
  393.  
  394.         OTHERWISE
  395.             * file not found..ignore command line
  396.             com_line = ""
  397.  
  398.     ENDCASE
  399.  
  400.     IF .NOT. EMPTY(com_line)
  401.         * command line file exists
  402.  
  403.         IF RAT(".VEW", com_line) = LEN(com_line) - 3
  404.             * assume a valid .VEW file
  405.             view_file = com_line
  406.             set_from(.F.)                            && restore view
  407.             KEYBOARD CHR(-4) + CHR(24) + CHR(13)    && browse view
  408.  
  409.         ELSE
  410.             * assume a valid .DBF file
  411.             dbf[1] = com_line                        && primary database
  412.             USE &com_line                            && open data file
  413.             all_fields(1, M->field_n1)                && all fields active
  414.             KEYBOARD CHR(-4) + CHR(13)                && browse database
  415.  
  416.         ENDIF
  417.  
  418.         IF .NOT. EMPTY(dbf[1])
  419.             * view established..cancel display of message
  420.             view_err = ""
  421.  
  422.         ENDIF
  423.     ENDIF
  424. ENDIF
  425.  
  426. DO WHILE .T.
  427.     * forever
  428.     cur_func = M->sysfunc        && to recognize a change
  429.  
  430.     DO CASE
  431.  
  432.         CASE M->sysfunc = 5
  433.             * browse
  434.  
  435.             IF .NOT. EMPTY(dbf[1])
  436.                 * there is a view..do the set up
  437.                 setup()
  438.  
  439.                 IF EMPTY(M->view_err)
  440.                     * set up successful so far
  441.                     cur_fields = "field_n" + SUBSTR("123456", M->cur_area, 1)
  442.  
  443.                     DO CASE
  444.  
  445.                         CASE M->func_sel = 1 .AND. EMPTY(M->cur_dbf)
  446.                             * browse one file
  447.                             view_err = "No data file in current select area"
  448.  
  449.                         CASE M->func_sel = 1 .AND. EMPTY(&cur_fields[1])
  450.                             * browse one file
  451.                             view_err = "No active field list in current select area"
  452.  
  453.                         CASE EMPTY(field_list[1])
  454.                             * browse entire view
  455.                             view_err = "No active field list"
  456.  
  457.                         OTHERWISE
  458.                             * ok to browse
  459.  
  460.                             IF M->func_sel = 1
  461.                                 * browse one file..hi-lite the name
  462.                                 hi_cur()
  463.  
  464.                             ENDIF
  465.  
  466.                             help_code = 3
  467.                             DO browse
  468.                             dehi_cur()
  469.  
  470.                     ENDCASE
  471.                 ENDIF
  472.  
  473.             ELSE
  474.                 view_err = "No database in use"
  475.  
  476.             ENDIF
  477.  
  478.             sysfunc = 0            && back to the main view screen
  479.  
  480.         CASE M->sysfunc = 3
  481.  
  482.             IF M->func_sel = 1
  483.                 * modify structure
  484.                 hi_cur()
  485.                 help_code = 4
  486.                 DO modi_stru
  487.                 dehi_cur()
  488.  
  489.                 IF EMPTY(M->cur_dbf)
  490.                     * new structure not created..kill dummy View channel
  491.                     cur_area = 0
  492.  
  493.                 ENDIF
  494.  
  495.             ELSE
  496.                 * create or re-create index
  497.  
  498.                 IF EMPTY(M->cur_dbf)
  499.                     view_err = "No data file in current select area"
  500.  
  501.                 ELSE
  502.                     help_code = 5
  503.                     DO make_ntx
  504.  
  505.                 ENDIF
  506.             ENDIF
  507.  
  508.             sysfunc = 0            && back to the main view screen
  509.  
  510.         CASE M->sysfunc = 6 .AND. M->func_sel <> 6
  511.             * copy/append/replace/pack/zap
  512.  
  513.             IF EMPTY(M->cur_dbf)
  514.                 view_err = "No data file in current select area"
  515.                 sysfunc = 0        && back to the main view screen
  516.                 LOOP
  517.  
  518.             ENDIF
  519.  
  520.             IF .NOT. EMPTY(dbf[1])
  521.                 * do view set up
  522.                 setup()
  523.  
  524.             ENDIF
  525.  
  526.             IF .NOT. EMPTY(M->view_err)
  527.                 * error in set up
  528.                 sysfunc = 0        && back to the main view screen
  529.                 LOOP
  530.  
  531.             ENDIF
  532.  
  533.             hi_cur()
  534.  
  535.             DO CASE
  536.  
  537.                 CASE M->func_sel < 4
  538.                     * copy, append, or replace
  539.                     DO capprep
  540.  
  541.                 CASE M->func_sel = 4
  542.                     * pack command
  543.  
  544.                     IF rsvp("Pack " + M->cur_dbf + "? (Y/N)") = "Y"
  545.                         * pack confirmed
  546.                         stat_msg("Packing " + M->cur_dbf)
  547.                         SELECT (M->cur_area)
  548.                         PACK
  549.                         stat_msg(M->cur_dbf + " Packed")
  550.  
  551.                     ENDIF
  552.  
  553.                 CASE M->func_sel = 5
  554.                     * zap command
  555.  
  556.                     IF rsvp("Zap " + M->cur_dbf + "? (Y/N)") = "Y"
  557.                         * zap confirmed
  558.                         stat_msg("Zapping " + M->cur_dbf)
  559.                         SELECT (M->cur_area)
  560.                         ZAP
  561.                         stat_msg(M->cur_dbf + " Zapped")
  562.  
  563.                     ENDIF
  564.  
  565.             ENDCASE
  566.  
  567.             dehi_cur()
  568.             sysfunc = 0            && back to the main view screen
  569.  
  570.         CASE M->sysfunc = 6 .AND. M->func_sel = 6
  571.             * run a DOS command or program
  572.             @ 4,0 CLEAR
  573.  
  574.             IF .NOT. EMPTY(dbf[1])
  575.                 * set view before a possible chdir
  576.                 setup()
  577.  
  578.             ENDIF
  579.  
  580.             IF .NOT. EMPTY(M->view_err)
  581.                 * display message and continue for possible
  582.                 * correction of "File not found", etc.
  583.                 error_msg(M->view_err, 24, 7)
  584.                 view_err = ""
  585.  
  586.             ENDIF
  587.  
  588.             run_com = ""
  589.             com_line = ""
  590.             help_code = 18
  591.  
  592.             DO WHILE .NOT. q_check()
  593.                 * re-draw top 3 rows after each command
  594.                 @ 0,0 SAY " F1        F2        F3        F4        " +;
  595.                           "F5        F6        F7        F8       "
  596.                 show_keys()
  597.                 @ 2,0 SAY REPLICATE("─", 80)
  598.                 @ 24,0 SAY "Run ═" + CHR(16) + " "
  599.  
  600.                 * accept command entry
  601.                 run_com = enter_rc(M->com_line,24,7,127,"@KS73",M->color1)
  602.  
  603.                 IF .NOT. EMPTY(M->run_com) .AND. M->keystroke = 13
  604.                     * only the enter key will run the command
  605.                     com_line = M->run_com        && preserve previous command
  606.                     @ 24,0                        && clear the command entry
  607.  
  608.                     SET CURSOR ON
  609.                     RUN &run_com
  610.                     SET CURSOR OFF
  611.  
  612.                 ELSE
  613.                     * check for menu request
  614.                     sysmenu()
  615.  
  616.                     IF M->local_func = 1
  617.                         DO syshelp
  618.  
  619.                     ENDIF
  620.                 ENDIF
  621.             ENDDO
  622.  
  623.             * re-establish the environment
  624.             @ 3,0 CLEAR
  625.  
  626.             * rebuild directory arrays..must keep current
  627.             DECLARE dbf_list[adir("*.DBF") + 20]
  628.             DECLARE ntx_list[adir("*" + INDEXEXT()) + 20]
  629.             DECLARE vew_list[adir("*.VEW") + 20]
  630.  
  631.             * fill the arrays with filenames..data files
  632.             array_dir("*.DBF",dbf_list)
  633.  
  634.             * index files
  635.             array_dir("*" + INDEXEXT(),ntx_list)
  636.  
  637.             * view files
  638.             array_dir("*.VEW",vew_list)
  639.             cur_area = 0        && re-draw view screen
  640.             sysfunc = 0            && back to the main view screen
  641.  
  642.         OTHERWISE
  643.             * main view screen..sysfunc = 0
  644.             help_code = 1
  645.             DO set_view
  646.  
  647.             IF M->keystroke = 27
  648.                 * exit confirmed in set_view
  649.                 SET TYPEAHEAD TO 0    && remaining keystrokes to DOS
  650.                 CLOSE DATABASES        && kill the view
  651.                 RESTORE SCREEN        && ...may be your own
  652.                 SET CURSOR ON        && always leave them laughing
  653.                 SET COLOR TO        && back to normal
  654.                 QUIT                && -=[Bye]=-
  655.  
  656.             ENDIF
  657.     ENDCASE
  658. ENDDO
  659.  
  660.  
  661. * EOF DBU.PRG
  662.