with trace
-- msxls.e 0.1
-- A file filter for reading & writing Microsoft Excel spreadsheet files.
-- Spreadsheet data will be stored in parallel sequences:
-- xls_data[]    - The static data
-- xls_format[]  - Formatting data for the same set of cells
-- xls_formula[] - Formula data for the same set of cells
-- xls_header[]  - The header array for the file
-- xls_footer[]  - The footer array for the file

-- Written by Michael J. Sabal
-- Credit given to Roger A. Marin for his Excel Tools, on which this is based.
-- Credit given to Daniel Rentz for his File Format document found on wotsit.org
-- Credit given to http://jakarta.apache.org/poi/poifs/fileformat.html for details on the OLE2 format

-- DISCLAIMER: This document is for informational and documentation purposes only.
-- The information contained herein likely violates a few thousand patents, so
-- use it at your own risk and liability.  Nothing here is warranted, and all
-- liability is restricted to the user.

--------------------------------------------------------------------------------
-- History log
--------------------------------------------------------------------------------
-- v.0.01a - 25 April 2006 - Initial programming
-- v.0.02a - 17 August 2006 - Properly read BIFF8/OLE2 documents

--------------------------------------------------------------------------------
-- To do list
--------------------------------------------------------------------------------
-- Handling of format codes is woefully incomplete.
-- Add support for formulas
-- Add support for column & row info defaults

--------------------------------------------------------------------------------
-- Limits
--------------------------------------------------------------------------------
-- 1. This version only responds to BIFF8 formats (Excel 97,2000,XP)
-- 2. You can only read/write single-sheet books


--------------------------------------------------------------------------------
-- INCLUDES
--------------------------------------------------------------------------------
include file.e
include wildcard.e
include get.e
include machine.e

--------------------------------------------------------------------------------
-- VARIABLES & CONSTANTS
--------------------------------------------------------------------------------
global sequence xls_data
global sequence xls_format
global sequence xls_formula
global sequence xls_header
global sequence xls_footer
global sequence xls_filename -- Name of currently processed file.
global sequence xls_encoded  -- Byte codes of BIFF8 file
global sequence xls_strings  -- Byte codes for strings
global sequence xls_xflist   -- Format types
global sequence xls_formatlist
global sequence xls_fontlist
global atom xls_fp           -- File pointer for currently processed file.
global sequence xls_error_string     -- Text of an occuring error.
global atom xls_BIFF_version         -- Excel version of file, here for convenience
atom logfile

sequence xls_record          -- Record of data, including opcode & params

-- Init
xls_data = {}
xls_format = {}
xls_formula = {}
xls_header = {}
xls_footer = {}
xls_filename = ""
xls_encoded = {}
xls_strings = {}
xls_xflist = {}
xls_formatlist = {}
xls_fontlist = {}
xls_fp = -1
xls_error_string = ""
xls_BIFF_version = -1
logfile = 1

global constant DEBUG=0

--------------------------------------------------------------------------------
-- SUPPORT ROUTINES
--------------------------------------------------------------------------------

global procedure xls_resetall()
  if xls_fp > 2 then
    close(xls_fp)
  end if
  xls_data = {}
  xls_format = {}
  xls_formula = {}
  xls_header = {}
  xls_footer = {}
  xls_filename = ""
  xls_encoded = {}
  xls_strings = {}
  xls_xflist = {}
  xls_formatlist = {}
  xls_fontlist = {}
  xls_fp = -1
  xls_error_string = ""
  xls_BIFF_version = -1
  logfile = 1
end procedure

--------------------------------------------------------------------------------

function xls_get_bytes(integer n)

  -- Returns atom: FAILURE, sequence: BYTES

  sequence bytes
  atom byte
  bytes = {}

  for ctr = 1 to n do
    byte = getc(xls_fp)
    if byte < 0 then
      xls_error_string = "Invalid file read."
      return -14
    end if
    bytes = bytes & byte
  end for
  return bytes

end function

--------------------------------------------------------------------------------

function xls_get_bytes_a(integer n)

  -- performs the conversion from sequence to atom, assumes unsigned integer
  -- Returns negative: FAILURE, positive: BYTES
  object bytes
  atom num
  bytes = xls_get_bytes(n)
  if atom(bytes) then
    return bytes
  end if
  num = 0
  for ctr = length(bytes) to 1 by -1 do
    num = num + (bytes[ctr]*power(256,ctr-1))
  end for
  return num

end function

--------------------------------------------------------------------------------

function xls_bytes2a(sequence bytes)

  atom num

  num = 0
  for ctr = length(bytes) to 1 by -1 do
    num = num + (bytes[ctr]*power(256,ctr-1))
  end for
  return num

end function

--------------------------------------------------------------------------------

function xls_i2bytes(integer i)

  -- returns a big endian sequence that can be passed to float??_to_atom

  sequence bytes
  bytes = {0,0}

  if i > power(2,16) then
    bytes = {0,0,0,0}
    bytes[4]=floor(i/power(256,3))
    i = i - (floor(i/power(256,3))*power(256,3))
    bytes[3]=floor(i/power(256,2))
    i = i - (floor(i/power(256,2))*power(256,2))
    bytes[2]=floor(i/256)
    bytes[1]=remainder(i,256)
  else
    bytes[2]=floor(i/256)
    bytes[1]=remainder(i,256)
  end if
  return bytes

end function

--------------------------------------------------------------------------------

function xls_ieeebytes2a(sequence bytes)

  sequence bits
  atom e, f, s

    bits = {}
    for ctr = length(bytes) to 1 by -1 do
      bits = bits & reverse(int_to_bits(bytes[ctr],8))
    end for
    e = bits_to_int(reverse(bits[2..12]))
    f = 0
    if bits[1] = 0 then
      s = 1
    else
      s = -1
    end if
    for ctr = 1 to length(bits)-12 do
      if bits[ctr+12] then
        f = f + (1/power(2,ctr))
      end if
    end for
    if e != 0 and e != 2047 then
      f = f + 1
      return (s * power(2,e-1023) * f)
    elsif e = 0 then
      return (s * power(2,-1022) * f)
    else
      return float32_to_atom(reverse(bytes))
    end if

end function

--------------------------------------------------------------------------------

function xls_rk2a(sequence bytes)

  atom divby
  atom i_f

  divby = 1
  i_f = 1
  if length(bytes)<4 then
    return 0
  end if
  if and_bits(bytes[1],1)=1 then
    divby = 100
  end if
  if and_bits(bytes[1],2)=2 then
    i_f = 1
  else
    i_f = 0
  end if
  bytes[1] = and_bits(bytes[1],#FC)

  if i_f = 1 then
    return xls_bytes2a(bytes)/(4*divby)
  else
    return xls_ieeebytes2a(bytes)/divby
  end if

end function

--------------------------------------------------------------------------------

function xls_a2rk(atom a)
  --** TO DO **--
  return {0,0,0,0}
end function

--------------------------------------------------------------------------------

function xls_a2string(atom a, object format)

  atom xfrec,fmtrec
  object fmtcode
  atom ly
  sequence dt

  if atom(format) then
    xfrec = format
  elsif length(format) >= 4 then
    xfrec = xls_bytes2a(format[3..4])+1
  else
    return sprintf("%f",a)
  end if
  if xfrec > length(xls_xflist) or (sequence(xls_xflist[xfrec]) and
         length(xls_xflist[xfrec])<4) then
    return sprintf("%f",a)
  end if
  fmtrec = xls_bytes2a(xls_xflist[xfrec][3..4])+1
  fmtcode = -1
  if atom(fmtrec) and fmtrec = 1 then
    -- If the format code is 0, check for a parent xf record
    xfrec = xls_bytes2a(xls_xflist[xfrec][5..6])+1
    if and_bits(xfrec,#FFF0)=#FFF0 or xfrec > length(xls_xflist) then
      fmtrec = -1
      fmtcode = -1
    else
      fmtrec = xls_bytes2a(xls_xflist[xfrec][3..4])+1
    end if
  end if
  if fmtrec = 1 or fmtrec = -1 then
    fmtrec = format
    fmtcode = format
  else
    for ctr = 1 to length(xls_formatlist) do
      if length(xls_formatlist[ctr])>2 and fmtrec=xls_bytes2a(xls_formatlist[ctr][1..2]) then
        fmtcode = xls_formatlist[ctr][3..length(xls_formatlist[ctr])]
        exit
      end if
    end for
  end if
  if atom(fmtcode) and fmtcode = -1 then
    fmtcode = fmtrec
  end if
  if atom(fmtcode) and (fmtcode = 1 or fmtcode = 15) then
    return sprintf("%d",a)
--  elsif fmtcode=#A then
--    return sprintf("%0.2d%%",a)
  elsif (atom(fmtcode) and find(fmtcode,{#9,#A,#E,#10,#11,#16,#19})) or
        (sequence(fmtcode) and (find('M',fmtcode) or find('D',fmtcode) or find('Y',fmtcode) or
         find('y',fmtcode))) then
    -- return date
    dt = {1900,1,1}
    a = a - 1  -- 1/1/1900 begins as #1
    while a > 0 do
      if remainder(dt[1],4)=0 then
        -- and (remainder(dt[1],100)>0 or remainder(dt[1],400)=0) Microsoft Excel includes years divisible
        -- by 100 but not by 400 as leap years.
        ly = 1
      else
        ly = 0
      end if
      if a >= 366 and ly = 1 then
        dt[1] = dt[1] + 1
        a = a - 366
      elsif a >= 365 and ly = 0 then
        dt[1] = dt[1] + 1
        a = a - 365
      elsif find(dt[2],{1,3,5,7,8,10,12}) and a >= 31 then
        dt[2] = dt[2] + 1
        a = a - 31
      elsif find(dt[2],{4,6,9,11}) and a >= 30 then
        dt[2] = dt[2] + 1
        a = a - 30
      elsif dt[2]=2 and ly=1 and a >= 29 then
        dt[2] = dt[2] + 1
        a = a - 29
      elsif dt[2]=2 and ly=0 and a >= 28 then
        dt[2] = dt[2] + 1
        a = a - 28
      else
        dt[3] = dt[3] + a
        a = 0
      end if
    end while
    return sprintf("%d/%d/%d",{dt[2],dt[3],dt[1]})
  else
    return sprintf("%f",a)
  end if


end function

--------------------------------------------------------------------------------

function xls_ascii2unicode(sequence string)

  sequence out
  out = {}
  for ctr = 1 to length(string) do
    out = out & string[ctr] & #00
  end for
  return out

end function

--------------------------------------------------------------------------------

function xls_unicode2ascii(sequence bytes)

  sequence out
  out = ""
  for ctr = 1 to length(bytes) by 2 do
    out = out & bytes[ctr]
  end for
  return out

end function

--------------------------------------------------------------------------------

function xls_get_opcode()

  -- Returns positive: OPCODE, negative: FAILURE
  object bytes

  bytes = xls_get_bytes(2)
  if atom(bytes) then
    return bytes
  end if
  if length(bytes) < 2 or sequence(bytes[1]) or sequence(bytes[2]) then
    return -1
  end if
  return (bytes[2]*256)+bytes[1]

end function

--------------------------------------------------------------------------------

function xls_get_reclen()

  -- Returns positive: RECLEN, negative: FAILURE
  -- NOTE: Record lengths and opcodes are both 2-byte fields.  The
  -- different names are just for program clarity.
  return xls_get_opcode()

end function

--------------------------------------------------------------------------------

procedure xls_add2format(atom row, atom column, atom lrow, atom lcolumn, atom xfidx)

  if xfidx > length(xls_xflist) then
    return
  end if

  if length(xls_format)<row then
    xls_format = xls_format & repeat({},row-length(xls_format)+1)
  end if
  if length(xls_format)<lrow then
    xls_format = xls_format & repeat({},lrow-length(xls_format)+1)
  end if

  for ctr = row to lrow do
    if length(xls_format[ctr])<column then
      xls_format[ctr] = xls_format[ctr] & repeat({},column-length(xls_format[ctr])+1)
    end if
    if length(xls_format[ctr])<lcolumn then
      xls_format[ctr] = xls_format[ctr] & repeat({},lcolumn-length(xls_format[ctr])+1)
    end if
    for ctr2 = column to lcolumn do
      xls_format[ctr][ctr2] = xfidx
    end for
  end for

end procedure

--------------------------------------------------------------------------------

procedure xls_add2data(atom row, atom column, atom lrow, atom lcolumn, object data)

  if length(xls_data)<row then
    xls_data = xls_data & repeat({},row-length(xls_data)+1)
  end if
  if length(xls_data)<lrow then
    xls_data = xls_data & repeat({},lrow-length(xls_data)+1)
  end if

  for ctr = row to lrow do
    if length(xls_data[ctr])<column then
      xls_data[ctr] = xls_data[ctr] & repeat({},column-length(xls_data[ctr])+1)
    end if
    if length(xls_data[ctr])<lcolumn then
      xls_data[ctr] = xls_data[ctr] & repeat({},lcolumn-length(xls_data[ctr])+1)
    end if
    for ctr2 = column to lcolumn do
      xls_data[ctr][ctr2] = data
    end for
  end for

end procedure

--------------------------------------------------------------------------------
-- FILTER ROUTINES
--------------------------------------------------------------------------------
---------------------------------------
-- OLE2
---------------------------------------

function xls_block2offset(integer block)
  -- Return offset within file
  return (block+1)*512
end function

--------------------------------------------------------------------------------

function xls_read_ole_header()

  object try
  object preamble, property
  sequence title
  -- two bytes have already been read
  preamble = #D0&#CF&get_bytes(xls_fp,510)
  if atom(preamble) or length(preamble)<512 then
    return 0
  end if
  -- locate the Root property record
  if DEBUG then
    puts(logfile,"Jumping to "&sprintf("%x\n",xls_block2offset(bytes_to_int(preamble[49..53]))))
  end if
  try = seek(xls_fp,xls_block2offset(bytes_to_int(preamble[49..53])))
  if try!=0 then
    return 0
  end if
  property = get_bytes(xls_fp,512)
  if length(property)<512 then
    return 0
  end if
  -- The file property record is usually in the same big block
  for ctr = 0 to 3 do
    title = upper(xls_unicode2ascii(property[(ctr*#80)+1..(ctr*#80)+
            bytes_to_int(property[(ctr*#80)+#41..(ctr*#80)+#42]&0&0)-2]))
    if DEBUG then
      puts(logfile,"Property title: "&title&"\n")
    end if
    if compare(title,"BOOK")=0 or compare(title,"WORKBOOK")=0 then
      -- found it, now go to it
      try = seek(xls_fp,xls_block2offset(bytes_to_int(property[(ctr*#80)+#75..(ctr*#80)+#79])))
      if DEBUG then
        puts(logfile,"Jumping to "&sprintf("%x\n",xls_block2offset(bytes_to_int(property[(ctr*#80)+#75..(ctr*#80)+#79]))))
      end if
      if try != 0 then
        return 0
      else
        try = xls_get_opcode()
        if try < 0 then
          return 0
        else
          xls_record = {try}
        end if
        return 1
      end if
    end if
  end for

  xls_record = {}
  return 0

end function

--------------------------------------------------------------------------------

function xls_write_ole_header()

  -- Returns OLE blocks

  atom BAT_COUNT                      -- number of elements in BAT array
  atom PROPERTIES_START               -- block index of first block of the property table
  atom SIZE_OF_FILE                   -- actual size of spreadsheet
  atom strlen                         -- length of a given string
  sequence block1                     -- preamble
  sequence block2                     -- properties
  sequence bat_array

  bat_array = repeat(-1,109)
  bat_array[1]=-2
  BAT_COUNT = 1
  PROPERTIES_START = 0
  SIZE_OF_FILE = length(xls_encoded)
  block1 = {
    #D0,#CF,#11,#E0,#A1,#B1,#1A,#E1,                    -- 0x0000 magic
    #00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,    -- 0x0008 unknown constants
    #00,#00,#00,#00,
    #3E,#00,#03,#00,#FE,#FF,                            -- 0x0018 unknown constants, versions?
    #09,#00,#06,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00,#00 -- 0x001E log2 big block size, log2 small block size, unknown constants
  } & int_to_bytes(BAT_COUNT) & int_to_bytes(PROPERTIES_START) & {  -- 0x002C
    #00,#00,#00,#00,#00,#10,#00,#00,                    -- 0x0034 unknown constants
    #FE,#FF,#FF,#FF,#00,#00,#00,#00,                    -- 0x003C first block (-2) & #blocks of SBAT
    #FE,#FF,#FF,#FF,#00,#00,#00,#00                    -- 0x0044 first block (-2) & #blocks of XBAT
  }
  for ctr = 1 to 109 do                                 -- 0x004C BAT array
    block1 = block1 & int_to_bytes(bat_array[ctr])
  end for

  block2 = xls_ascii2unicode("Root Entry")&#00&#00
  strlen = length(block2)
  for ctr = length(block2)+1 to #40 do
    block2 = block2 & #00
  end for
  block2 = block2 & remainder(strlen,256) & floor(strlen/256) -- +#40 length of title
  block2 = block2 & {#05,#01,#FF,#FF,#FF,#FF,#FF,#FF,#FF,#FF} -- +#42 5=root,1=black,prev peer, next peer
  block2 = block2 & {#01,#00,#00,#00} & repeat(0,36)          -- +#4C location of child w/in property + timestamps
  block2 = block2 & {#FE,#FF,#FF,#FF,#00,#00,#00,#00,#00,#00,#00,#00} -- +#74 block index of file (N/A)
  block2 = block2 & xls_ascii2unicode("Book")&#00&#00
  strlen = (length("Book")*2)+2
  for ctr = length(block2)+1 to #C0 do
    block2 = block2 & #00
  end for
  block2 = block2 & remainder(strlen,256) & floor(strlen/256) -- +#40 length of title
  block2 = block2 & {#02,#01,#FF,#FF,#FF,#FF,#FF,#FF,#FF,#FF} -- +#42 2=file,1=black,prev peer, next peer
  block2 = block2 & {#FF,#FF,#FF,#FF} & repeat(0,36)          -- +#4C location of child w/in property + timestamps
  block2 = block2 & {#01,#00,#00,#00} &
         int_to_bytes(SIZE_OF_FILE) & {#00,#00,#00,#00}       -- +#74 block index & actual size of file (N/A)
  block2 = block2 & repeat(#FF,256)                             -- block fill

  return block1 & block2

end function

---------------------------------------
-- HEADER
---------------------------------------

global function xls_read_header()
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE

  sequence header_recs
  atom try
  atom done
  atom array_ct, cont_flag, last_array_ct
  object x, bytes, temp, save_string

  header_recs = {#0000,#0009,#000A,#0013,#0016,#0017,#0018,#001E,#0023,
                          #0031,#003C,#0051,#0059,#005A,#008E,#0092,#00E0,#00FC,#01AE,
                          #0200,#0209,#0218,#0223,#0231,#0243,#0409,#041E,#0443,
                          #0809,#D0CF}

  try = seek(xls_fp,0)
  if try != 0 then
    xls_error_string = "Could not return to the beginning of the file."
    return -13
  end if

  done = 0
  cont_flag = 0
  xls_header = {}
  save_string = {}
  while not done do

    x = xls_get_opcode()
    if DEBUG and 0 then
      puts(logfile,sprintf("%x ",x))
    end if
    if x < 0 then
      return x
    end if
    if x = #CFD0 then -- #D0,#CF are reversed coming out the function call
      try = xls_read_ole_header()
    else
      xls_record = {x}
    end if
    x = xls_get_reclen()
    if x < 0 then
      return x
    end if
    xls_record = append(xls_record,x)
    if xls_record[1]=#003C then
      -- special handling for a CONTINUE record
      xls_record = xls_header[length(xls_header)]
      xls_record[2] = xls_record[2] + x
      xls_header = xls_header[1..length(xls_header)-1]
      cont_flag = 1
    else
      cont_flag = 0
    end if
    bytes = xls_get_bytes(x)
    if atom(bytes) then
      return bytes
    end if
    if find(xls_record[1],header_recs)>0 then
      if xls_record[1]=#0000 then
        -- DIMENSIONS
        xls_BIFF_version = 2

      elsif xls_record[1]=#0009 then
        -- BOF record, version 2
        xls_BIFF_version = 2

      elsif xls_record[1]=#000A then
        -- EOF record
        done=1
      elsif xls_record[1]=#0013 then
        -- PASSWORD record

      elsif xls_record[1]=#0016 then
        -- EXTERNCOUNT record

      elsif xls_record[1]=#0017 then
        -- EXTERNSHEET record

      elsif xls_record[1]=#0018 then
        -- NAME record

      elsif xls_record[1]=#001E then
        -- FORMAT record
        xls_formatlist = append(xls_formatlist,bytes)
      elsif xls_record[1]=#0023 then
        -- EXTERNNAME record

      elsif xls_record[1]=#0031 then
        -- FONT record

      elsif xls_record[1]=#003C then
        -- CONTINUE record
        -- handled above
      elsif xls_record[1]=#0051 then
        -- DCONREF record

      elsif xls_record[1]=#0059 then
        -- XCT record

      elsif xls_record[1]=#005A then
        -- CRN record

      elsif xls_record[1]=#008E then
        -- SHEETSOFFSET record

      elsif xls_record[1]=#0092 then
        -- PALETTE record

      elsif xls_record[1]=#00E0 then
        -- XF record
        xls_xflist = append(xls_xflist,bytes)
      elsif xls_record[1]=#00FC then
        -- SST record
        if length(bytes)>=12 then
          if cont_flag = 0 then
            if DEBUG then
              puts(logfile,sprintf("\nStrings table (%d records):\n",length(xls_strings)))
            end if
            array_ct = xls_bytes2a(bytes[5..8])
            x = 9  -- pointer
            last_array_ct = 1
          else
            x = 1
            if length(save_string) > 0 then
              bytes = save_string & bytes[2..length(bytes)]
              save_string = {}
            end if
          end if
          for ctr = last_array_ct to array_ct do
            if x+1 > length(bytes) then
              temp = length(bytes)
              last_array_ct = ctr
              exit
            end if
            temp = xls_bytes2a(bytes[x..x+1])
            if x+3+temp-1 > length(bytes) then
              save_string = bytes[x..length(bytes)]
              last_array_ct = ctr
              exit
            end if
            xls_strings = append(xls_strings,bytes[x+3..x+3+temp-1])
            x = x + 3 + temp
          end for
        end if
      elsif xls_record[1]=#01AE then
        -- SUPBOOK record

      elsif xls_record[1]=#0200 then
        -- DIMENSIONS record

      elsif xls_record[1]=#0209 then
        -- BOF record (v3)
        xls_BIFF_version = 3

      elsif xls_record[1]=#0218 then
        -- NAME record

      elsif xls_record[1]=#0223 then
        -- EXTERNNAME record

      elsif xls_record[1]=#0231 then
        -- FONT record
        xls_fontlist = append(xls_fontlist,bytes)
      elsif xls_record[1]=#0243 then
        -- XF record
        xls_xflist = append(xls_xflist,bytes)
      elsif xls_record[1]=#0409 then
        -- BOF record, version 4
        xls_BIFF_version = 4

      elsif xls_record[1]=#041E then
        -- FORMAT record
        xls_formatlist = append(xls_formatlist,bytes)
      elsif xls_record[1]=#0443 then
        -- XF record
        xls_BIFF_version = 4

      elsif xls_record[1]=#0809 then
        -- BOF record: version 6,7,8
        if length(bytes)<4 then
          xls_error_string="Invalid record format."
          return -21
        end if
        x = (bytes[1]*256)+bytes[2]  -- version; reverse of normal
        if x=6 then x=8 end if
        xls_record = append(xls_record,x)
        xls_BIFF_version = x
        x = xls_bytes2a(bytes[3..4])  -- type of file
        xls_record = append(xls_record,x)
        if xls_BIFF_version > 4 and length(bytes)>=8 then
          x = xls_bytes2a(bytes[5..6]) -- build identifier
          xls_record = append(xls_record,x)
          x = xls_bytes2a(bytes[7..8]) -- build year
          xls_record = append(xls_record,x)
          if xls_BIFF_version = 8 and length(bytes)>=16 then
            x = xls_bytes2a(bytes[9..12]) -- File history flags
            xls_record = append(xls_record,x)
            x = xls_bytes2a(bytes[13..16]) -- Lowest version of Excel that can read all records in the file
            xls_record = append(xls_record,x)
          end if
        end if
      end if
      xls_header = append(xls_header,xls_record)
      xls_record = {}
    elsif xls_record[1]=#D0CF then
      -- OLE2 magic
    elsif xls_BIFF_version != 8 then
      done = 1
    end if
  end while

  if DEBUG then
    puts(logfile,"\n\nAt: "&sprintf("%x\n",where(xls_fp)))
  end if
  return 1

end function

--------------------------------------------------------------------------------

global function xls_read_sheet()

  atom try
  atom done
  atom row, column, lcolumn
  object x, bytes, temp

  done = 0
  while not done do
    x = xls_get_opcode()
    if DEBUG then
      puts(logfile,sprintf("%x: ",x))
    end if
    if x < 0 then
      return x
    end if
    if x = #CFD0 then -- #D0,#CF are reversed coming out the function call
      try = xls_read_ole_header()
    else
      xls_record = {x}
    end if
    x = xls_get_reclen()
    if x < 0 then
      return x
    end if
    xls_record = append(xls_record,x)
    bytes = xls_get_bytes(x)
    if atom(bytes) then
      return bytes
    end if
    if DEBUG and 0 then
      for ctr9 = 1 to length(bytes) do
        puts(logfile,sprintf("%x ",bytes[ctr9]))
      end for
      puts(logfile,"\n")
    end if
    if 1 then  -- record validation: TO DO
      row = 0
      column = 0
      if length(bytes)>=4 then
--        row = xls_bytes2a(bytes[1..2]) + 1
--        column = xls_bytes2a(bytes[3..4]) + 1
--        if row = 61 and column = 46 then trace(1) end if
        -- bytes[5..6]=index to XF record
      end if

      if xls_record[1]=#000A then
        done = 1
      elsif xls_record[1]=#0001 then
        -- BLANK record
      elsif xls_record[1]=#0002 then
        -- INTEGER record

      elsif xls_record[1]=#0006 then
        -- FORMULA record

      elsif xls_record[1]=#000C then
        -- CALCOUNT record

      elsif xls_record[1]=#000F then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0010 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0011 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0014 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0015 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#001D then
        -- SELECTION record

      elsif xls_record[1]=#0026 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0027 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0028 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0029 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#002A then
        --** UNKNOWN record **--

      elsif xls_record[1]=#002B then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0055 then
        -- DEFCOLWIDTH record

      elsif xls_record[1]=#005F then
        --** UNKNOWN record **--

      elsif xls_record[1]=#007D then
        -- COLINFO record

      elsif xls_record[1]=#0080 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0081 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0082 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0083 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#0084 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#00A1 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#00BD then
        -- MULRK record
        if length(bytes)>=12 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          for ctr = 5 to length(bytes)-2 by 6 do
            if ctr+5 <= length(bytes) then
              xls_add2format(row,column,row,column,xls_bytes2a(bytes[ctr..ctr+1]))
              xls_add2data(row,column,row,column,xls_rk2a(bytes[ctr+2..ctr+5]))
              column = column + 1
            end if
          end for
        end if
      elsif xls_record[1]=#00BE then
        -- MULBLANK record
        if length(bytes)>=6 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          -- bytes[5..~-1]=index to XF records
          lcolumn = xls_bytes2a(bytes[length(bytes)-1..length(bytes)]) + 1
        end if
      elsif xls_record[1]=#00E5 then
        -- MERGEDCELLS record

      elsif xls_record[1]=#00EC then
        --** UNKNOWN record **--

      elsif xls_record[1]=#00FD then
        -- LABELSST record
        if length(bytes)>=8 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          -- bytes[5..6]=index to XF record
          x = xls_bytes2a(bytes[7..10])
          temp=length(xls_strings)
          if x+1 <= length(xls_strings) then
            xls_add2data(row,column,row,column,xls_strings[x+1])
          end if
        end if
      elsif xls_record[1]=#0200 then
        -- DIMENSIONS record

      elsif xls_record[1]=#0201 then
        -- BLANK record
        if length(bytes)>=6 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          -- bytes[5..6]=index to XF record
        end if
      elsif xls_record[1]=#0203 then
        -- NUMBER record
        if length(bytes)>=14 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          xls_add2format(row,column,row,column,xls_bytes2a(bytes[5..6]))
          xls_add2data(row,column,row,column,xls_ieeebytes2a(bytes[7..14]))
        end if
      elsif xls_record[1]=#0208 then
        --** UNKNOWN record: lines & borders? **--

      elsif xls_record[1]=#0225 then
        --** UNKNOWN record **--

      elsif xls_record[1]=#023E then
        --** UNKNOWN record **--

      elsif xls_record[1]=#027E then
        -- RK record
        if length(bytes)>=10 then
          row = xls_bytes2a(bytes[1..2]) + 1
          column = xls_bytes2a(bytes[3..4]) + 1
          xls_add2format(row,column,row,column,xls_bytes2a(bytes[5..6]))
          xls_add2data(row,column,row,column,xls_rk2a(bytes[7..10]))
        end if
      elsif xls_record[1]=#0809 then
        -- BOF record

      end if
    end if
  end while


  if DEBUG then
    puts(logfile,"\n\nAt: "&sprintf("%x\n",where(xls_fp)))
  end if
  return 1

end function

--------------------------------------------------------------------------------

global function xls_encode_header()

  sequence EXTSST
  sequence BIFF8_Header_Records_A, BIFF8_Header_Records_B,
           BIFF8_Header_Records_C, BIFF8_Header

  EXTSST = {}
  BIFF8_Header_Records_A =
{
 #09,#08,#08,#00,#00,#05,#05,#00,#A0,#19,#CD,#07,         --BOF BIFF version=8, doc type=workbook globals
--     #C1,#C0,#00,#00,#06,#03,#00,#00,
-- #40,#00,#02,#00,#00,#00,                                 --BACKUP         is off
 #31,#02,#0C,#00,#C8,#00,#00,#00,#FE,#FF,#05,'A','r','i','a','l' --FONT
 --#31,#02,#0A,#00,#C8,#00,#01,#00,#05,'A','r','i','a','l', --FONT
 --#31,#02,#0A,#00,#C8,#00,#02,#00,#05,'A','r','i','a','l', --FONT
 --#31,#02,#0A,#00,#C8,#00,#03,#00,#05,'A','r','i','a','l', --FONT
 --#31,#02,#0A,#00,#C8,#00,#00,#00,#05,'A','r','i','a','l', --FONT

}

  BIFF8_Header_Records_B =
-- {#AE,#01,#04,#00,#01,#00,#01,#04,                         --SUPBOOK0: own
-- #17,#00,#08,#00,#01,#00,#00,#00,#00,#00,#00,#00           --EXTERNSHEET: own
{ }


  BIFF8_Header_Records_C =
 {#0A,#00,#00,#00,                                        --EOF Worksheet Globals
 #09,#08,#08,#00,#00,#05,#10,#00,#A0,#19,#CD,#07,         --BOF BIFF version=8, doc type=worksheet
 --    #C1,#C0,#00,#00,#06,#03,#00,#00,
-- #0D,#00,#02,#00,#01,#00,                                 --CALCMODE automatic
 #0C,#00,#02,#00,#64,#00,                                 --CALCOUNT 
 #19,#00,#02,#00,#00,#00}                                 --WINDOW PROTECT is off
-- #00,#02,#0E,#00} &                                       --DIMENSIONS
-- int_to_bytes(0) & int_to_bytes(length(xls_data)) &
-- int_to_bytes(0)
-- if length(xls_data)>0 then
--   BIFF8_Header_Records_C &= remainder(length(xls_data[1]),256) & floor(length(xls_data[1])/256)
-- else
--   BIFF8_Header_Records_C &= #01 & #00
-- end if
-- BIFF8_Header_Records_C &= #00 & #00

  BIFF8_Header = BIFF8_Header_Records_A &
                 {#85,#00,#0F,#00} & int_to_bytes(length(BIFF8_Header_Records_A)+
                      length(xls_strings)+14+length(BIFF8_Header_Records_B)+
                      4+19) & #00 & #00 &              --BOUNDSHEET 0: 14=lenth of EXTSST, 23=length of BOUNDSHEET, 4=length of EOF
                      #07 & #00 & "Sheet01" &
                 xls_strings &
                 {#FF,#00,#0A,#00} &                      -- EXTSST
                 xls_strings[5..6] &                      -- : # of strings in the hash (2 bytes)
                 int_to_bytes(length(BIFF8_Header_Records_A)+12) &  -- absolute offset for the first string
                 {#0C,#00,#00,#00} &                      -- position of first string within record
                 BIFF8_Header_Records_B &
                 BIFF8_Header_Records_C

  xls_header = BIFF8_Header

  return 1

end function

--------------------------------------------------------------------------------

global function xls_write_header()
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE



  return 1

end function

---------------------------------------
-- FOOTER
---------------------------------------

global function xls_read_footer()
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE


  return 1

end function

--------------------------------------------------------------------------------

global function xls_write_footer()
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE


  return 1

end function

---------------------------------------
-- FILE
---------------------------------------

global function xls_open_xls(sequence fname, object method)
  -- Returns xls_fp: >2 on SUCCESS, 0 or negative on FAILURE

  if length(fname)=0 then
    xls_error_string = "xls_open_xls requires a valid filename."
    return 0
  end if
  if atom(method) and find(method,"RrWw")=0 then
    xls_error_string = "xls_open_xls method must be R,W,Rb, or Wb."
    return -12
  end if
  if sequence(method) and find(upper(method),{"R","W","RB","WB"})=0 then
    xls_error_string = "xls_open_xls method must be R,W,Rb, or Wb."
    return -12
  end if
  if atom(method) or length(method)=1 then
    method = method & "B"
  end if
  method = lower(method)

  xls_fp = open(fname,method)
  if xls_fp > 2 then
    xls_filename = fname
  else
    xls_filename = ""
  end if

  return xls_fp

end function

--------------------------------------------------------------------------------

global function xls_close_xls()
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE

  if xls_fp > 2 then
    close(xls_fp)
    xls_fp = -1
    return 1
  else
    xls_error_string = "File already closed."
    return 0
  end if

end function

---------------------------------------
-- DATA
---------------------------------------

global function xls_build_strings()
  -- Returns indexed string list

  -- When encoding the header, SST = #FC,#00,??,?? (record length)
  -- 4 bytes: total number of strings, 4 bytes: total number of unique strings
  -- For each string that follows:
     -- 2 bytes: length of string, 1 byte: #00 (8-bit, no formatting)
     -- var.: the string itself

  atom sctr, uctr, done
  sequence strlist
  sequence SST
  strlist = {}
  SST = {}
  sctr = 0
  uctr = 0

  for row = 1 to length(xls_data) do
    for cell = 1 to length(xls_data[row]) do
      if sequence(xls_data[row][cell]) then
        -- The only sequence in an Excel cell would be a string.
        -- Formulas, formats, and OLE objects are stored in
        -- different data elements.
        done = 0
        for sidx = 1 to length(strlist) do
          if compare(xls_data[row][cell],strlist[sidx][2])=0 then
            done = 1
            sctr = sctr + 1
            exit
          end if
        end for
        if not done then
          strlist = append(strlist,{length(strlist)+1,xls_data[row][cell]})
          sctr = sctr + 1
          uctr = uctr + 1
        end if
      end if
    end for
  end for

  for sidx = 1 to length(strlist) do
    SST = SST & remainder(length(strlist[sidx][2]),256) &
        floor(length(strlist[sidx][2])/256) & #00 & strlist[sidx][2]
  end for
  SST = int_to_bytes(sctr) & int_to_bytes(uctr) & SST
  SST = #FC & #00 & remainder(length(SST),256) & floor(length(SST)/256) & SST
  xls_strings = SST

  return strlist

end function

--------------------------------------------------------------------------------

global function xls_encode_data(sequence strlist)

  sequence code
  object temp
  xls_encoded = {}

  for row = 1 to length(xls_data) do
    for cell = 1 to length(xls_data[row]) do
      code = {}
      if sequence(xls_data[row][cell]) then
        -- LABELSST
        for sidx = 1 to length(strlist) do
--          if compare(strlist[sidx][2],xls_data[row][cell])=0 then
          if 1 then
--            code = {#FD,#00,#0A,#00} & remainder(row-1,256) & floor((row-1)/256) &
--                   remainder(cell-1,256) & floor((cell-1)/256) & #FF & #FF &
--                   int_to_bytes(strlist[sidx][1]-1)
--            temp = 6 + ((length(xls_data[row][cell])+1)*2)
            temp = 6 + ((length(xls_data[row][cell]))) + 2
            code = {#04,#02} & remainder(temp,256) & floor(temp/256) &
                   remainder(row-1,256) & floor((row-1)/256) &
                   remainder(cell-1,256) & floor((cell-1)/256) & #FE & #FF &
--                   remainder((temp-8),256)&floor((temp-8)/256)&xls_ascii2unicode(xls_data[row][cell])
                   remainder((temp-8),256)&floor((temp-8)/256)&(xls_data[row][cell])
            xls_encoded = xls_encoded & code
            exit
          end if
        end for
      else
        -- RK
--        temp = xls_data[row][cell] * 4
--        if integer(temp) then
--          temp = int_to_bytes(and_bits(temp,#FFFFFFFE))
--        else
--          temp = atom_to_float32(and_bits(temp,#FFFFFFFC))
--          temp = bytes_to_int(atom_to_float32(temp))
--          temp = int_to_bytes(and_bits(temp,#FFFFFFFC))
--        end if
--        code = {#7E,#02,#0A,#00} & remainder(row-1,256) & floor((row-1)/256) &
--                remainder(cell-1,256) & floor((cell-1)/256) & #FF & #FF & temp
        code = {#03,#02,#0E,#00} & remainder(row-1,256) & floor((row-1)/256) &
                remainder(cell-1,256) & floor((cell-1)/256) & #FE & #FF & atom_to_float64(xls_data[row][cell])
        xls_encoded = xls_encoded & code
      end if
    end for
  end for

  return 1

end function

--------------------------------------------------------------------------------

global function xls_read_all(sequence fname)
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE

  atom try, try2
  object r1,r2,r3
  try = xls_open_xls(fname,"rb")
  if try < 2 then
    return try
  end if
  try = xls_read_header()
  if try < 1 then
    try2 = xls_close_xls()
    return try
  end if
  try = xls_read_sheet()

  if DEBUG then
    puts(logfile,"\nSpreadsheet data:\n\n")
    for r = 1 to length(xls_data) do
      puts(logfile,sprintf("%03d: ",r))
      for c = 1 to length(xls_data[r]) do
r1 = xls_format[r]
if length(xls_format[r])>=c and atom(xls_format[r][c]) then
  r2 = xls_xflist[xls_format[r][c]+1]
  if sequence(r2) and length(r2)>3 and r2[3]>0 then
    for z = 1 to length(xls_formatlist) do
      if xls_formatlist[z][1] = r2[3] then
        r3 = xls_formatlist[z]
      end if
    end for
  end if
end if
--if r=12 and c=37 then trace(1) end if
        if integer(xls_data[r][c]) and (length(xls_format)<r or length(xls_format[r])<c) then
          puts(logfile,sprintf("%d ",xls_data[r][c]))
        elsif atom(xls_data[r][c]) then
          puts(logfile,xls_a2string(xls_data[r][c],xls_format[r][c])&" ")
        else
          puts(logfile,xls_data[r][c]&" ")
        end if
      end for
      puts(logfile,"\n")
      if r = 12 then
        print(logfile,xls_data[r])
        print(logfile,xls_format[r])
        puts(logfile,"\n")
      end if
      if r > 100 then
        exit
      end if
    end for
  end if

  try = xls_close_xls()
  return try

end function

--------------------------------------------------------------------------------

global function xls_write_all(sequence fname)
  -- Returns 1: SUCCESS, 0: FAILURE, negative: ERROR CODE

  -- For OLE2 format:
  -- 1. Build strings table
  -- 2. Encode data & formatting
  -- 3. Encode header
  -- 4. Write header + data to file

  atom try
  sequence strlist

  xls_encoded = {}
  strlist = xls_build_strings()
  try = xls_encode_data(strlist)
  try = xls_encode_header()

  xls_encoded = xls_header & xls_encoded & #0A & #00 & #00 & #00
--  xls_encoded = xls_write_ole_header() & xls_encoded
  if remainder(length(xls_encoded),512) > 0 then
    xls_encoded = xls_encoded & repeat(#FF,512-remainder(length(xls_encoded),512))
  end if
--  while length(xls_encoded)<8192 do
--    xls_encoded = xls_encoded & repeat(#FF,512)
--  end while

  try = xls_open_xls(fname,"wb")
  if try < 2 then
    return try
  end if
  puts(xls_fp,xls_encoded)
  try = xls_close_xls()
  return try

end function

--------------------------------------------------------------------------------
-- TEST PROCEDURE
--------------------------------------------------------------------------------

procedure testw()

  object try

  xls_data = {{"Field 1","Field 2","Field 3","Field 4","","","","","Field 9"},
              {15,24,3.33,123456789,0,0,-12345,0.31415297},
              {},
              {},
              {"M12",7,"October",573234565,"","12/25/2006"}}
--  xls_data = {{1,"Test string"}}

  xls_filename = "test01.xls"
--  try = xls_read_all(xls_filename)
  try = xls_write_all(xls_filename)


end procedure

procedure testr()

  object try

  logfile = open("msxls.log","w")
  xls_filename = "Allocation Spreadsheet Daily - 2006-8-14.xls"
--  xls_filename="test05.xls"
  try = xls_read_all(xls_filename)
  close(logfile)


end procedure

--testr()