home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / SBTAR2.ZIP / SYSSTRT.PRG < prev    next >
Encoding:
Text File  |  1990-06-04  |  13.4 KB  |  406 lines
  1. ********************** ' MultiNet Source Code ' ***********************
  2. ** '                       SBT Corporation                         ' **
  3. ** '         One Harbor Drive, Sausalito, California 94965         ' **
  4. ** '                   Telephone (415) 331-9900                    ' **
  5. ***********************************************************************
  6. ** '   (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation   ' **
  7. ** '            All Rights Reserved by SBT Corporation             ' **
  8. ** '                                                               ' **
  9. ***********************************************************************
  10. ** ' 06/04/90 = Last Update  **  SYSSTRT.PRG  **   Version 6.35.00 ' **
  11. ***********************************************************************
  12. * ' System wide startup program, called by XX.PRG
  13. *
  14. SET CONSOLE ON
  15. SET DEVICE TO SCREEN
  16. SET PRINT OFF
  17. SET SAFETY OFF
  18. SELECT a
  19. STORE ' ' TO mans
  20. DO CASE
  21.   CASE clipper .OR. xquicks
  22.     STORE .t. TO mfound
  23.   CASE FILE('&m0cmddr.sysmult.prg')
  24.     STORE .t. TO mfound
  25.   CASE FILE('&m0cmddr.sysmult.fox')
  26.     STORE .t. TO mfound
  27.   CASE FILE('&m0cmddr.sysmult.fxp')
  28.     STORE .t. TO mfound
  29.   CASE FILE('&m0cmddr.sysmult.cod')
  30.     STORE .t. TO mfound
  31.   CASE FILE('&m0cmddr.sysmult.cmd')
  32.     STORE .t. TO mfound
  33.   CASE FILE('&m0cmddr.sysmult.run')
  34.     STORE .t. TO mfound
  35.   CASE FILE('&m0cmddr.sysmult.dbo')
  36.     STORE .t. TO mfound
  37.   OTHERWISE
  38.     STORE .f. TO mfound
  39. ENDCASE
  40. IF mfound
  41.   SET PROCEDURE TO sysmult
  42. ELSE
  43.   USE
  44.   CLEAR
  45.   ?? CHR(7)
  46.   STORE ' ' TO mans
  47.   @ 2,4 SAY 'Warning [9004] - Procedure File Missing.'
  48.   @ 4,4 SAY 'Informational only - No data has been lost.'
  49.   @ 6,4 SAY 'The Procedure File SYSMULT was not found on ' + m0cmddr
  50.   @ 7,4 SAY 'Please reinstall the system and check to be sure all of the'
  51.   @ 8,4 SAY 'files are present on the Program Drive and Directory.'
  52.   @ 10,4 SAY 'Program Cancelled.  Press any key to continue...' GET mans
  53.   READ
  54.   SET TALK ON
  55.   SET SAFETY ON
  56.   CANCEL
  57. ENDIF
  58. RELEASE m0dbfdr, m0comp, m0company, m0cname, ;
  59. m0compno, m0date, m0tmpf1, m0tmpf2, m0tmpf3, m0tmpf4, m0tmpf5, m0tmpf6, ;
  60. m0link, m0add, m0del, m0seqno, m0miscno, action, m0port
  61. RELEASE m0ret, m0deflink, m0new, m0change, m0pass, ;
  62. m0dept, m0color, m0monitor, m0usedep, m0stpprn, m0prnesc, m0litebar
  63. PUBLIC m0dbfdr, m0comp, m0company, m0cname, ;
  64. m0compno, m0date, m0tmpf1, m0tmpf2, m0tmpf3, m0tmpf4, m0tmpf5, m0tmpf6, ;
  65. m0link, m0add, m0del, m0seqno, m0miscno, action, m0port
  66. PUBLIC m0ret, m0deflink, m0new, m0change, m0pass, ;
  67. m0color, m0monitor, m0stpprn, m0prnesc, m0litebar
  68. RELEASE foxpro, mdbase4
  69. PUBLIC foxpro, mdbase4
  70. IF 'DBASE IV' $ UPPER(VERSION())
  71.   STORE .t. TO mdbase4
  72. ENDIF
  73. IF m0pgmid = 'GL'
  74.   PUBLIC m0dept, m0usedep
  75. ENDIF
  76. * ' We force fox true for early SCO versions that didn't support DBMS var
  77. IF 'NIX' $ UPPER(OS()) .AND. 'FOX' $ UPPER(VERSION())
  78.   STORE .t. TO fox
  79. ENDIF
  80. * ' Define which platforms support the litebar menu system
  81. * ' As of 6/1/90 Only Fox 2.x and FoxPro will use litebar menus
  82. STORE .f. TO m0litebar
  83. DO CASE
  84. * ' Leave litebar to .f. if 'MA' version 6.10 or less
  85.   CASE VAL(m0vers) < 6.30 .AND. .NOT. (m0pgmid = 'MA' .AND. ;
  86.     VAL(m0vers) > 6.10)
  87.     * ' leave litebar false for non supported versions
  88.   CASE foxpro
  89.     STORE .t. TO m0litebar
  90.   CASE fox .AND. ' 2.' $ VERSION()
  91.     STORE .t. TO m0litebar
  92. ENDCASE
  93. IF 'MAC' $ UPPER(OS())
  94.   STORE .f. TO m0litebar
  95. ENDIF
  96. * ' Initialize the print escape values.
  97. STORE .f. TO m0stpprn, m0prnesc
  98. * ' Check for these variables in case calling program is early version
  99. IF TYPE('m0switchar') = 'U'
  100.   PUBLIC m0switchar
  101. ENDIF
  102. IF TYPE('m0single') = 'U'
  103.   RELEASE m0single
  104.   PUBLIC m0single
  105.   STORE .f. TO m0single
  106. ENDIF
  107. IF TYPE('m0trial') = 'U'
  108.   RELEASE m0trial
  109.   PUBLIC m0trial
  110.   STORE .f. TO m0trial
  111. ENDIF
  112. * ' prepare the picure information for decimals to input for inventory
  113. RELEASE mdecimal0, mdecimal1, mdecimal2, mdecimal3
  114. PUBLIC mdecimal0, mdecimal1, mdecimal2, mdecimal3
  115. STORE '#####' TO mdecimal0
  116. STORE '#####.#' TO mdecimal1
  117. STORE '#####.##' TO mdecimal2
  118. STORE '#####.###' TO mdecimal3
  119. CLEAR
  120. * ' Process of creating unique temporary file names for each user
  121. LOCATE FOR UPPER(sysid) = 'MM  '
  122. DO p0rlockn
  123. REPLACE int3 WITH IIF(int3 < 999993, int3 + 6, 6)
  124. UNLOCK
  125. STORE SUBSTR(STR(100000000 + int3 - 5,9,0),2,8) TO m0tmpf1
  126. STORE SUBSTR(STR(100000000 + int3 - 4,9,0),2,8) TO m0tmpf2
  127. STORE SUBSTR(STR(100000000 + int3 - 3,9,0),2,8) TO m0tmpf3
  128. STORE SUBSTR(STR(100000000 + int3 - 2,9,0),2,8) TO m0tmpf4
  129. STORE SUBSTR(STR(100000000 + int3 - 1,9,0),2,8) TO m0tmpf5
  130. STORE SUBSTR(STR(100000000 + int3,9,0),2,8) TO m0tmpf6
  131. * ' Set up colors/shadings on monitors
  132. IF (m0os = 'D' .OR. (fox .AND. 'MAC' $ UPPER(OS()))) .AND. .NOT. m0trial
  133.   STORE TRIM(LTRIM(SUBSTR(str5,2,25))) TO m0color
  134.   DO WHILE ' ' $ m0color
  135.     STORE AT(' ',m0color) TO mpos
  136.     STORE SUBSTR(m0color,1,mpos-1) + SUBSTR(m0color,mpos+1) TO m0color
  137.   ENDDO
  138.   IF SUBSTR(str5,1,1) $ 'CM'
  139.     SET COLOR TO &m0color
  140.     STORE SUBSTR(str5,1,1) TO m0monitor
  141.   ELSE
  142.     * ' If sysdata isn't set to Color or Mono assume 'Ask on Startup'
  143.     IF ISCOLOR()
  144.       STORE 'C' TO m0monitor
  145.     ELSE
  146.       STORE 'M' TO m0monitor
  147.     ENDIF
  148.     * ' If monitor type not defined
  149.     @ 22,10 SAY 'What type of Monitor do you have ? (Color/Mono) ' + ;
  150.     SUBSTR(m0border,181,5) GET m0monitor PICTURE '!'
  151.     READ SAVE
  152.     DO WHILE .NOT. m0monitor $ 'CM'
  153.       ?? CHR(7)
  154.       READ SAVE
  155.     ENDDO
  156.     CLEAR GETS
  157.     DO CASE
  158.       CASE m0monitor = 'C' .AND. LEN(m0color) > 0
  159.         SET COLOR TO &m0color
  160.       CASE m0monitor = 'C'
  161.         SET COLOR TO W+/B,N/W,B
  162.       CASE 'MAC' $ UPPER(OS()) .AND. fox
  163.         SET COLOR TO N/W,W/N,N
  164.       OTHERWISE
  165.         SET COLOR TO W+/N,N/W,N
  166.     ENDCASE
  167.   ENDIF && SUBSTR(str5,1,1) $ 'CM'
  168. ENDIF && (m0os = 'D' .OR. (fox .AND. 'MAC' $ UPPER(OS()))) .AND. .NOT. m0trial
  169. * ' Set to latest of clock date or stored SBT last used date for system date
  170. STORE DATE() TO m0date
  171. IF CTOD(SUBSTR(a->str8,1,8)) > m0date .OR. SUBSTR(DTOC(DATE()),7,2) = '80'
  172.   STORE CTOD(SUBSTR(a->str8,1,8)) TO m0date
  173.   CLEAR
  174.   ?? CHR(7)
  175.   IF SUBSTR(DTOC(DATE()),7,2) = '80'
  176.     @ 15,3 SAY ;
  177.     'NOTE: Your computer appears to have no clock.'
  178.     @ 16,9 SAY '(The operating system date is ' + DTOC(DATE()) + '.)'
  179.   ELSE
  180.     @ 15,3 SAY ;
  181.     "NOTE: The SBT system date is greater than computer's clock date."
  182.   ENDIF
  183.   STORE DTOC(m0date) TO mdate
  184.   @ 19,15 SAY 'Please enter Current Date ' + SUBSTR(m0border,179,7) ;
  185.   GET mdate PICTURE '##/##/##'
  186.   READ SAVE
  187.   DO WHILE DTOC(CTOD(mdate)) <> mdate .OR. ' ' $ mdate
  188.     ?? CHR(7)
  189.     @ 23,2 SAY 'Invalid date, please reenter'
  190.     READ SAVE
  191.     @ 23,0
  192.   ENDDO
  193.   CLEAR GETS
  194.   DO p0rlockn
  195.   REPLACE str8 WITH mdate + SUBSTR(str8,9)
  196.   STORE CTOD(mdate) TO m0date
  197. ELSE
  198.   DO p0rlockn
  199.   REPLACE str8 WITH DTOC(m0date) + SUBSTR(a->str8,9,2)
  200. ENDIF
  201. UNLOCK
  202. * ' Set up version heading for billboard  6.2 was start of Six PLUS
  203. IF VAL(m0vers) < 6.2
  204.   STORE m0system + ' Series Six - Version ' + m0vers TO mtitle
  205. ELSE
  206.   STORE m0system + ' Series Six Plus - Version ' + m0vers TO mtitle
  207. ENDIF
  208. * ' The trial billboard/copyright screen is a little different
  209. IF m0trial
  210.   IF ISCOLOR()
  211.     SET COLOR TO W+/B,N/W,B
  212.   ELSE
  213.     SET COLOR TO W+/N,N/W,N
  214.   ENDIF
  215.   CLEAR
  216.   @ 1,40 - INT(LEN(mtitle)/2) SAY mtitle
  217.   TEXT
  218.                       Copyright (c) 1990  SBT Corporation
  219.  
  220.           This trial program  has been provided pursuant to a License
  221.           Agreement containing restrictions on its use.   The program
  222.           contains valuable trade secrets and proprietary information
  223.           of SBT Corporation  and is protected  by federal  copyright
  224.           law. The trial program may be copied and distributed in any
  225.           form  or  medium,   and  may  be  used  in  any  manner not
  226.           specifically prohibited by said  License  Agreement.
  227.  
  228.           For  further  information  regarding SBT's complete product
  229.           line, call or write:
  230.  
  231.                                  SBT  Corporation
  232.                                  Sales Department
  233.                                  One Harbor Drive
  234.                                Sausalito, Ca 94965
  235.                                   415/331-9900
  236.  
  237.   ENDTEXT
  238.   * ' Special trial specific installation routines
  239.   DO p0trinst
  240. ELSE
  241.   CLEAR
  242.   @ 1,40 - INT(LEN(mtitle)/2) SAY mtitle
  243.   TEXT
  244.                       Copyright (c) 1990  SBT Corporation
  245.  
  246.           This  software  has  been  provided  pursuant  to a License
  247.           Agreement containing restrictions on its use.  The software
  248.           contains valuable trade secrets and proprietary information
  249.           of SBT Corporation  and is protected  by federal  copyright
  250.           law.   It may not be  copied  or distributed in any form or
  251.           medium,  disclosed to third parties,  or used in any manner
  252.           not  provided  for in said  License  Agreement  except with
  253.           prior written authorization from SBT.
  254.  
  255.           For  further  information  regarding SBT's complete product
  256.           line, call or write:
  257.  
  258.                                  SBT  Corporation
  259.                                  Sales Department
  260.                                  One Harbor Drive
  261.                                Sausalito, Ca 94965
  262.                                   415/331-9900
  263.  
  264.   ENDTEXT
  265. ENDIF
  266. IF FILE ('sysbuil.dbf')
  267.   DELETE FILE sysbuil.dbf
  268. ENDIF
  269. IF m0litebar
  270.   STORE 'SYS' + m0pgmid + 'MN' TO menuf
  271.   STORE 'SYS' + m0pgmid + 'MO' TO menuo
  272.   IF .NOT. FILE ('&m0sysdr.&menuf..dbf')
  273.     STORE .f. TO m0litebar
  274.   ENDIF
  275. ENDIF
  276. IF m0litebar
  277.   IF .NOT. (FILE ('&m0sysdr.&menuf..ndx') .AND. FILE('&m0sysdr.&menuo..ndx'))
  278.     @ 23,0
  279.     @ 23,2 SAY '*****  Building Indexes for Light Bar Menus  *****'
  280.     USE &m0sysdr.&menuf
  281.     COPY TO &m0sysdr.tempfile FOR .NOT. DELETED()
  282.     USE
  283.     DELETE FILE &m0sysdr.&menuf..dbf
  284.     RENAME &m0sysdr.tempfile.dbf TO &m0sysdr.&menuf..dbf
  285.     USE &m0sysdr.&menuf
  286.     INDEX ON menuprg+SUBSTR(STR(1000 + disprow + dispcol,4,0),2,3) ;
  287.     TO &m0sysdr.&menuo..ndx
  288.     INDEX ON menuprg+SUBSTR(title,1,1) TO &m0sysdr.&menuf..ndx
  289.   ENDIF
  290. ENDIF
  291. USE &m0sysdr.sysdata
  292. @ 23,0
  293. * ' New fields to access multinet files from both DOS and Mac
  294. IF TYPE('maclink1') = 'U'
  295.   STORE FLOCK() TO lockedf
  296.   IF .NOT. lockedf
  297.     @ 23,0
  298.     @ 23,3 SAY 'File ' + UPPER(DBF()) + '. Attempting to lock file...'
  299.     DO WHILE .NOT. lockedf
  300.       STORE FLOCK() TO lockedf
  301.     ENDDO
  302.   ENDIF
  303.   @ 23,0
  304.   @ 23,1 SAY ;
  305.   '***  Updating SYSDATA file for networking with Macintosh computers  ***'
  306.   COPY STRUCTURE EXTENDED TO sysbuil
  307.   USE sysbuil EXCLUSIVE
  308.   LOCATE FOR field_name = 'MACPROG'
  309.   IF EOF()
  310.     APPEND BLANK
  311.     REPLACE field_name WITH 'MACPROG', field_type WITH 'C', ;
  312.     field_len WITH 40, field_dec WITH 0
  313.   ENDIF
  314.   LOCATE FOR field_name = 'MACDATA'
  315.   IF EOF()
  316.     APPEND BLANK
  317.     REPLACE field_name WITH 'MACDATA', field_type WITH 'C', ;
  318.     field_len WITH 40, field_dec WITH 0
  319.   ENDIF
  320.   LOCATE FOR field_name = 'MACSYST'
  321.   IF EOF()
  322.     APPEND BLANK
  323.     REPLACE field_name WITH 'MACSYST', field_type WITH 'C', ;
  324.     field_len WITH 40, field_dec WITH 0
  325.   ENDIF
  326.   APPEND BLANK
  327.   REPLACE field_name WITH 'MACLINK1', field_type WITH 'C', ;
  328.   field_len WITH 40, field_dec WITH 0
  329.   APPEND BLANK
  330.   REPLACE field_name WITH 'MACLINK2', field_type WITH 'C', ;
  331.   field_len WITH 40, field_dec WITH 0
  332.   APPEND BLANK
  333.   REPLACE field_name WITH 'MACLINK3', field_type WITH 'C', ;
  334.   field_len WITH 40, field_dec WITH 0
  335.   USE
  336.   CREATE systemp.dbf FROM sysbuil.dbf
  337.   USE systemp EXCLUSIVE
  338.   APPEND FROM sysdata
  339.   USE
  340.   DELETE FILE sysdata.dbf
  341.   DELETE FILE sysbuil.dbf
  342.   RENAME systemp.dbf TO sysdata.dbf
  343. ENDIF
  344. * ' Added fields in SYSTABL in version 6.21 for maximum value checking
  345. IF FILE('systabl.dbf')
  346.   USE systabl
  347.   IF TYPE('tblnum01') = 'U'
  348.     @ 23,0
  349.     @ 23,1 SAY ;
  350.     '***  Updating SYSTABL.DBF structure to support range checking  ***'
  351.     COPY TO sysbuil.dbf STRUCTURE EXTENDED
  352.     USE sysbuil EXCLUSIVE
  353.     APPEND BLANK
  354.     REPLACE field_name WITH 'TBLNUM01', field_type WITH 'N', ;
  355.     field_len WITH 15, field_dec WITH 4
  356.     APPEND BLANK
  357.     REPLACE field_name WITH 'TBLNUM02', field_type WITH 'N', ;
  358.     field_len WITH 15, field_dec WITH 4
  359.     APPEND BLANK
  360.     REPLACE field_name WITH 'TBLNUM03', field_type WITH 'N', ;
  361.     field_len WITH 15, field_dec WITH 4
  362.     USE
  363.     CREATE systemp.dbf FROM sysbuil.dbf
  364.     USE systemp EXCLUSIVE
  365.     APPEND FROM systabl
  366.     USE
  367.     DELETE FILE systabl.dbf
  368.     DELETE FILE sysbuil.dbf
  369.     RENAME systemp.dbf TO systabl.dbf
  370.   ENDIF && TYPE('tblnum01') = 'U'
  371. ENDIF && FILE('systabl.dbf')
  372. USE sysdata
  373. LOCATE FOR UPPER(sysid) = 'MM  '
  374. IF .NOT. m0single
  375.   STORE ' ' TO mans
  376.   DO WHILE SUBSTR(str10,1,1) = 'Y' .AND. mans <> 'Q'
  377.     * ' Clear file from current use area before displaying error msg
  378.     USE
  379.     * ' Display System Maintenance operation message
  380.     DO syshelp WITH 10002
  381.     STORE ' ' TO mans
  382.     @ 21,4 SAY 'Press Q to quit or any other key to retry access...' ;
  383.     GET mans PICTURE '!'
  384.     READ
  385.     IF mans <> 'Q'
  386.       USE sysdata
  387.       LOCATE FOR UPPER(sysid) = 'MM  '
  388.     ELSE
  389.       STORE .t. TO mquit
  390.       RETURN
  391.     ENDIF
  392.   ENDDO
  393. ENDIF
  394. DO p0setenv
  395. IF m0pgmid <> 'MM'
  396.   DO p0usrcnt WITH .t.
  397. ENDIF
  398. RETURN
  399. *
  400. * ' $Revision:   1.36  $
  401. * ' $Date:   30 May 1990 17:17:06  $
  402. **********************
  403. ** ' SYSSTRT.PRG  ' **
  404. ** '  405 Lines   ' **
  405. **********************
  406.