home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Excel_File1906206282005.psc / BIFFReader.cls < prev    next >
Text File  |  2005-06-28  |  27KB  |  712 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "BIFFReader"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Dim Unique As Long
  15. Dim sstcount As Long
  16.  
  17. Private Type BIFF_SECTOR
  18.     Data() As Byte
  19. End Type
  20.  
  21. Private SST() As String
  22.  
  23. '0  64  Character array of the name of the entry, always 16-bit Unicode characters, with trailing
  24. '       zero character (results in a maximum name length of 31 characters)
  25. '64  2  Size of the used area of the character buffer of the name (not character count), including
  26. '       the trailing zero character (e.g. 12 for a name with 5 characters: (5+1)╖2 = 12)
  27. '66  1  Type of the entry:  00H = Empty 03H = LockBytes (unknown)
  28. '                           01H = User storage 04H = Property (unknown)
  29. '                           02H = User stream 05H = Root storage
  30. '67  1  Node colour of the entry: 00H = Red 01H = Black
  31. '68  4  DID of the left child node inside the red-black tree of all direct members of the parent
  32. '       storage (if this entry is a user storage or stream, .7.1), û1 if there is no left child
  33. '72  4  DID of the right child node inside the red-black tree of all direct members of the parent
  34. '       storage (if this entry is a user storage or stream, .7.1), û1 if there is no right child
  35. '76  4  DID of the root node entry of the red-black tree of all storage members (if this entry is a
  36. '       storage, .7.1), û1 otherwise
  37. '80 16  Unique identifier, if this is a storage (not of interest in the following, may be all 0)
  38. '96  4  User flags (not of interest in the following, may be all 0)
  39. '100 8  Time stamp of creation of this entry (.7.2.3). Most implementations do not write a valid
  40. '       time stamp, but fill up this space with zero bytes.
  41. '108 8  Time stamp of last modification of this entry (.7.2.3). Most implementations do not write
  42. '       a valid time stamp, but fill up this space with zero bytes.
  43. '116 4  SID of first sector or short-sector, if this entry refers to a stream (.7.2.2), SID of first
  44. '       sector of the short-stream container stream (.6.1), if this is the root storage entry, 0
  45. '       otherwise
  46. '120 4  Total stream size in bytes, if this entry refers to a stream (.7.2.2), total size of the shortstream
  47. '       container stream (.6.1), if this is the root storage entry, 0 otherwise
  48. '124 4  Not used
  49.  
  50. Private Type BIFF_DIRECTORY
  51.     DirName(63) As Byte
  52.     NameLength As Integer
  53.     entrytype As Byte
  54.     NodeColor As Byte
  55.     LeftChildDID As Long
  56.     RightChildDID As Long
  57.     RootDID As Long
  58.     UID(15) As Byte
  59.     UserFlags As Long
  60.     CreateTime(7) As Byte
  61.     ModifyTime(7) As Byte
  62.     FirstSectorSID As Long
  63.     StreamSize As Long
  64.     UnUsed As Long
  65. End Type
  66.  
  67.  
  68. Dim XF() As Integer
  69. Dim xfcount As Long
  70.  
  71. '0    8     Compound document file identifier: D0H CFH 11H E0H A1H B1H 1AH E1H
  72. '8   16     Unique identifier (UID) of this file (not of interest in the following, may be all 0)
  73. '24   2     Revision number of the file format (most used is 003EH)
  74. '26   2     Version number of the file format (most used is 0003H)
  75. '28   2     Byte order identifier (.4.2):   FEH FFH = Little-Endian
  76. '                                           FFH FEH = Big - Endian
  77. '30   2     Size of a sector in the compound document file (.3.1) in power-of-two (ssz), real sector
  78. '           size is sec_size = 2ssz bytes (most used value is 9 which means 512 bytes, minimum
  79. '           value is 7 which means 128 bytes)
  80. '32   2     Size of a short-sector in the short-stream container stream (.6.1) in power-of-two (sssz),
  81. '           real short-sector size is short_sec_size = 2sssz bytes (most used value is 6 which
  82. '           means 64 bytes, maximum value is sector size ssz, see above)
  83. '34  10     Not used
  84. '44   4     Total number of sectors used for the sector allocation table (.5.2)
  85. '48   4     SID of first sector of the directory stream (.7)
  86. '52   4     Not used
  87. '56   4     Minimum size of a standard stream (in bytes, most used size is 4096 bytes), streams
  88. '           smaller than this value are stored as short-streams (.6)
  89. '60   4     SID of first sector of the short-sector allocation table (.6.2), or .2 (End Of Chain SID,
  90. '           .3.1) if not extant
  91. '64   4     Total number of sectors used for the short-sector allocation table (.6.2)
  92. '68   4     SID of first sector of the master sector allocation table (.5.1), or .2 (End Of Chain SID,
  93. '           .3.1) if no additional sectors used
  94. '72   4     Total number of sectors used for the master sector allocation table (.5.1)
  95. '76 436     First part of the master sector allocation table (.5.1) containing 109 SIDs
  96.  
  97. Private Type BIFF_FILE_HEADER
  98.     Header As String * 8
  99.     UID(0 To 15) As Byte
  100.     Revision As Integer
  101.     Version As Integer
  102.     ByteOrder(0 To 1) As Byte
  103.     SectorSize As Integer
  104.     ShortSectorSize As Integer
  105.     UnUsed(0 To 9) As Byte
  106.     SATSize As Long
  107.     FirstDirSID As Long
  108.     UnUsed2(0 To 3) As Byte
  109.     MinStdStream As Long
  110.     FirstShortSATSID As Long
  111.     ShortSATSize As Long
  112.     FirstMSATSID As Long
  113.     MSATSize As Long
  114.     FirstMSAT(0 To 108) As Long
  115. End Type
  116.  
  117. Dim checkBIFFHeaderString As String
  118.  
  119. Dim myBIFFHeader As BIFF_FILE_HEADER
  120.  
  121. Public WorkBook As New cWorkBook
  122. Dim currentworksheet As cWorkSheet
  123. Dim currow As Long
  124. Dim curcol As Long
  125.  
  126. Private DateMode As Integer
  127.  
  128. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
  129.  
  130. Private Sub Class_Initialize()
  131.     checkBIFFHeaderString = Chr(&HD0) & Chr(&HCF) & Chr(&H11) & Chr(&HE0) & Chr(&HA1) & Chr(&HB1) & Chr(&H1A) & Chr(&HE1)
  132. End Sub
  133.  
  134. Property Get WorkSheet(index) As cWorkSheet
  135.     Set WorkSheet = WorkBook.WorkSheet(index)
  136. End Property
  137.  
  138. Property Get WorkSheets() As Collection
  139.     Set WorkSheets = WorkBook.WorkSheets
  140. End Property
  141.  
  142. Public Function OpenBIFF(filename As String) As Boolean
  143. Dim myFile As Long
  144. Dim Sector() As BIFF_SECTOR
  145.  
  146.     myFile = FreeFile
  147.     If Dir(filename) <> "" Then
  148.         Open filename For Binary As myFile
  149.         With myBIFFHeader
  150.             Get #myFile, , .Header
  151.             Get #myFile, , .UID
  152.             Get #myFile, , .Revision
  153.             Get #myFile, , .Version
  154.             Get #myFile, , .ByteOrder
  155.             Get #myFile, , .SectorSize
  156.             Get #myFile, , .ShortSectorSize
  157.             Get #myFile, , .UnUsed
  158.             Get #myFile, , .SATSize
  159.             Get #myFile, , .FirstDirSID
  160.             Get #myFile, , .UnUsed2
  161.             Get #myFile, , .MinStdStream
  162.             Get #myFile, , .FirstShortSATSID
  163.             Get #myFile, , .ShortSATSize
  164.             Get #myFile, , .FirstMSATSID
  165.             Get #myFile, , .MSATSize
  166.             Get #myFile, , .FirstMSAT
  167.         End With
  168.                 
  169.         If myBIFFHeader.Header = checkBIFFHeaderString Then
  170.             With myBIFFHeader
  171.                 'Trace "Byte Order: " & Hex(.ByteOrder(0)) & Hex(.ByteOrder(1))
  172.                 'Trace "ver: " & .Version & " rev: " & .Revision
  173.                 'Trace "Sector size: " & 2 ^ .SectorSize
  174.                 'Trace "Short Sector size: " & 2 ^ .ShortSectorSize
  175.                 'Trace "SAT Size: " & .SATSize
  176.                 'Trace "Short SAT Size: " & .ShortSATSize
  177.                 'Trace "Master SAT size: " & .MSATSize
  178.                 'Trace "First Master SAT SID: " & .FirstMSATSID
  179.                 'Trace "First Short SAT SID: " & .FirstShortSATSID
  180.                 'Trace "First Directory SID: " & .FirstDirSID
  181.                 
  182.                 .SectorSize = 2 ^ .SectorSize
  183.                 .ShortSectorSize = 2 ^ .ShortSectorSize
  184.                 
  185.                 Dim sectorcount As Long
  186.                 
  187.                 While Not EOF(myFile)
  188.                     ReDim Preserve Sector(sectorcount)
  189.                     ReDim Preserve Sector(sectorcount).Data(.SectorSize - 1)
  190.                     Get #myFile, , Sector(sectorcount).Data
  191.                     sectorcount = sectorcount + 1
  192.                 Wend
  193.                 
  194.                 Dim SAT() As Long
  195.                 ReDim SAT((.SATSize * .SectorSize / 4) - 1)
  196.                 
  197.                 i = 0
  198.                 While .FirstMSAT(i) > -1
  199.                     CopyMemory SAT(i * .SectorSize / 4), Sector(.FirstMSAT(i)).Data(0), .SectorSize
  200.                     i = i + 1
  201.                 Wend
  202.                 ' Need to handle if MSAT extends beyond first 109 bytes...
  203.                 
  204.                 Dim DES() As BIFF_DIRECTORY
  205.                 
  206.                 Dim currentSID As Integer
  207.                 Dim nextSID As Integer
  208.                 Dim dirCount As Long
  209.                 Dim offset As Long
  210.                 
  211.                 currentSID = .FirstDirSID
  212.                 
  213.                 'Trace "Name" & vbTab & vbTab & "Length" & vbTab & "Type" & vbTab & "LDID" & vbTab & _
  214.                  "RDID" & vbTab & "RtDID" & vbTab & "SID1" & vbTab & "StrmLen"
  215.                 
  216.                 Dim WorkBookData() As Byte
  217.                 'Dim workbooksidcount As Long
  218.                 Dim sectorlocation As Long
  219.                 
  220.                 While currentSID > 0
  221.                     ReDim Preserve DES(dirCount)
  222.                     CopyMemory DES(dirCount), Sector(.FirstDirSID).Data(0 + offset), 128
  223.                     
  224.                     With DES(dirCount)
  225.                         'Trace CStr(.DirName) & vbTab & .NameLength & vbTab & GetEntryTypeName(.entrytype) & vbTab & .LeftChildDID & vbTab & _
  226.                          .RightChildDID & vbTab & .RootDID & vbTab & .FirstSectorSID & vbTab & .StreamSize
  227.                         
  228.                         entryname = Left(CStr(.DirName), .NameLength)
  229.                         If Left(entryname, InStr(1, entryname, Chr(0)) - 1) = "Workbook" Then
  230.                             
  231.                             i = 1
  232.                             workbookSID = .FirstSectorSID
  233.                             While workbookSID <> -2
  234.                                 workbookSID = SAT(workbookSID)
  235.                                 i = i + 1
  236.                             Wend
  237.                             
  238.                             ReDim WorkBookData(i * (myBIFFHeader.SectorSize) - 1)
  239.                             
  240.                             i = 1
  241.                             workbookSID = .FirstSectorSID
  242.                             While workbookSID <> -2
  243.                                 CopyMemory WorkBookData((i - 1) * myBIFFHeader.SectorSize), Sector(workbookSID).Data(0), myBIFFHeader.SectorSize
  244.                                 workbookSID = SAT(workbookSID)
  245.                                 i = i + 1
  246.                             Wend
  247.                             
  248.                             i = 0
  249.                             While i < .StreamSize
  250.                                 GetNextRecord WorkBookData, i
  251.                             Wend
  252.                             
  253.                             Erase WorkBookData
  254.                         End If
  255.                     
  256.                     End With
  257.                     
  258.                     offset = offset + 128
  259.                     If offset >= 512 Then
  260.                         offset = 0
  261.                         currentSID = SAT(currentSID)
  262.                     End If
  263.                     dirCount = dirCount + 1
  264.                 Wend
  265.             
  266.             End With
  267.             
  268.             For i = 0 To UBound(Sector)
  269.                 Erase Sector(i).Data
  270.             Next
  271.             
  272.             Erase Sector
  273.             Erase SST
  274.             
  275.             Close myFile
  276.             
  277.             OpenBIFF = True
  278.         Else
  279.             OpenBIFF = False
  280.         End If
  281.         
  282.     End If
  283. End Function
  284.  
  285. Private Function GetEntryTypeName(entrytype) As String
  286.     Select Case entrytype
  287.     Case 0
  288.         GetEntryTypeName = "Empty"
  289.     Case 1
  290.         GetEntryTypeName = "Storage"
  291.     Case 2
  292.         GetEntryTypeName = "Stream"
  293.     Case 3
  294.         GetEntryTypeName = "LockBytes"
  295.     Case 4
  296.         GetEntryTypeName = "Property"
  297.     Case 5
  298.         GetEntryTypeName = "Root"
  299.     Case Else
  300.         GetEntryTypeName = "Unknown"
  301.     End Select
  302. End Function
  303.  
  304. Private Function GetNextRecord(WorkBookData() As Byte, sectorlocation, Optional getdata As Boolean = False)
  305. Dim recID As Integer
  306. Dim savesector As Long
  307. Dim skipme As Boolean
  308.  
  309.     savesector = sectorlocation
  310.     recID = getInt(WorkBookData, sectorlocation)
  311.     recsize = getInt(WorkBookData, sectorlocation)
  312.     Select Case recID
  313.     Case &H27E
  314.         'Trace "<RK len=" & recsize & ">"
  315.         currow = getInt(WorkBookData, sectorlocation)
  316.         curcol = getInt(WorkBookData, sectorlocation)
  317.         XFind = getInt(WorkBookData, sectorlocation)
  318.         RKVal = GetRK(WorkBookData, sectorlocation)
  319.         If Not (currentworksheet Is Nothing) Then
  320.             currentworksheet.CellFormat(currow, curcol) = XF(XFind)
  321.             currentworksheet.Cell(currow, curcol) = RKVal
  322.         End If
  323.         
  324.     Case &H203
  325.         currow = getInt(WorkBookData, sectorlocation)
  326.         curcol = getInt(WorkBookData, sectorlocation)
  327.         XFind = getInt(WorkBookData, sectorlocation)
  328.         dblval = GetDouble(WorkBookData, sectorlocation)
  329.         If Not (currentworksheet Is Nothing) Then
  330.             currentworksheet.CellFormat(currow, curcol) = XF(XFind)
  331.             currentworksheet.Cell(currow, curcol) = dblval
  332.         End If
  333.         
  334.     Case &HFD
  335.         currow = getInt(WorkBookData, sectorlocation)
  336.         curcol = getInt(WorkBookData, sectorlocation)
  337.         Call getInt(WorkBookData, sectorlocation)
  338.         sstindex = getLong(WorkBookData, sectorlocation)
  339.         'Trace "<LABELSST INDEX=" & sstindex & ">" & SST(sstindex)
  340.         If Not (currentworksheet Is Nothing) Then
  341.             currentworksheet.Cell(currow, curcol) = SST(sstindex)
  342.         End If
  343.     
  344. '    Case &H208
  345. '        'Trace "<ROW len=" & recsize & ">"
  346. '        curcol = getInt(WorkBookData, sectorlocation)
  347. '        firstcol = getInt(WorkBookData, sectorlocation)
  348. '        LastCol = getInt(WorkBookData, sectorlocation)
  349. '        Call getInt(WorkBookData, sectorlocation)   'height
  350. '        Call getInt(WorkBookData, sectorlocation)   'unused
  351. '        Call getInt(WorkBookData, sectorlocation)   'unused in BIFF8
  352.     
  353.     Case &HA
  354.         'Trace "<EOF>"
  355.         'Trace "-----"
  356.         Set currentworksheet = Nothing
  357.                 
  358.     'Case &HC
  359.         'Trace "<CALCCOUNT len=" & recsize & ">"
  360.     
  361.     'Case &HD
  362.         'Trace "<CALCMODE len=" & recsize & ">"
  363.     
  364.     'Case &HF
  365.         'Trace "<REFMODE len=" & recsize & ">"
  366.     
  367.     'Case &H10
  368.         'Trace "<DELTA len=" & recsize & ">"
  369.     
  370.     'Case &H11
  371.         'Trace "<ITERATION len=" & recsize & ">"
  372.     
  373.     Case &H22
  374.         DateMode = getInt(WorkBookData, sectorlocation)
  375.     
  376.     Case &H31
  377.         getInt WorkBookData, sectorlocation
  378.         getInt WorkBookData, sectorlocation
  379.         getInt WorkBookData, sectorlocation
  380.         getInt WorkBookData, sectorlocation
  381.         getInt WorkBookData, sectorlocation
  382.         getByte WorkBookData, sectorlocation
  383.         getByte WorkBookData, sectorlocation
  384.         getByte WorkBookData, sectorlocation
  385.         getByte WorkBookData, sectorlocation
  386.         getString WorkBookData, sectorlocation, 8
  387.         'Trace "<FONT FACE=""" & getString(WorkBookData, sectorlocation, 8) & """>"
  388.         
  389.     'Case &H5C
  390.         'Trace "<WRITEACCESS =""" & getString(WorkBookData, sectorlocation, 16) & """>"
  391.     
  392.     Case &HD7
  393.         'Trace "<DBCELL len=" & recsize & ">"
  394.         rowrec = getLong(WorkBookData, sectorlocation)
  395.         startrow = savesector - rowrec + &H14
  396.         reccount = (recsize - 4) / 2 - 1
  397.         ReDim rowoffset(reccount)
  398.         For i = 0 To reccount
  399.             rowoffset(i) = getInt(WorkBookData, sectorlocation)
  400.         Next
  401.         
  402.         'For i = 0 To reccount
  403.         '    startrow = startrow + rowoffset(i)
  404.         '    GetNextRecord WorkBookData, startrow, True
  405.         'Next
  406.     
  407.     Case &HE0
  408.         'Trace "<XF len=" & recsize & ">"
  409.         getInt WorkBookData, sectorlocation
  410.         
  411.         ReDim Preserve XF(xfcount)
  412.         XF(xfcount) = getInt(WorkBookData, sectorlocation)
  413.         xfcount = xfcount + 1
  414.         getInt WorkBookData, sectorlocation
  415.         getByte WorkBookData, sectorlocation
  416.         getByte WorkBookData, sectorlocation
  417.         getByte WorkBookData, sectorlocation
  418.         getByte WorkBookData, sectorlocation
  419.         getLong WorkBookData, sectorlocation
  420.         getLong WorkBookData, sectorlocation
  421.         getInt WorkBookData, sectorlocation
  422.     
  423.     'Case &H7D
  424.         'Trace "<COLINFO len=" & recsize & ">"
  425.     
  426.     Case &H85
  427.         streamloc = getLong(WorkBookData, sectorlocation)
  428.         sheetvisible = getByte(WorkBookData, sectorlocation)
  429.         sheettype = getByte(WorkBookData, sectorlocation)
  430.         sheetname = getString(WorkBookData, sectorlocation, , False)
  431.         RemoveNull sheetname
  432.         WorkBook.AddWorkSheet sheetname
  433.         WorkBook.WorkSheet(sheetname).StreamOffset = streamloc
  434.         
  435.         'Trace "<BOUNDSHEET  StreamLoc= " & streamloc & " Visible=" & sheetvisible & " Type=" & sheettype & " Name=" & sheetname & ">"
  436.  
  437.     'Case &H8C
  438.         'Trace "<COUNTRY EXCEL=" & getInt(WorkBookData, sectorlocation) & " SYSTEM=" & getInt(WorkBookData, sectorlocation) & ">"
  439.  
  440.     Case &HBD
  441.         Trace "<MULRK len=" & recsize & ">"
  442.     
  443.     'Case &HBE
  444.         'Trace "<MULBLANK len=" & recsize & ">"
  445.     
  446.     Case &HFC
  447.         Dim allstrings As String
  448.         totalstrings = getLong(WorkBookData, sectorlocation)
  449.         Unique = getLong(WorkBookData, sectorlocation)
  450.         'Trace "<SST len=" & recsize & " Total=" & totalstrings & " Unique=" & Unique & ">"
  451.         ReDim SST(Unique)
  452.         Dim outstr As String
  453.         Dim bitsize As Integer, readoption As Boolean, overflow As Integer
  454.         Dim temp() As Byte
  455.         Dim offset As Integer
  456.         
  457.         readoption = True
  458.         bitsize = 16
  459.         
  460.         offset = 0
  461.         sstcount = 0
  462.         
  463.         Do While sstcount < Unique
  464.             offset = 0
  465.             If overflow = 0 Then
  466.                 If bitsize = 8 Then
  467.                     length = getByte(WorkBookData(), sectorlocation)
  468.                 Else
  469.                     length = getInt(WorkBookData(), sectorlocation)
  470.                 End If
  471.             
  472.                 ReDim temp(length - 1)
  473.             
  474.                 If (sectorlocation + length) > (savesector + recsize + 4) Then
  475.                     overflow = (sectorlocation + length) - (savesector + recsize + 4)
  476.                     length = length - overflow - 1
  477.                 End If
  478.                 
  479.                 If readoption Then
  480.                     Unicode = getByte(WorkBookData(), sectorlocation)
  481.                     If (Unicode And Not 1) > 0 Then Stop
  482.                     If (Unicode And 1) = 1 Then length = length * 2
  483.                 End If
  484.                 
  485.             
  486.             Else
  487.                 getByte WorkBookData(), sectorlocation
  488.                 offset = length
  489.                 length = overflow + 1
  490.                 overflow = 0
  491.             End If
  492.             
  493.             If length > 0 Then
  494.                 
  495.                 CopyMemory temp(offset), WorkBookData(sectorlocation), length
  496.                 
  497.                 If readoption Then
  498.                     If (Unicode And 1) = 1 Then
  499.                         outstr = CStr(temp)
  500.                     Else
  501.                         outstr = StrConv(temp, vbUnicode)
  502.                     End If
  503.                 Else
  504.                     outstr = StrConv(temp, vbUnicode)
  505.                 End If
  506.             Else
  507.                 outstr = ""
  508.             End If
  509.             
  510.             If overflow = 0 Then
  511.                 SST(sstcount) = outstr
  512.                 'Debug.Print SST(sstcount)
  513.                 sstcount = sstcount + 1
  514.             End If
  515.             
  516.             sectorlocation = sectorlocation + length
  517.             If sectorlocation = savesector + recsize + 4 Then
  518.                 savesector = sectorlocation
  519.                 recID = getInt(WorkBookData, sectorlocation)
  520.                 recsize = getInt(WorkBookData, sectorlocation)
  521.             End If
  522.         Loop
  523.         sectorlocation = savesector
  524.         skipme = True
  525.         
  526. '        recID = getInt(WorkBookData, sectorlocation)
  527. '        recsize = getInt(WorkBookData, sectorlocation)
  528. '        Do While recID = &H3C
  529. '            If getByte(WorkBookData, sectorlocation) > 0 Then Stop
  530. '            CopyMemory SSTData(SSTDatalocation), WorkBookData(sectorlocation), recsize - 1
  531. '            SSTDatalocation = SSTDatalocation + recsize - 1
  532. '            sectorlocation = sectorlocation + recsize - 1
  533. '            recID = getInt(WorkBookData, sectorlocation)
  534. '            recsize = getInt(WorkBookData, sectorlocation)
  535. '        Loop
  536.         
  537.         
  538. '    Case &H3C
  539. '        'Trace "<CONTINUE len=" & recsize & ">"
  540. '
  541. '        Do While (sstcount < Unique) And (sectorlocation < (savesector + recsize + 4))
  542. '            If sstcount > 7428 And (sectorlocation - (savesector + recsize + 4) > -60) Then Stop
  543. '            SST(sstcount) = getString(WorkBookData, sectorlocation)
  544. '            sstcount = sstcount + 1
  545. '        Loop
  546.     
  547.     'Case &HFD
  548.         'Trace "<EXTSST len=" & recsize & ">"
  549.     
  550.     'Case &H160
  551.         'Trace "<USESELFS len=" & recsize & ">"
  552.     
  553.     Case &H200
  554.         fr = getLong(WorkBookData, sectorlocation)
  555.         lr = getLong(WorkBookData, sectorlocation)
  556.         fc = getInt(WorkBookData, sectorlocation)
  557.         lc = getInt(WorkBookData, sectorlocation)
  558.         getInt WorkBookData, sectorlocation ' unused
  559.         curcol = fc
  560.         currow = fr
  561.         If Not (currentworksheet Is Nothing) Then currentworksheet.InitGrid lr, lc
  562.         'Trace "<DIMENSIONS " & Chr(65 + fc) & fr + 1 & " to  " & Chr(65 + lc - 1) & lr & ">"
  563.     
  564.     
  565. '    Case &H20B
  566. '        Dim nm As Integer, rl As Long, rf As Long
  567. '        getLong WorkBookData, sectorlocation
  568. '        rf = getLong(WorkBookData, sectorlocation)
  569. '        rl = getLong(WorkBookData, sectorlocation)
  570. '        getLong WorkBookData, sectorlocation
  571. '        nm = (rl - rf - 1) / 32 + 1
  572. '        'Trace "<INDEX rf =" & rf & " rl =" & rl & " nm =" & nm & ">"
  573. '        While nm > 0
  574. '            getLong WorkBookData, sectorlocation
  575. '            nm = nm - 1
  576. '        Wend
  577.     
  578.     'Case &H293
  579.         'Trace "<STYLE len=" & recsize & ">"
  580.     
  581.     Case &H41E
  582.         'Trace "<FORMAT Index=" & getInt(WorkBookData, sectorlocation) & " String=""" & getString(WorkBookData, sectorlocation) & """>"
  583.         index = getInt(WorkBookData, sectorlocation)
  584.         newformat = getString(WorkBookData, sectorlocation, 16)
  585.         WorkBook.AddFormatString index, newformat
  586.         
  587.     Case &H809
  588.         Dim mWorkSheet As cWorkSheet
  589.         For Each mWorkSheet In WorkBook.WorkSheets
  590.             If sectorlocation - 4 = mWorkSheet.StreamOffset Then
  591.                 Set currentworksheet = mWorkSheet
  592.             End If
  593.         Next
  594.         
  595.         'Trace "<BOF>"
  596.         streamtype = getInt(WorkBookData, sectorlocation)
  597. '        Select Case streamtype
  598. '        Case &H5
  599. '            'Trace " Workbook Globals"
  600. '        Case &H6
  601. '            'Trace " Visual Basic Module"
  602. '        Case &H10
  603. '            'Trace " Worksheet"
  604. '        Case &H20
  605. '            'Trace " Chart"
  606. '        Case &H40
  607. '            'Trace " Macro Sheet"
  608. '        Case &H100
  609. '            'Trace " Workspace File"
  610. '        Case Else
  611. '            'Trace " Unknown stream: " & Hex(getInt(WorkBookData, sectorlocation - 2))
  612. '        End Select
  613.         getInt WorkBookData, sectorlocation
  614.         getInt WorkBookData, sectorlocation
  615.         getInt WorkBookData, sectorlocation
  616.         getLong WorkBookData, sectorlocation
  617.         getLong WorkBookData, sectorlocation
  618.     
  619.     Case Else
  620.         sectorlocation = savesector + recsize + 4
  621.     End Select
  622.     
  623.     'und uglich hacken fⁿr die maken suren sectorlen nein ⁿberfluen
  624. '    If Not skipme Then
  625. '        If sectorlocation <> savesector + recsize + 4 Then
  626. '            Debug.Print Hex(recID)
  627. '            sectorlocation = savesector + recsize + 4
  628. '        End If
  629. '    End If
  630. End Function
  631.  
  632. Private Function getByte(WorkBookData() As Byte, sectorlocation) As Byte
  633.     CopyMemory getByte, WorkBookData(sectorlocation), 1
  634.     sectorlocation = sectorlocation + 1
  635. End Function
  636.  
  637. Private Function getInt(WorkBookData() As Byte, sectorlocation) As Integer
  638.     CopyMemory getInt, WorkBookData(sectorlocation), 2
  639.     sectorlocation = sectorlocation + 2
  640. End Function
  641.  
  642. Private Function getLong(WorkBookData() As Byte, sectorlocation) As Long
  643.     CopyMemory getLong, WorkBookData(sectorlocation), 4
  644.     sectorlocation = sectorlocation + 4
  645. End Function
  646.  
  647. Private Function getString(WorkBookData() As Byte, sectorlocation, Optional bitsize As Integer = 16, Optional readoption As Boolean = True) As String
  648.     Dim temp() As Byte
  649.     If bitsize = 8 Then
  650.         length = getByte(WorkBookData(), sectorlocation)
  651.     Else
  652.         length = getInt(WorkBookData(), sectorlocation)
  653.     End If
  654.     If readoption Then
  655.         Unicode = getByte(WorkBookData(), sectorlocation)
  656.         If (Unicode And Not 1) > 0 Then Stop
  657.         If (Unicode And 1) = 1 Then length = length * 2
  658.     End If
  659.     
  660.     If length > 0 Then
  661.         ReDim temp(length - 1)
  662.         CopyMemory temp(0), WorkBookData(sectorlocation), length
  663.         
  664.         If readoption Then
  665.             If (Unicode And 1) = 1 Then
  666.                 getString = CStr(temp)
  667.             Else
  668.                 getString = StrConv(temp, vbUnicode)
  669.             End If
  670.         Else
  671.             getString = StrConv(temp, vbUnicode)
  672.         End If
  673.     Else
  674.         getString = ""
  675.     End If
  676.     sectorlocation = sectorlocation + length
  677. End Function
  678.  
  679. Private Sub RemoveNull(text)
  680.     If InStr(1, text, Chr(0)) > 1 Then
  681.         text = Left(text, InStr(1, text, Chr(0)) - 1)
  682.     End If
  683. End Sub
  684.  
  685. Private Function GetRK(WorkBookData() As Byte, sectorlocation)
  686. Dim lTemp As Long
  687. Dim dblval As Double
  688. Dim fakedouble(7) As Byte
  689.     
  690.     CopyMemory lTemp, WorkBookData(sectorlocation), 4
  691.     sectorlocation = sectorlocation + 4
  692.     If (lTemp And 2) = 2 Then
  693.         vnumber = lTemp \ 4
  694.     Else
  695.         lTemp = lTemp And Not 2
  696.         CopyMemory fakedouble(4), lTemp, 4
  697.         CopyMemory dblval, fakedouble(0), 8
  698.         vnumber = dblval
  699.     End If
  700.     If (lTemp And 1) = 1 Then vnumber = vnumber / 100
  701.     GetRK = vnumber
  702. End Function
  703.  
  704.  
  705. Private Function GetDouble(WorkBookData() As Byte, sectorlocation)
  706. Dim dblval As Double
  707.     CopyMemory dblval, WorkBookData(sectorlocation), 8
  708.     sectorlocation = sectorlocation + 8
  709.     GetDouble = dblval
  710. End Function
  711.  
  712.