home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol063 / 123range.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-13  |  6.0 KB  |  160 lines
  1. 10    ' 123RANGE.BAS    List Lotus Range Names used in a spreadsheet file (.wks)20    '
  2. 30    ' Charles H. Greene dba ISM                           April 23, 1983
  3. 40    ' 150 West First Street
  4. 50    ' New Richmond, Wi   54017     <715> 246-6690
  5. 60    '
  6. 70    ' Lotus v1.0 does not provide for listing Range Names that have been
  7. 80    ' assigned..this program provides a modest solution to that problem.
  8. 90    '
  9. 100   DEFINT A-Z
  10. 150   DIM LOTUS.CTL$(10)
  11. 200   BLACK=0: WHITE=7: BRIGHT=16: FG=WHITE: BG=BLACK
  12. 210   FALSE=0: TRUE=NOT FALSE
  13. 220   END.OF.FILE=FALSE
  14. 230   FF$=CHR$(12)
  15. 500   X=0: Y=0: Z=0
  16. 510   X$=""
  17. 520   LOTUS.CTL$(1)=CHR$(0)             'characters seperating range names
  18. 530   LOTUS.CTL$(2)=CHR$(11)            'Range Name fields begin with the 1st
  19. 540   LOTUS.CTL$(3)=CHR$(0)             '  sequence of characters (2)-(5)
  20. 550   LOTUS.CTL$(4)=CHR$(24)            'any break in this sequence ends
  21. 560   LOTUS.CTL$(5)=CHR$(0)             '  the range names
  22. 5000  '
  23. 5010  ' Load table of column codes
  24. 5020  '
  25. 5030  DIM COL$(256)
  26. 5040  FOR X = 0 TO 255
  27. 5050     READ COL$(X)
  28. 5060  NEXT
  29. 5500  '
  30. 5510  ' Print Headings
  31. 5520  '
  32. 5530  PRINT
  33. 5540  KEY OFF: CLS: LOCATE ,,0
  34. 5550  PRINT "List Lotus(tm) Range Names                   "DATE$"  "LEFT$(TIME$,5)"   123RANGE <ISM>"
  35. 5560  PRINT
  36. 5570  PRINT "Press Ctrl PrtSc keys to send output to printer...."
  37. 5580  SOUND 32767,50:SOUND 32767,1
  38. 5590  '
  39. 5600  PRINT FF$"List Lotus(tm) Range Names                   "DATE$"  "LEFT$(TIME$,5)"   123RANGE <ISM>"
  40. 5610  PRINT
  41. 6000  '
  42. 6010  ' Get Lotus filespec
  43. 6020  '
  44. 6030  ON ERROR GOTO 15000
  45. 6040  PRINT "Enter LOTUS spreadsheet filespec : ";
  46. 6050  INPUT "",FILE$
  47. 6060  Z=INSTR(FILE$,".")                'make sure it has .wks extension
  48. 6070  IF Z=0 THEN FILE$=FILE$+".WKS"
  49. 6080  OPEN FILE$ AS #1 LEN=1
  50. 6090  FIELD #1,1 AS X$
  51. 6100  FCB=VARPTR(#1)                    'address FCB
  52. 6110  Z=PEEK(FCB)                       'file type must be random
  53. 6120  IF Z<>4 THEN CLOSE #1: GOTO 6000
  54. 6130  K1!=PEEK(FCB+19)*256
  55. 6131  K2!=K1!*256
  56. 6132  K3!=PEEK(FCB+17)
  57. 6134  K4!=256*PEEK(FCB+18)
  58. 6136  RCDLIMIT!=K1!+K2!+K3!+K4!
  59. 6140  IF RCDLIMIT!=0 THEN CLOSE #1: PRINT: PRINT "**** File not found ****": GOTO 6000
  60. 6150  PRINT: PRINT: PRINT "File contains "RCDLIMIT!"bytes.": PRINT: PRINT
  61. 6160  GOSUB 7500                        'get byte
  62. 6170  FLD.CNT=1: RANGE.NAME$=""
  63. 6180  WHILE NOT END.OF.FILE
  64. 6190      ON MATCH.CNT+1 GOSUB 10000, 10100, 10200, 10300, 10400
  65. 6200      GOSUB 7500
  66. 6990  WEND
  67. 7000  '
  68. 7010  ' End of Input
  69. 7020  '
  70. 7030  PRINT: PRINT: PRINT "< END OF LIST >"
  71. 7040  END                               'done
  72. 7050  PRINT "      < "FILE$" End of Range Name List >"
  73. 7500  '
  74. 7510  ' Read file
  75. 7520  '
  76. 7530  RCDNO!=RCDNO!+1                   'set next random record(byte) no.
  77. 7540                                    'check for end of file
  78. 7550  IF RCDNO!>RCDLIMIT! THEN END.OF.FILE=TRUE: X$="": GOTO 7590
  79. 7560  GET #1,RCDNO!
  80. 7590  RETURN
  81. 10000 '
  82. 10010 ' Look for start of range names 0Bh 00h 18h 00h
  83. 10020 '
  84. 10030 IF X$<>CHR$(11) THEN MATCH.CNT = 0:RETURN
  85. 10040 MATCH.CNT=1
  86. 10090 RETURN
  87. 10100 '
  88. 10110 IF X$<>CHR$(0)  THEN MATCH.CNT = 0: GOTO 10000
  89. 10120 MATCH.CNT=2
  90. 10190 RETURN
  91. 10200 '
  92. 10210 IF X$<>CHR$(24) THEN MATCH.CNT = 0: GOTO 10000
  93. 10220 MATCH.CNT=3
  94. 10290 RETURN
  95. 10300 '
  96. 10310 IF X$<>CHR$(0)  THEN MATCH.CNT = 0: GOTO 10000
  97. 10320 MATCH.CNT=4
  98. 10390 RETURN
  99. 10400 '
  100. 10410 ' Range name fields found
  101. 10420 '
  102. 10430 IF FLD.CNT > 15 GOTO 10500
  103. 10440 IF X$<>CHR$(0) THEN RANGE.NAME$=RANGE.NAME$+X$
  104. 10450 FLD.CNT=FLD.CNT+1
  105. 10490 RETURN
  106. 10500 IF FLD.CNT > 17 GOTO 10600
  107. 10510 IF FLD.CNT = 17 THEN RANGE.BEG.COL=ASC(X$)
  108. 10520 FLD.CNT=FLD.CNT+1
  109. 10590 RETURN
  110. 10600 IF FLD.CNT > 19 GOTO 10700
  111. 10610 IF FLD.CNT = 18 THEN RANGE.BEG.ROW=ASC(X$) ELSE RANGE.BEG.ROW=(RANGE.BEG.ROW * 256)+ASC(X$)
  112. 10620 FLD.CNT=FLD.CNT+1
  113. 10690 RETURN
  114. 10700 IF FLD.CNT > 21 GOTO 10800
  115. 10710 IF FLD.CNT = 21 THEN RANGE.END.COL=ASC(X$)
  116. 10720 FLD.CNT=FLD.CNT+1
  117. 10790 RETURN
  118. 10800 IF FLD.CNT > 23 GOTO 10900
  119. 10810 IF FLD.CNT = 22 THEN RANGE.END.ROW=ASC(X$): FLD.CNT=FLD.CNT+1: RETURN
  120. 10820 RANGE.END.ROW=(RANGE.END.ROW*256)+ASC(X$)
  121. 10840 PRINT USING "\              \";RANGE.NAME$;
  122. 10850 RANGE.BEG$=COL$(RANGE.BEG.COL)+MID$(STR$(RANGE.BEG.ROW+1),2)
  123. 10860 RANGE.END$=COL$(RANGE.END.COL)+MID$(STR$(RANGE.END.ROW+1),2)
  124. 10870 PRINT "   "RANGE.BEG$".."RANGE.END$"
  125. 10880 FLD.CNT=FLD.CNT+1: RANGE.NAME$=""
  126. 10890 RETURN
  127. 10900 IF X$<>LOTUS.CTL$(FLD.CNT-23) THEN END.OF.FILE=TRUE
  128. 10910 IF FLD.CNT < 28 THEN FLD.CNT=FLD.CNT+1 ELSE FLD.CNT=1
  129. 10990 RETURN
  130. 15000 '
  131. 15010 ' Error traps
  132. 15020 '
  133. 15030 IF ERR=57 THEN PRINT: PRINT "**** I/O Error         ****": END
  134. 15040 IF ERR<24 OR ERR>25 GOTO 15100
  135. 15050 IF ERL <>    6070 GOTO 15200
  136. 15060 IF ERL <>    7560 GOTO 15300
  137. 15070 PRINT:PRINT "**** Check disk drive -- press any key to continue ****"
  138. 15080 CHAR$=INKEY$: IF CHAR$="" THEN 15070 ELSE RESUME
  139. 15100 '   Disk file open errors
  140. 15190 GOTO 15900
  141. 15200 '   Disk I/O errors
  142. 15210 IF ERR=62 OR ERR=63 THEN END.OF.FILE=TRUE: X$="": RESUME 7590
  143. 15290 GOTO 15900
  144. 15300 '
  145. 15900 PRINT "ERROR #"ERR" IN LINE "ERL
  146. 15910 ON ERROR GOTO 0
  147. 60000 '
  148. 60010 ' Col Subscript
  149. 60020 '
  150. 60030 DATA A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  151. 60040 DATA AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ
  152. 60050 DATA BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ
  153. 60060 DATA CA,CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CM,CN,CO,CP,CQ,CR,CS,CT,CU,CV,CW,CX,CY,CZ
  154. 60070 DATA DA,DB,DC,DD,DE,DF,DG,DH,DI,DJ,DK,DL,DM,DN,DO,DP,DQ,DR,DS,DT,DU,DV,DW,DX,DY,DZ
  155. 60080 DATA EA,EB,EC,ED,EE,EF,EG,EH,EI,EJ,EK,EL,EM,EN,EO,EP,EQ,ER,ES,ET,EU,EV,EW,EX,EY,EZ
  156. 60090 DATA FA,FB,FC,FD,FE,FF,FG,FH,FI,FJ,FK,FL,FM,FN,FO,FP,FQ,FR,FS,FT,FU,FV,FW,FX,FY,FZ
  157. 60100 DATA GA,GB,GC,GD,GE,GF,GG,GH,GI,GJ,GK,GL,GM,GN,GO,GP,GQ,GR,GS,GT,GU,GV,GW,GX,GY,GZ
  158. 60110 DATA HA,HB,HC,HD,HE,HF,HG,HH,HI,HJ,HK,HL,HM,HN,HO,HP,HQ,HR,HS,HT,HU,HV,HW,HX,HY,HZ
  159. 60120 DATA IA,IB,IC,ID,IE,IF,IG,IH,II,IJ,IK,IL,IM,IN,IO,IP,IQ,IR,IS,IT,IU,IV
  160.