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