home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / WINER.ZIP / LOTUS123.BAS < prev    next >
BASIC Source File  |  1992-05-13  |  8KB  |  255 lines
  1. '*********** LOTUS123.BAS - shows how to read and write Lotus 1-2-3 files
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6. DECLARE SUB GetFormat (Format, Row, Column)
  7. DECLARE SUB WriteColWidth (Column, ColWidth)
  8. DECLARE SUB WriteInteger (Row, Column, ColWidth, Temp)
  9. DECLARE SUB WriteLabel (Row, Column, ColWidth, Msg$)
  10. DECLARE SUB WriteNumber (Row, Col, ColWidth, Fmt$, Num#)
  11.  
  12. DIM SHARED CellFmt AS STRING * 1        'to read one byte
  13. DIM SHARED ColNum(40)                   'max columns to write
  14. DIM SHARED FileNum                      'the file number to use
  15.  
  16. CLS
  17. PRINT "Read an existing 123 file or ";
  18. PRINT "Create a sample file (R/C)? ";
  19. LOCATE , , 1
  20. DO
  21.    X$ = UCASE$(INKEY$)
  22. LOOP UNTIL X$ = "R" OR X$ = "C"
  23. LOCATE , , 0
  24. PRINT X$
  25.  
  26. IF X$ = "R" THEN
  27.  
  28.   '----- read an existing file
  29.   INPUT "Lotus file to read: ", FileName$
  30.   IF INSTR(FileName$, ".") = 0 THEN
  31.     FileName$ = FileName$ + ".WKS"
  32.   END IF
  33.   PRINT
  34.  
  35.   '----- get the next file number and open the file
  36.   FileNum = FREEFILE
  37.   OPEN FileName$ FOR BINARY AS #FileNum
  38.  
  39.   DO UNTIL Opcode = 1                   'until End of File code
  40.  
  41.      GET FileNum, , Opcode              'get the next opcode
  42.      GET FileNum, , Length              'and the data length
  43.  
  44.      SELECT CASE Opcode                 'filter the Opcodes
  45.  
  46.     CASE 0                              'Beginning of File record
  47.       PRINT "Beginning of file, Lotus ";
  48.       GET FileNum, , Temp
  49.  
  50.       SELECT CASE Temp
  51.         CASE 1028
  52.           PRINT "1-2-3 version 1.0 or 1A"
  53.         CASE 1029
  54.           PRINT "Symphony version 1.0"
  55.         CASE 1030
  56.           PRINT "123 version 2.x"
  57.         CASE ELSE
  58.           PRINT "NOT a Lotus File!"
  59.       END SELECT
  60.  
  61.     CASE 1                                  'End of File
  62.       PRINT "End of File"
  63.  
  64.     CASE 12                                 'Blank cell
  65.        'Note that Lotus saves blank cells only if they are formatted or
  66.        'protected.
  67.        CALL GetFormat(Format, Row, Column)
  68.        PRINT "Blank:      Format ="; Format,
  69.        PRINT "Row ="; Row,
  70.        PRINT "Col ="; Column
  71.  
  72.     CASE 13                                 'Integer
  73.        CALL GetFormat(Format, Row, Column)
  74.        GET FileNum, , Temp
  75.        PRINT "Integer:    Format ="; Format,
  76.        PRINT "Row ="; Row,
  77.        PRINT "Col ="; Column,
  78.        PRINT "Value ="; Temp
  79.  
  80.     CASE 14                                 'Floating point
  81.        CALL GetFormat(Format, Row, Column)
  82.        GET FileNum, , Number#
  83.        PRINT "Number:     Format ="; Format,
  84.        PRINT "Row ="; Row,
  85.        PRINT "Col ="; Column,
  86.        PRINT "Value ="; Number#
  87.  
  88.     CASE 15                                 'Label
  89.        CALL GetFormat(Format, Row, Column)
  90.        'Create a string to hold the label.  6 is subtracted to exclude the
  91.        'Format, Column, and Row information.
  92.  
  93.        Info$ = SPACE$(Length - 6)
  94.        GET FileNum, , Info$                 'read the label
  95.        GET FileNum, , CellFmt$              'eat the CHR$(0)
  96.        PRINT "Label:      Format ="; Format,
  97.        PRINT "Row ="; Row,
  98.        PRINT "Col ="; Column, Info$
  99.  
  100.     CASE 16                                 'Formula
  101.        CALL GetFormat(Format, Row, Column)
  102.        GET FileNum, , Number#               'read cell value
  103.        GET FileNum, , Length                'and formula length
  104.        SEEK FileNum, SEEK(FileNum) + Length 'skip formula
  105.        PRINT "Formula:    Format ="; Format,
  106.        PRINT "Row ="; Row,
  107.        PRINT "Col ="; Column,
  108.        PRINT "Value ="; Number#
  109.  
  110.     CASE ELSE
  111.        Dummy$ = SPACE$(Length)              'skip the record
  112.        GET FileNum, , Dummy$                'read it in
  113.        PRINT "Opcode: "; Opcode             'show its Opcode
  114.  
  115.      END SELECT
  116.  
  117.      '----- pause when the screen fills
  118.      IF CSRLIN > 21 THEN
  119.        PRINT
  120.        PRINT "Press <ESC> to end or ";
  121.        PRINT "any other key for more"
  122.        DO
  123.          K$ = INKEY$
  124.        LOOP UNTIL LEN(K$)
  125.        IF K$ = CHR$(27) THEN EXIT DO
  126.        CLS
  127.      END IF
  128.  
  129.      NumRecs = NumRecs + 1                  'count the records
  130.  
  131.   LOOP
  132.   PRINT "Number of Records Processed ="; NumRecs
  133.   CLOSE
  134.  
  135. ELSE
  136.  
  137.   '----- write a sample file
  138.   FileNum = FREEFILE                        'as above
  139.   OPEN "SAMPLE.WKS" FOR BINARY AS #FileNum
  140.  
  141.   Temp = 0                                  'OpCode for Start of File
  142.   PUT FileNum, , Temp                       'write that
  143.   Temp = 2                                  'its data length is 2
  144.   PUT FileNum, , Temp                       'since it's an integer
  145.   Temp = 1030                               'Lotus version 2.x
  146.   PUT FileNum, , Temp
  147.  
  148.   Row = 0                                   'write this in Row 1
  149.   DO
  150.      CALL WriteLabel(Row, 0, 16, "This is a Label")
  151.      CALL WriteLabel(Row, 1, 12, "So is this")
  152.      CALL WriteInteger(Row, 2, 7, 12345)
  153.      CALL WriteNumber(Row, 3, 9, "C2", 57.23#)
  154.      CALL WriteNumber(Row, 4, 9, "F5", 12.3456789#)
  155.      CALL WriteInteger(Row, 6, 9, 99)       'skip a column for fun
  156.      Row = Row + 1                          'go on to the next row
  157.   LOOP WHILE Row < 6
  158.  
  159.   '----- Write the End of File record and close the file
  160.   Temp = 1                                  'Opcode for End of File
  161.   PUT FileNum, , Temp
  162.   Temp = 0                                  'the data length is zero
  163.   PUT FileNum, , Temp
  164.   CLOSE
  165.  
  166. END IF
  167. END
  168.  
  169. SUB GetFormat (Format, Row, Column) STATIC
  170.   GET FileNum, , CellFmt$: Format = ASC(CellFmt$)
  171.   GET FileNum, , Column
  172.   GET FileNum, , Row
  173. END SUB
  174.  
  175. SUB WriteColWidth (Column, ColWidth) STATIC
  176.  
  177.   '----- allow a column width only once for each column
  178.   IF NOT ColNum(Column) THEN
  179.     Temp = 8
  180.     PUT FileNum, , Temp
  181.     Temp = 3
  182.     PUT FileNum, , Temp
  183.     PUT FileNum, , Column
  184.     Temp$ = CHR$(ColWidth)
  185.     PUT FileNum, , Temp$
  186.     '----- show we wrote this column's width
  187.     ColNum(Column) = -1
  188.   END IF
  189.  
  190. END SUB
  191.  
  192. SUB WriteInteger (Row, Column, ColWidth, Integ) STATIC
  193.  
  194.   Temp = 13                                 'OpCode for an integer
  195.   PUT FileNum, , Temp
  196.   Temp = 7                                  'Length + 5 byte header
  197.   PUT FileNum, , Temp
  198.   Temp$ = CHR$(127)                         'the format portion
  199.   PUT FileNum, , Temp$
  200.   PUT FileNum, , Column
  201.   PUT FileNum, , Row
  202.   PUT FileNum, , Integ
  203.   CALL WriteColWidth(Column, ColWidth)
  204.  
  205. END SUB
  206.  
  207. SUB WriteLabel (Row, Column, ColWidth, Msg$)
  208.  
  209.   IF LEN(Msg$) > 240 THEN                   '240 is the maximum length
  210.     Msg$ = LEFT$(Msg$, 240)
  211.   END IF
  212.  
  213.   Temp = 15                                 'OpCode for a label
  214.   PUT FileNum, , Temp
  215.   Temp = LEN(Msg$) + 7                      'Length plus 5-byte header
  216.                                             'plus "'" plus CHR$(0)
  217.   PUT FileNum, , Temp
  218.   Temp$ = CHR$(127)                         '127 is the default format
  219.   PUT FileNum, , Temp$
  220.   PUT FileNum, , Column
  221.   PUT FileNum, , Row
  222.   Temp$ = "'" + Msg$ + CHR$(0)              'a "'" left-aligns a label
  223.                                             'use "^" instead to center
  224.   PUT FileNum, , Temp$
  225.   CALL WriteColWidth(Column, ColWidth)
  226.  
  227. END SUB
  228.  
  229. SUB WriteNumber (Row, Col, ColWidth, Fmt$, Num#) STATIC
  230.  
  231.   IF LEFT$(Fmt$, 1) = "F" THEN                    'fixed
  232.     '----- specify the number of decimal places
  233.      Format$ = CHR$(0 + VAL(RIGHT$(Fmt$, 1)))
  234.   ELSEIF LEFT$(Fmt$, 1) = "C" THEN                'currency
  235.      Format$ = CHR$(32 + VAL(RIGHT$(Fmt$, 1)))
  236.   ELSEIF LEFT$(Fmt$, 1) = "P" THEN                'percent
  237.      Format$ = CHR$(48 + VAL(RIGHT$(Fmt$, 1)))
  238.   ELSE                                            'default
  239.      Format$ = CHR$(127)                    'use CHR$(255) for protected
  240.   END IF
  241.  
  242.   Temp = 14                                 'Opcode for a number
  243.   PUT FileNum, , Temp
  244.   Temp = 13                                 'Length (8) + 5 = 13
  245.   PUT FileNum, , Temp
  246.  
  247.   PUT FileNum, , Format$
  248.   PUT FileNum, , Col
  249.   PUT FileNum, , Row
  250.   PUT FileNum, , Num#
  251.  
  252.   CALL WriteColWidth(Column, ColWidth)
  253.  
  254. END SUB
  255.