Public Class ExcelHelper ''' <summary> ''' 获取工作表列表 ''' </summary> ''' <param name="filename">文件名</param> ''' <returns></returns> ''' <remarks></remarks> Public Shared Function GetSheetList(ByVal filename As String) As String() If (String.IsNullOrEmpty(filename)) Then Throw New ArgumentNullException("文件名为空! ") End If If (IO.File.Exists(filename) = False) Then Throw New IO.FileNotFoundException("文件未找到!", filename) End If ' Using stream As IO.FileStream = IO.File.OpenRead(filename) Return GetSheetList(stream) End Using End Function ''' <summary> ''' 获取工作表列表 ''' </summary> ''' <param name="stream">文件流</param> ''' <returns></returns> ''' <remarks></remarks> Public Shared Function GetSheetList(ByVal stream As IO.FileStream) As String() Dim bookStream() As Byte = ReadBook(stream) ' Dim sheets As New List(Of String) ' Dim Records As List(Of Record) = ReadRecords(bookStream, RID.BOUNDSHEET) For Each record As Record In Records With New ExcelSheet(record) If (.SheetType = SheetTypes.Worksheet AndAlso .Visibility = SheetVisibilities.Visible) Then sheets.Add(.SheetName) End If End With Next ' stream.Close() ' Return sheets.ToArray End Function
''' <summary> ''' 从文件中读取指定工作表 ''' </summary> ''' <param name="filename">文件名</param> ''' <param name="sheetName">工作表名</param> ''' <returns></returns> ''' <remarks></remarks> Public Shared Function GetSheetData(ByVal filename As String, ByVal sheetName As String) As Object(,) If (String.IsNullOrEmpty(filename)) Then Throw New ArgumentNullException("文件名为空! ") End If If (IO.File.Exists(filename) = False) Then Throw New IO.FileNotFoundException("文件未找到!", filename) End If ' Using stream As IO.FileStream = IO.File.OpenRead(filename) Return GetSheetData(stream, sheetName) End Using End Function ''' <summary> ''' 从文件流中读取指定工作表 ''' </summary> ''' <param name="stream">文件流</param> ''' <param name="sheetName">工作表名</param> ''' <returns></returns> ''' <remarks></remarks> Public Shared Function GetSheetData(ByVal stream As IO.FileStream, ByVal sheetName As String) As Object(,) Dim bookStream() As Byte = ReadBook(stream) Dim RowCount As Integer = 0, ColumnCount As Integer = 0 Dim records As List(Of RecordData) = ReadSheet(bookStream, sheetName) Dim reccount As Integer = records.Count, rec As RecordData Dim cells As New List(Of ExcelCell), cell As ExcelCell Dim sst As ExcelSST = Nothing ' 共享字符串表 Dim xfs As New List(Of ExcelCellStyle) ' 单元格样式 Dim formats As New Dictionary(Of Integer, String) ' 格式 Dim merged As New List(Of ExcelMergedCell) ' 合并单元格 ' ' 读取共享字符串表、单元格格式、样式设置 For i As Integer = reccount - 1 To 0 Step -1 rec = records(i) ' Select Case rec.ID Case ExcelHelper.RID.SST ' 共享字符串表 sst = New ExcelSST(rec.Read(bookStream)) Case ExcelHelper.RID.XF ' 单元格样式 Dim xf As New ExcelCellStyle(BitConverter.ToUInt16(bookStream, rec.Position), _ BitConverter.ToUInt16(bookStream, rec.Position + 2)) xfs.Add(xf) Case ExcelHelper.RID.FORMAT ' 格式 Dim index As String = BitConverter.ToUInt16(bookStream, rec.Position) Dim str As String = UnicodeString.Read(bookStream, rec.Position + 2, rec.Length - 2, 16) formats(index) = str Case Else Exit For End Select ' ' 移除 reccount -= 1 Next ' Dim units As New List(Of SheetUnit), rccPerUnit As Integer = Math.Max(reccount / 20, 1000) For i As Integer = 0 To reccount - 1 Step rccPerUnit units.Add(New SheetUnit(records, bookStream, i, Math.Min(reccount - i, rccPerUnit))) Next For Each unit As SheetUnit In units unit.SST = sst ' 共享字符串表 unit.XFS = xfs ' 样式表 unit.Formats = formats ' 格式表 System.Threading.ThreadPool.QueueUserWorkItem(AddressOf unit.Process, Nothing) Next ' 等待完成 While True Dim Found As Boolean = False For Each unit As SheetUnit In units If (unit.Finished = False) Then Found = True End If Next If (Not Found) Then Exit While Else Threading.Thread.Sleep(10) : Application.DoEvents() End If End While ' For Each unit As SheetUnit In units If (RowCount < unit.RowCount) Then RowCount = unit.RowCount End If If (ColumnCount < unit.ColumnCount) Then ColumnCount = unit.ColumnCount End If cells.AddRange(unit.Cells) merged.AddRange(unit.CellsMerged) Next ' Dim buffer(,) As Object = New Object(RowCount - 1, ColumnCount - 1) {} ' If (RowCount > 0 AndAlso ColumnCount > 0) Then For Each cell In cells If (cell.IsMulti) Then If (cell.IsSST) Then For i As Integer = 0 To cell.ColCount - 1 buffer(cell.RowIndex, cell.ColIndex + i) = sst.GetString(DirectCast(cell.Values(i), Integer)) Next Else For i As Integer = 0 To cell.ColCount - 1 buffer(cell.RowIndex, cell.ColIndex + i) = cell.Values(i) Next End If Else If (cell.IsSST) Then buffer(cell.RowIndex, cell.ColIndex) = sst.GetString(DirectCast(cell.Values(0), Integer)) Else buffer(cell.RowIndex, cell.ColIndex) = cell.Values(0) End If End If Next ' For Each mergedcell As ExcelMergedCell In merged ' 合并单元格值 Dim value As Object = buffer(mergedcell.RowMin, mergedcell.ColMin) ' 设置所有被合并的单元格 For i As Integer = mergedcell.RowMin To mergedcell.RowMax For j As Integer = mergedcell.ColMin To mergedcell.ColMax buffer(i, j) = value Next Next Next End If ' Return buffer End Function
''' <summary> ''' 工作表处理线程单元 ''' </summary> ''' <remarks></remarks> Private Class SheetUnit
Sub New(ByVal records As List(Of RecordData), ByVal bookStream() As Byte, ByVal index As Integer, ByVal count As Integer) Me.Index = index Me.Count = count Me.Records = records Me.BookStream = bookStream End Sub
Sub Process(ByVal state As Object) Dim rec As RecordData, cell As ExcelCell Dim recIndex As Integer ' Try For recIndex = Me.Index To Me.Index + Me.Count - 1 rec = Records(recIndex) ' Select Case rec.ID
Case ExcelHelper.RID.MERGEDCELLS ' 合并单元格
Me.CellsMerged.AddRange(rec.Read(BookStream).ReadMergedCells)
Case Else Try ' 单元格 cell = New ExcelCell(rec.Read(BookStream), XFS, Formats) Catch ex As Exception Stop End Try ' If (RowCount <= cell.RowIndex) Then RowCount = cell.RowIndex + 1 End If If (ColumnCount < cell.ColIndex + cell.ColCount) Then ColumnCount = cell.ColIndex + cell.ColCount End If ' Cells.Add(cell) End Select ' 'If (i Mod 1000) = 0 Then Threading.Thread.Sleep(1) Next Catch ex As Exception Me.Exception = ex Finally Me.Finished = True End Try
End Sub
Public Index As Integer Public Count As Integer Public Records As New List(Of RecordData) Public BookStream() As Byte
Public SST As ExcelSST Public XFS As List(Of ExcelCellStyle) Public Formats As Dictionary(Of Integer, String) ' Public Cells As New List(Of ExcelCell) Public CellsMerged As New List(Of ExcelMergedCell)
Public RowCount As Integer Public ColumnCount As Integer
Public Finished As Boolean Public Exception As Exception
End Class
''' <summary> ''' 读取工作簿二进制字节数组 ''' </summary> ''' <param name="stream">文件流</param> ''' <returns></returns> ''' <remarks></remarks> Private Shared Function ReadBook(ByVal stream As IO.FileStream) As Byte() ' 文件流长度 Dim streamLength As Integer = stream.Length If (streamLength = 0) Then Throw New Exception("没有数据") If (streamLength < 512) Then Throw New Exception(String.Format("长度 {0}, 不足512字节", streamLength)) ' ' 读文件头，确定文件 Dim head() As Byte = New Byte(511) {} stream.Read(head, 0, 512)
' 字节存储顺序是否从小到大(Little-Endian) Dim isLE As Boolean = (head(28) = 254 AndAlso head(29) = 255) ' 扇区长度 Dim szSector As Integer = BitConverter.ToUInt16(head, 30) If (szSector < 7 OrElse szSector > 32) Then Throw New Exception("扇区长度不正确（必须在7与32之间取值）") ' 小扇区长度 Dim szShortSector As Integer = BitConverter.ToUInt16(head, 32), shortSectorLength As Integer = Math.Pow(2, szShortSector) If (szShortSector > szSector) Then Throw New Exception("短扇区长度不正确（必须小于" & szSector & "）") ' 扇区数量 Dim satSectorCount As Integer = BitConverter.ToUInt32(head, 44) If (satSectorCount <= 0) Then Throw New Exception(String.Format("错误的扇区数 {0} (必须大于零) ", satSectorCount)) ' 目录中的第一个扇区的标识 Dim dirSID0 As Integer = BitConverter.ToUInt32(head, 48) If (dirSID0 <= 0) Then Throw New Exception(String.Format("错误的目录扇区(SID0)标识 {0} (必须大于零) ", dirSID0)) ' 标准数据流的最小长度(字节) Dim szMinStandardStream As Integer = BitConverter.ToUInt32(head, 56), sectorLength As Integer = Math.Pow(2, szSector) If (szMinStandardStream < sectorLength OrElse szMinStandardStream Mod sectorLength > 0) Then Throw New Exception(String.Format("标准数据流长度 {0} 不正确，(必须为 {1} 的倍数) ", szMinStandardStream, sectorLength)) End If ' 短扇区分配表中第一个扇区的标识 Dim ssatSID0 As Integer = BitConverter.ToInt32(head, 60) If (ssatSID0 < 0 AndAlso ssatSID0 <> -2) Then Throw New Exception(String.Format("错误的短扇区(SSAT SID0)标识 {0} (不小于 0 或 等于-2) ", ssatSID0)) End If ' 短扇区分配表中的扇区数量 Dim ssatSectorCount As Integer = BitConverter.ToUInt32(head, 64) If (ssatSectorCount > 0 AndAlso ssatSID0 < 0) Then Throw New Exception(String.Format("错误的短扇区(SSAT SID0)标识 {0} (当短扇区数量大于零时，SID0 不能小于 0) ", ssatSID0)) End If If (ssatSectorCount < 0) Then Throw New Exception(String.Format("错误的短扇区数 {0} (不能小于零) ", ssatSectorCount)) End If
' 主扇区分配表中的第一个扇区标识 Dim msatSID0 As Integer = BitConverter.ToInt32(head, 68) If (msatSID0 < 1 AndAlso msatSID0 <> -2) Then Throw New Exception(String.Format("错误的主扇区(MSAT SID0)标识 {0} (不小于 0 或 等于-2) ", msatSID0)) End If ' 主扇区分配表中的扇区数量 Dim msatSectorCount As Integer = BitConverter.ToUInt32(head, 72) If (msatSectorCount < 0) Then Throw New Exception(String.Format("错误的主扇区数 {0} (不能小于零) ", msatSectorCount)) End If If (msatSectorCount = 0 AndAlso msatSID0 <> -2) Then Throw New Exception(String.Format("错误的主扇区(MSAT SID0) 标识 {0} (必须 = -2) ", msatSID0)) End If
' 读取主扇区记录 Dim k As Integer = Math.Pow(2, szSector) / 4 - 1 Dim msat() As Integer = New Integer(108 + (k * msatSectorCount)) {} For i As Integer = 0 To 108 msat(i) = BitConverter.ToInt32(head, 76 + i * 4) Next Dim msatSIDNext As Integer = msatSID0 For i As Integer = 0 To msatSectorCount - 1 Dim sector() As Byte = ReadSector(stream, sectorLength, msatSIDNext) If (sector.Length = 0) Then Throw New Exception(String.Format("MSAT 数据缺失, SID [{0}] 未找到，已到达文件尾部! ", msatSIDNext)) End If ' 填充扇区表 For j As Integer = 0 To k - 1 msat(109 + (i * k) + j) = BitConverter.ToInt32(sector, j * 4) Next ' 下一扇区标识 msatSIDNext = BitConverter.ToInt32(sector, k * 4) Next ' ' 计算扇区数 Dim SATCount As Integer = msat.Length - 1 While (msat(SATCount - 1) < 0) SATCount -= 1 End While
Dim m As Integer = sectorLength / 4 Dim sat() As Integer = New Integer(SATCount * m - 1) {} For i As Integer = 0 To SATCount - 1 ' 偏移量 Dim sector() As Byte = ReadSector(stream, sectorLength, msat(i)) If (sector.Length = 0) Then Throw New Exception(String.Format("SAT SID 数据链缺失, SID [{0}] 未找到，已到达文件尾部! ", msat(i))) End If ' 填充 For k = 0 To m - 1 sat(i * m + k) = BitConverter.ToInt32(sector, k * 4) Next Next
' 读取 SSAT SID Dim ssatCount As Integer = 0 Dim ssatSIDNext As Integer = ssatSID0 Dim ssat() As Integer = New Integer((ssatSectorCount + 1) * m - 1) {} While (ssatSIDNext > -2) ' 偏移量 Dim sector() As Byte = ReadSector(stream, sectorLength, ssatSIDNext) If (sector.Length = 0) Then Throw New Exception(String.Format("SSAT SID SID [{0}] 未找到，已到达文件尾部! ", ssatSIDNext)) End If For i As Integer = 0 To m - 1 ssat(ssatCount * m + i) = BitConverter.ToInt32(sector, i * 4) Next ssatSIDNext = sat(ssatSIDNext) ssatCount += 1 End While If (ssatCount < ssatSectorCount) Then Throw New Exception(String.Format("SSAT Sector 数据链缺失， 找到 {0} / {1}", ssatCount, ssatSectorCount)) End If
' 目录 Dim dirSectorCount As Integer = 0 Dim dirSIDNext As Integer = dirSID0 : m = sectorLength / 128 Dim dir As New Dictionary(Of Integer, Byte()), dirEntry() As Byte While (dirSIDNext > -2) Dim sector() As Byte = ReadSector(stream, sectorLength, dirSIDNext) If (sector.Length = 0) Then Throw New Exception(String.Format("目录扇区 {0} 未找到", dirSIDNext)) End If For i As Integer = 0 To m - 1 dirEntry = New Byte(127) {} Array.Copy(sector, i * 128, dirEntry, 0, 128) dir(dirSectorCount * m + i) = dirEntry Next dirSIDNext = sat(dirSIDNext) dirSectorCount += 1 End While ' Dim bookID As Integer = -1
For i As Integer = 0 To dir.Count - 1 dirEntry = dir(i) Dim nameLength As Integer = BitConverter.ToInt16(dirEntry, 64) Dim nameOfStream() As Byte = New Byte(nameLength - 1) {} Dim overwrite As Boolean = False ' Array.Copy(dirEntry, nameOfStream, nameLength) overwrite = CompareArray(dirEntry, nameOfStream) ' ' 读取文档数据流 ' 是否工作簿 If (CompareArray(nameOfStream, BIFF.WorkbookName)) Then bookID = i Exit For Stop End If Next ' If (bookID < 0) Then Throw New Exception("未找到工作簿") End If
' 读取工作簿 Dim bookStream() As Byte = ReadStream(stream, bookID, dir, sectorLength, shortSectorLength, sat, ssat, szMinStandardStream) If (bookStream.Length = 0) Then Throw New Exception("工作簿读取失败") End If ' Return bookStream End Function
''' <summary> ''' 从工作簿存储字节数组中读取指定名称的工作表 ''' </summary> ''' <param name="bookStream">工作簿</param> ''' <param name="sheetName">工作表名称</param> ''' <returns></returns> ''' <remarks></remarks> Private Shared Function ReadSheet(ByVal bookStream() As Byte, ByVal sheetName As String) As List(Of RecordData) If (String.IsNullOrEmpty(sheetName)) Then Throw New ArgumentNullException("sheetName") End If
Dim sheetIndex As Integer = -1, sheetNameFound As String, sheetFounded As Boolean = False Dim sheetPosition As Integer = -1 ' ' 读取所有工作表记录 Dim rid As RID, rlen As Integer, lastNonContinue As RecordData = Nothing, lastAdded As Boolean = True Dim rdata() As Byte = New Byte(1023) {}, positions As New List(Of RecordData), others As New List(Of RecordData) Dim rpos As Integer = 0 While (rpos < bookStream.Length - 4) ' 标识 rid = New RID(bookStream(rpos), bookStream(rpos + 1)) ' 是否为空 If (rid.IsEmpty) Then GoTo ReadNext ' ' 长度 rlen = BitConverter.ToUInt16(bookStream, rpos + 2) ' ' 是否继续记录 If (rid.IsContinue) Then If (lastAdded = False) Then GoTo ReadNext If (lastNonContinue Is Nothing) Then Throw New ApplicationException("Found CONTINUE record without previous/parent record.") End If ' lastNonContinue.Continues.Add(New RecordData(rid, rpos + 4, rlen)) Else Select Case rid Case ExcelHelper.RID.EOF ' 结束 If (sheetFounded) Then Exit While Else If (sheetPosition >= 0) Then sheetFounded = True rpos = sheetPosition Continue While End If End If
Case ExcelHelper.RID.BOF positions.Clear()
Case ExcelHelper.RID.BOUNDSHEET ' SheetName sheetIndex += 1 ' rdata = New Byte(rlen - 1) {} Array.Copy(bookStream, rpos + 4, rdata, 0, rlen) ' With New ExcelSheet(rid, rdata) If (.SheetType = SheetTypes.Worksheet AndAlso .Visibility = SheetVisibilities.Visible) Then sheetNameFound = .SheetName ' 找到工作表 If (String.Compare(sheetName, sheetNameFound, True) = 0) Then sheetPosition = .StreamPosition GoTo ReadNext End If End If End With Case ExcelHelper.RID.SST ' 共享字符串表 lastAdded = True lastNonContinue = New RecordData(rid, rpos + 4, rlen) others.Add(lastNonContinue)
Case ExcelHelper.RID.XF ' 单元格样式 lastAdded = True lastNonContinue = New RecordData(rid, rpos + 4, rlen) others.Add(lastNonContinue)
Case ExcelHelper.RID.FORMAT ' 格式字符串 lastAdded = True lastNonContinue = New RecordData(rid, rpos + 4, rlen) others.Add(lastNonContinue)
Case Else If (sheetFounded) Then Select Case rid Case ExcelHelper.RID.RK ' 压缩数字 Case ExcelHelper.RID.NUMBER ' 浮点数 Case ExcelHelper.RID.LABEL ' 字符串 Case ExcelHelper.RID.LABELSST ' 共享字符串 Case ExcelHelper.RID.MULRK ' 一组压缩数字 'Case ExcelHelper.RID.MULBLANK ' 一组空白 'Case ExcelHelper.RID.BLANK ' 空白 Case ExcelHelper.RID.FORMULA ' 公式 Case ExcelHelper.RID.MERGEDCELLS ' 合并单元格 Case Else GoTo ReadNext End Select ' lastAdded = True lastNonContinue = New RecordData(rid, rpos + 4, rlen) positions.Add(lastNonContinue) End If End Select End IfReadNext: rpos += (rlen + 4) End While ' If (positions.Count > 0) Then positions.AddRange(others) End If ' Return positions End Function
''' <summary> ''' 从工作簿存储字节数组中读取指定记录 ''' </summary> ''' <param name="streamBook">工作簿</param> ''' <param name="id">记录标识</param> ''' <returns></returns> ''' <remarks></remarks> Private Shared Function ReadRecords(ByVal streamBook() As Byte, ByVal id As RID) As List(Of Record) Dim records As New List(Of Record)
' 读取所有工作表记录 Dim rid As RID, rlen As Integer, lastNonContinue As Record = Nothing, lastAdded As Boolean = False Dim rdata() As Byte = New Byte(1023) {} Dim pos As Integer = 0 While (pos < streamBook.Length - 4) ' 标识 rid = New RID(streamBook(pos), streamBook(pos + 1)) ' 是否为空 If (rid.IsEmpty) Then GoTo ReadNext
' 长度 rlen = BitConverter.ToUInt16(streamBook, pos + 2) ' ' 是否继续记录 If (rid.IsContinue) Then If (lastAdded = False) Then GoTo ReadNext If (lastNonContinue Is Nothing) Then Throw New ApplicationException("Found CONTINUE record without previous/parent record.") End If ' ' 获取记录数据 rdata = New Byte(rlen - 1) {} Array.Copy(streamBook, pos + 4, rdata, 0, rlen) ' lastNonContinue.Continues.Add(New Record(rid, rdata)) Else ' If (rid = id) Then lastAdded = True ' ' 获取记录数据 rdata = New Byte(rlen - 1) {} Array.Copy(streamBook, pos + 4, rdata, 0, rlen) ' lastNonContinue = New Record(rid, rdata) records.Add(lastNonContinue) Else lastAdded = False End If End If 'ReadNext: pos += (rlen + 4) End While ' Return records End Function
''' <summary> ''' 从文件流中读取指定数据流 ''' </summary> ''' <param name="stream">文件流</param> ''' <param name="bookID">工作簿序号</param> ''' <param name="books">所有工作簿节点</param> ''' <param name="sectorLength">扇区长度</param> ''' <param name="shortSectorLength">短扇区长度</param> ''' <param name="sat">扇区分配表</param> ''' <param name="ssat">短扇区分配表</param> ''' <param name="szMinStandardStream">标准流最小长度</param> ''' <returns></returns> ''' <remarks></remarks> Private Shared Function ReadStream(ByVal stream As IO.FileStream, ByVal bookID As Integer, ByVal books As Dictionary(Of Integer, Byte()), ByVal sectorLength As Integer, ByVal shortSectorLength As Integer, ByVal sat() As Integer, ByVal ssat() As Integer, ByVal szMinStandardStream As Integer) As Byte() Dim bookSectorLength As Integer, satBook() As Integer, bookEntry() As Byte = books(bookID) ' Dim bookStreamLength As Integer = BitConverter.ToInt32(bookEntry, 120) Dim bookStreamCount As Integer = 0 Dim bookStream() As Byte = New Byte() {}, bookBytes() As Byte = New Byte() {} If (bookID = 0 OrElse bookStreamLength >= szMinStandardStream) Then bookStream = New Byte(stream.Length - 1) {} stream.Position = 0 stream.Read(bookStream, 0, stream.Length) End If If (bookID = 0) Then bookSectorLength = sectorLength satBook = sat bookBytes = bookStream ElseIf (bookStreamLength < szMinStandardStream) Then bookSectorLength = shortSectorLength satBook = ssat bookBytes = ReadStream(stream, 0, books, sectorLength, shortSectorLength, sat, ssat, szMinStandardStream) Else bookSectorLength = sectorLength satBook = sat bookBytes = bookStream End If ' bookStream = New Byte(bookStreamLength - 1) {} ' Dim bookSIDNext As Integer = BitConverter.ToInt32(bookEntry, 116) While (bookSIDNext > -2) Dim sector() As Byte = New Byte(bookSectorLength - 1) {} ' If (bookStreamLength > 0) Then If (bookID > 0 AndAlso bookStreamLength < szMinStandardStream) Then Array.Copy(bookBytes, bookSIDNext * bookSectorLength, sector, 0, bookSectorLength) Else Array.Copy(bookBytes, 512 + bookSIDNext * bookSectorLength, sector, 0, bookSectorLength) End If ' If (sector.Length = 0) Then Throw New Exception(String.Format("未找到扇区 [{0}] ", bookSIDNext)) End If ' If (bookStreamCount + sector.Length >= bookStream.Length) Then ReDim Preserve bookStream(bookStreamCount + sectorLength) End If Array.Copy(sector, 0, bookStream, bookStreamCount, sector.Length) bookStreamCount += sector.Length End If ' If (bookSIDNext >= 0) Then bookSIDNext = satBook(bookSIDNext) Else Exit While End If End While ' ReDim Preserve bookStream(bookStreamLength - 1) ' Return bookStream End Function
''' <summary> ''' 读取扇区数组 ''' </summary> ''' <param name="stream">文件流</param> ''' <param name="sectorLength">扇区长度</param> ''' <param name="sid">扇区标识</param> ''' <returns></returns> ''' <remarks></remarks> Private Shared Function ReadSector(ByVal stream As IO.FileStream, ByVal sectorLength As Integer, ByVal sid As Integer) As Byte() ' 偏移量 Dim offset As Integer = 512 + sid * sectorLength If (offset + sectorLength > stream.Length) Then Return New Byte() {} ' 读取扇区 Dim sector() As Byte = New Byte(sectorLength - 1) {} stream.Seek(offset, IO.SeekOrigin.Begin) ' Dim size As Integer = 0 Dim remaing As Integer = sectorLength While (remaing > 0) Dim readed As Integer = stream.Read(sector, size, remaing) If (readed <= 0) Then Throw New IO.EndOfStreamException(String.Format("到达文件尾部，还有{0}字节没有读取", remaing)) End If remaing -= readed size += readed End While ' Return sector End Function
Private Shared Function CompareArray(ByVal A() As Byte, ByVal B() As Byte) As Boolean If (A.Length = B.Length) Then For i As Integer = 0 To A.Length - 1 If (A(i) <> B(i)) Then Return False Next Return True Else Return False End If End Function
Private Class ExcelSheet
Public Sub New(ByVal record As Record) Me.New(record.ID, record.Data) End Sub Public Sub New(ByVal id As RID, ByVal data() As Byte) Me.StreamPosition = BitConverter.ToInt32(data, 0) ' Select Case data(4) Case &H0 : Visibility = SheetVisibilities.Visible Case &H1 : Visibility = SheetVisibilities.Hidden Case &H2 : Visibility = SheetVisibilities.StrongHidden Case Else : Throw New Exception("未知代码：" & data(4)) End Select Select Case data(5) Case &H0 : SheetType = SheetTypes.Worksheet Case &H2 : SheetType = SheetTypes.Chart Case &H6 : SheetType = SheetTypes.VBModule Case Else : Throw New Exception("未知类型：" & data(5)) End Select ' If (Visibility = SheetVisibilities.Visible AndAlso SheetType = SheetTypes.Worksheet) Then SheetName = UnicodeString.Read(data, 6, data.Length - 6, 8) Else SheetName = "" End If End Sub
Public Visibility As SheetVisibilities Public SheetType As SheetTypes Public SheetName As String Public StreamPosition As Integer
End Class
Private Class ExcelCell
Sub New(ByVal record As Record, ByVal xfs As List(Of ExcelCellStyle), ByVal formats As Dictionary(Of Integer, String)) Me.RowIndex = record.ReadUInt16(0) Me.ColIndex = record.ReadUInt16(2) ' Dim rid As RID = record.ID, rlen As Integer = record.DataLength ' If (rid = ExcelHelper.RID.MULBLANK) Then rid = ExcelHelper.RID.BLANK : IsMulti = True : IsBlank = True ElseIf (rid = ExcelHelper.RID.MULRK) Then rid = ExcelHelper.RID.RK : IsMulti = True : IsRK = True Else IsBlank = (rid = ExcelHelper.RID.BLANK) IsSST = (rid = ExcelHelper.RID.LABELSST) IsRK = (rid = ExcelHelper.RID.RK) End If ' If (IsMulti) Then ColCount = record.ReadUInt16(rlen - 2) - ColIndex + 1 Values = New Object(ColCount - 1) {} Else ColCount = 1 Values = New Object(0) {} End If ' Dim offset As Integer = 4 ' For i As Integer = 0 To ColCount - 1 ' 格式 XFIndex = record.ReadUInt16(offset) : offset += 2 ' If (IsBlank) Then Values(i) = Nothing ElseIf (IsRK) Then Values(i) = record.ReadRK(offset) : offset += 4 ' If (XFIndex >= 0) Then Dim fmtIndex As Integer = xfs(XFIndex).FormatIndex If (formats.ContainsKey(fmtIndex)) Then Dim fmt As String = formats(fmtIndex) If (fmt.Contains("yy") OrElse fmt.Contains("m") OrElse fmt.Contains("d")) Then ' 日期格式 Values(i) = Date.FromOADate(DirectCast(Values(i), Double)) End If End If End If ElseIf (IsSST) Then Values(i) = record.ReadSSIndex(offset) Else If (record.ID = ExcelHelper.RID.FORMULA) Then ' 公式项 Values(i) = Nothing : IsBlank = True Else Values(i) = record.ReadValue(offset) End If End If Next
End Sub
Public Overrides Function ToString() As String If (IsMulti) Then Dim sb As New System.Text.StringBuilder ' For i As Integer = 0 To ColCount - 1 sb.AppendLine(String.Format("{0},{1} = {2}", Me.RowIndex, Me.ColIndex + i, Me.Values(i))) Next ' Return sb.ToString Else Return String.Format("{0},{1} = {2}", Me.RowIndex, Me.ColIndex, Me.Values(0)) End If End Function
Public RowIndex As Integer Public ColIndex As Integer Public ColCount As Integer Public IsMulti As Boolean Public IsBlank As Boolean Public IsSST As Boolean Public IsRK As Boolean Public XFIndex As Integer Public Values() As Object
End Class
''' <summary> ''' 共享字符串表 ''' </summary> ''' <remarks></remarks> Private Class ExcelSST
Public Sub New(ByVal record As Record) Dim cstTotal As Integer = record.ReadUInt32(0) Dim cstUnique As Integer = record.ReadUInt32(4) Dim cstIndex As Integer = 0, offset As Integer = 8 Dim cch As Integer, grbit As Byte, isrich As Boolean, isext As Boolean, compressed As Boolean Dim pos As Integer, rlen As Integer, str As String, bytes() As Byte Dim recIndex As Integer = -1, rec As Record = record, recNext As Record, recDataLength As Integer = rec.DataLength ' ReDim Strings(1000) : StringCount = 0 ' While (cstIndex < cstUnique) pos = offset : rlen = 3 ' 字符数量 cch = rec.ReadUInt16(offset) : offset += 2 ' 选项 grbit = rec.ReadByte(offset) : offset += 1 ' 是否压缩 compressed = (grbit And &H1) = &H0 ' 是否有扩展属性 isext = (grbit And &H4) = &H4 ' 是否富文本字符串 isrich = (grbit And &H8) = &H8 ' If (isrich) Then rlen += rec.ReadUInt16(offset) * 4 + 2 : offset += 2 If (isext) Then rlen += rec.ReadUInt32(offset) + 4 : offset += 4 ' rlen += IIf(compressed, cch, cch * 2) ' ' 是否跨记录存储 If (pos + rlen > recDataLength) Then ' 复制 bytes = New Byte(rlen - 1) {} ' Array.Copy(rec.Data, pos, bytes, 0, recDataLength - pos) : recNext = record.Continues(recIndex + 1) ' If (recNext.ReadByte(0) = 0) = compressed Then Array.Copy(recNext.Data, 1, bytes, recDataLength - pos, (pos + rlen) - recDataLength) offset = pos + rlen - recDataLength + 1 Else If (compressed) Then Stop Else For i As Integer = 0 To (pos + rlen) - recDataLength - 1 Step 2 bytes(recDataLength - pos + i) = recNext.ReadByte(i / 2 + 1) Next offset = (pos + rlen - recDataLength) / 2 + 1 End If End If
str = UnicodeString.Read(bytes, 16) ' recIndex += 1 : rec = recNext recDataLength = rec.DataLength Else ' 读字符串 str = rec.ReadUnicodeString(offset, cch, compressed) ' 偏移量 offset = pos + rlen End If ' StringCount += 1 If (StringCount >= Strings.Length) Then ReDim Preserve Strings(StringCount + 1000) End If Strings(StringCount - 1) = str ' ' 到达末尾 If (offset = recDataLength) Then offset = 0 recIndex += 1 If (recIndex < record.Continues.Count) Then rec = record.Continues(recIndex) recDataLength = rec.DataLength Else Exit While End If End If
' 索引 cstIndex += 1 End While
End Sub
Public Function GetString(ByVal index As Integer) As String If (index >= 0 AndAlso index < StringCount) Then Return Strings(index) Else Return "" End If End Function
Public Strings() As String Public StringCount As Integer = 0
End Class
''' <summary> ''' 单元格样式 ''' </summary> ''' <remarks></remarks> Private Class ExcelCellStyle
Sub New(ByVal font As Integer, ByVal format As Integer) Me.FontIndex = font Me.FormatIndex = format End Sub
Public FontIndex As Integer Public FormatIndex As Integer
End Class
''' <summary> ''' 合并单元格 ''' </summary> ''' <remarks></remarks> Private Structure ExcelMergedCell
Sub New(ByVal data() As Byte, ByVal index As Integer) Me.RowMin = BitConverter.ToUInt16(data, index) Me.RowMax = BitConverter.ToUInt16(data, index + 2) Me.ColMin = BitConverter.ToUInt16(data, index + 4) Me.ColMax = BitConverter.ToUInt16(data, index + 6) End Sub Sub New(ByVal minrow As Integer, ByVal mincol As Integer, ByVal maxrow As Integer, ByVal maxcol As Integer) Me.RowMin = minrow Me.ColMin = mincol Me.RowMax = maxrow Me.ColMax = maxcol End Sub
Public RowMin As Integer Public ColMin As Integer Public RowMax As Integer Public ColMax As Integer
End Structure
''' <summary> ''' 二进制存储顺序 ''' </summary> ''' <remarks></remarks> Private Enum ByteOrders ''' <summary> ''' 从小到大 ''' </summary> [Little_Endian] ''' <summary> ''' 从大到小 ''' </summary> [Big_Endian] End Enum
''' <summary> ''' BIFF ''' </summary> ''' <remarks></remarks> Public Class BIFF
Public Shared DirectoryRootName As Byte() = New Byte() {&H52, &H0, &H6F, &H0, &H6F, &H0, &H74, &H0, &H20, &H0, &H45, &H0, &H6E, &H0, &H74, &H0, &H72, &H0, &H79, &H0, &H0, &H0} Public Shared WorkbookName As Byte() = New Byte() {&H57, &H0, &H6F, &H0, &H72, &H0, &H6B, &H0, &H62, &H0, &H6F, &H0, &H6F, &H0, &H6B, &H0, &H0, &H0}
End Class
''' <summary> ''' 记录类型 ''' </summary> ''' <remarks></remarks> Private Structure RID
Sub New(ByVal first As Byte, ByVal second As Byte) Me.First = first Me.Second = second End Sub
Public Overrides Function ToString() As String If (_names.ContainsKey(Me.First) AndAlso _names(Me.First).ContainsKey(Me.Second)) Then Return String.Format("{2} {0:x2} {1:x2}", Me.First, Me.Second, _names(Me.First)(Me.Second)) Else Return String.Format("?? {0:x2} {1:x2}", Me.First, Me.Second) End If End Function
Shared Operator =(ByVal A As RID, ByVal B As RID) As Boolean Return A.First = B.First AndAlso A.Second = B.Second End Operator
Shared Operator <>(ByVal A As RID, ByVal B As RID) As Boolean Return A.First <> B.First OrElse A.Second <> B.Second End Operator
Public Function IsEmpty() As Boolean Return Me = RID.Empty End Function Public Function IsContinue() As Boolean Return Me = RID.CONTINUE End Function Public Function IsCell() As Boolean 'Return "RK,NUMBER,LABEL,LABELSST,MULBLANK,BLANK,MULRK,FORMULA".IndexOf(Me.GetName) >= 0 Return (Me = RID.RK OrElse Me = RID.NUMBER OrElse Me = RID.LABEL OrElse Me = RID.LABELSST OrElse Me = RID.MULBLANK OrElse Me = RID.BLANK OrElse Me = RID.MULRK OrElse Me = RID.FORMULA) End Function Public Function IsEOF() As Boolean Return Me = RID.EOF End Function
Public Function GetName() As String If (_names.ContainsKey(Me.First) AndAlso _names(Me.First).ContainsKey(Me.Second)) Then Return _names(Me.First)(Me.Second) Else Return String.Format("?? {0:x2} {1:x2}", Me.First, Me.Second) End If End Function
Public First As Byte Public Second As Byte
#Region "共享"
Shared Sub New() If (_init = False) Then _init = True ' Dim t As Type = GetType(RID) Dim r As RID, first As Byte ' For Each fi As System.Reflection.FieldInfo In t.GetFields(Reflection.BindingFlags.Static Or Reflection.BindingFlags.NonPublic) If (fi.FieldType Is t) Then r = fi.GetValue(Nothing) first = r.First If (_names.ContainsKey(first) = False) Then _names.Add(first, New Dictionary(Of Byte, String)) End If _names(first)(r.Second) = fi.Name _rids(fi.Name) = r End If Next End If End Sub
Private Shared ReadOnly _names As New Dictionary(Of Byte, Dictionary(Of Byte, String)) Private Shared ReadOnly _rids As New Dictionary(Of String, RID) Private Shared ReadOnly _init As Boolean
Friend Shared Empty As New RID(&H0, &H0)
Friend Shared ARRAY As New RID(&H21, &H2) Friend Shared BACKUP As New RID(&H40, &H0) Friend Shared BITMAP As New RID(&HE9, &H0) Friend Shared BLANK As New RID(&H1, &H2) Friend Shared BOF As New RID(&H9, &H8) Friend Shared BOOKBOOL As New RID(&HDA, &H0) Friend Shared BOOLERR As New RID(&H5, &H2) Friend Shared BOTTOMMARGIN As New RID(&H29, &H0) Friend Shared BOUNDSHEET As New RID(&H85, &H0) Friend Shared CALCCOUNT As New RID(&HC, &H0) Friend Shared CALCMODE As New RID(&HD, &H0) Friend Shared CODEPAGE As New RID(&H42, &H0) Friend Shared COLINFO As New RID(&H7D, &H0) Friend Shared CONDFMT As New RID(&HB0, &H1) Friend Shared [CONTINUE] As New RID(&H3C, &H0) Friend Shared COUNTRY As New RID(&H8C, &H0) Friend Shared CRN As New RID(&H5A, &H0) Friend Shared DATEMODE As New RID(&H22, &H0) Friend Shared DBCELL As New RID(&HD7, &H0) Friend Shared DCONREF As New RID(&H51, &H0) Friend Shared DEFAULTROWHEIGHT As New RID(&H25, &H2) Friend Shared DEFCOLWIDTH As New RID(&H55, &H0) Friend Shared DELTA As New RID(&H10, &H0) Friend Shared DIMENSIONS As New RID(&H0, &H2) Friend Shared DSF As New RID(&H61, &H1) Friend Shared DV As New RID(&HBE, &H1) Friend Shared DVAL As New RID(&HB2, &H1) Friend Shared EOF As New RID(&HA, &H0) Friend Shared EXTERNNAME As New RID(&H23, &H0) Friend Shared EXTERNSHEET As New RID(&H17, &H0) Friend Shared EXTSST As New RID(&HFF, &H0) Friend Shared FILEPASS As New RID(&H2F, &H0) Friend Shared FILESHARING As New RID(&H5B, &H0) Friend Shared FONT As New RID(&H31, &H0) Friend Shared FOOTER As New RID(&H15, &H0) Friend Shared FORMAT As New RID(&H1E, &H4) Friend Shared FORMULA As New RID(&H6, &H0) Friend Shared GRIDSET As New RID(&H82, &H0) Friend Shared GUTS As New RID(&H80, &H0) Friend Shared HCENTER As New RID(&H83, &H0) Friend Shared HEADER As New RID(&H14, &H0) Friend Shared HIDEOBJ As New RID(&H8D, &H0) Friend Shared HLINK As New RID(&HB8, &H1) Friend Shared HORIZONTALPAGEBREAKS As New RID(&H1B, &H0) Friend Shared INDEX As New RID(&HB, &H2) Friend Shared ITERATION As New RID(&H11, &H0) Friend Shared LABEL As New RID(&H4, &H2) Friend Shared LABELRANGES As New RID(&H5F, &H1) Friend Shared LABELSST As New RID(&HFD, &H0) Friend Shared LEFTMARGIN As New RID(&H26, &H0) Friend Shared MERGEDCELLS As New RID(&HE5, &H0) Friend Shared MULBLANK As New RID(&HBE, &H0) Friend Shared MULRK As New RID(&HBD, &H0) Friend Shared [NAME] As New RID(&H18, &H0) Friend Shared NOTE As New RID(&H1C, &H0) Friend Shared NUMBER As New RID(&H3, &H2) Friend Shared OBJECTPROTECT As New RID(&H63, &H0) Friend Shared PALETTE As New RID(&H92, &H0) Friend Shared PANE As New RID(&H41, &H0) Friend Shared PASSWORD As New RID(&H13, &H0) Friend Shared PHONETIC As New RID(&HEF, &H0) Friend Shared PRECISION As New RID(&HE, &H0) Friend Shared PRINTGRIDLINES As New RID(&H2B, &H0) Friend Shared PRINTHEADERS As New RID(&H2A, &H0) Friend Shared PROTECT As New RID(&H12, &H0) Friend Shared QUICKTIP As New RID(&H0, &H8) Friend Shared RANGEPROTECTION As New RID(&H68, &H8) Friend Shared REFMODE As New RID(&HF, &H0) Friend Shared RIGHTMARGIN As New RID(&H27, &H0) Friend Shared RK As New RID(&H7E, &H2) Friend Shared RSTRING As New RID(&HD6, &H0) Friend Shared ROW As New RID(&H8, &H2) Friend Shared SAVERECALC As New RID(&H5F, &H0) Friend Shared SCENPROTECT As New RID(&HDD, &H0) Friend Shared SCL As New RID(&HA0, &H0) Friend Shared SELECTION As New RID(&H1D, &H0) Friend Shared SETUP As New RID(&HA1, &H0) Friend Shared SHEETLAYOUT As New RID(&H62, &H8) Friend Shared SHEETPROTECTION As New RID(&H67, &H8) Friend Shared SHRFMLA As New RID(&HBC, &H4) Friend Shared SORT As New RID(&H90, &H0) Friend Shared SST As New RID(&HFC, &H0) Friend Shared STANDARDWIDTH As New RID(&H99, &H0) Friend Shared [STRING] As New RID(&H7, &H2) Friend Shared STYLE As New RID(&H93, &H2) Friend Shared SUPBOOK As New RID(&HAE, &H1) Friend Shared TABLEOP As New RID(&H36, &H2) Friend Shared TOPMARGIN As New RID(&H28, &H0) Friend Shared UNCALCED As New RID(&H5E, &H0) Friend Shared USESELFS As New RID(&H60, &H1) Friend Shared VCENTER As New RID(&H84, &H0) Friend Shared VERTICALPAGEBREAKS As New RID(&H1A, &H0) Friend Shared WINDOW1 As New RID(&H3D, &H0) Friend Shared WINDOW2 As New RID(&H3E, &H2) Friend Shared WINDOWPROTECT As New RID(&H19, &H0) Friend Shared WRITEACCESS As New RID(&H5C, &H0) Friend Shared WRITEPROT As New RID(&H86, &H0) Friend Shared WSBOOL As New RID(&H81, &H0) Friend Shared XCT As New RID(&H59, &H0) Friend Shared XF As New RID(&HE0, &H0)
#End Region
End Structure
''' <summary> ''' BIFF记录 ''' </summary> ''' <remarks></remarks> Private Class Record
Sub New(ByVal id As RID, ByVal data() As Byte) Me.mRID = id Me.mData = data End Sub
Public Function ReadByte(ByVal offset As Integer) As Byte Return Me.mData(offset) End Function Public Function ReadUInt16(ByVal offset As Integer) As UInt16 Return BitConverter.ToUInt16(Me.mData, offset) End Function Public Function ReadUInt32(ByVal offset As Integer) As UInt32 Return BitConverter.ToUInt32(Me.mData, offset) End Function Public Function ReadUInt64(ByVal offset As Integer) As UInt64 Return BitConverter.ToUInt64(Me.mData, offset) End Function
Public Function ReadInt16(ByVal offset As Integer) As Int16 Return BitConverter.ToInt16(Me.mData, offset) End Function Public Function ReadInt32(ByVal offset As Integer) As Int32 Return BitConverter.ToInt32(Me.mData, offset) End Function Public Function ReadInt64(ByVal offset As Integer) As Int64 Return BitConverter.ToInt64(Me.mData, offset) End Function
Public Function ReadValue(ByVal offset As Integer) As Integer Select Case mRID Case RID.RK : Return ReadRK(offset) Case RID.LABEL : Return ReadString(offset) Case RID.LABELSST : Return ReadSSIndex(offset) Case RID.NUMBER : Return ReadNumber(offset) Case Else Throw New ApplicationException("未支持的记录类型: " & mRID.ToString) End Select End Function
Public Function ReadRK(ByVal offset As Integer) As Double Dim div100 As Boolean = (mData(offset) And &H1) = &H1 Dim isInt As Boolean = (mData(offset) And &H2) = &H2 If (isInt) Then Dim rk As Integer = BitConverter.ToInt32(mData, offset) Dim num As Double = Convert.ToDouble(rk >> 2) If (div100) Then Return num / 100 Else Return num End If Else Dim rk As Integer = BitConverter.ToInt32(mData, offset) Dim floatBytes(7) As Byte : BitConverter.GetBytes(rk >> 2 << 2).CopyTo(floatBytes, 4) Dim num As Double = BitConverter.ToDouble(floatBytes, 0) If (div100) Then Return num / 100.0 Else Return num End If End If End Function
Public Function ReadString(ByVal offset As Integer) As String Return UnicodeString.Read(mData, offset, mData.Length - offset, 16) End Function
Public Function ReadSSIndex(ByVal offset As Integer) As Integer Return BitConverter.ToUInt32(mData, offset) End Function
Public Function ReadNumber(ByVal offset As Integer) As Double Return BitConverter.ToDouble(mData, offset) End Function
''' <summary> ''' 从指定位置读取Unicode字符串 ''' </summary> ''' <param name="offset">偏移量</param> ''' <param name="cch">字符数量</param> ''' <param name="compressed">是否压缩存储</param> ''' <returns></returns> ''' <remarks></remarks> Function ReadUnicodeString(ByVal offset As Integer, ByVal cch As Integer, ByVal compressed As Boolean) As String If (compressed) Then Dim bytes() As Byte = New Byte(cch * IIf(compressed, 2, 1) - 1) {} ' For i As Integer = 0 To cch - 1 bytes(i * 2) = mData(offset + i) Next ' Return System.Text.Encoding.Unicode.GetString(bytes) Else Return System.Text.Encoding.Unicode.GetString(mData, offset, cch * 2) End If End Function
''' <summary> ''' 读取合并单元格数组 ''' </summary> ''' <returns></returns> ''' <remarks></remarks> Function ReadMergedCells() As IList(Of ExcelMergedCell) Dim cells As New List(Of ExcelMergedCell) Dim count As UInt16 = Me.ReadUInt16(0) ' For i As Integer = 0 To count - 1 cells.Add(New ExcelMergedCell(Me.mData, i * 8 + 2)) Next ' Return cells End Function
Public Property Data As Byte() Get Return Me.mData End Get Set(ByVal value As Byte()) Me.mData = value End Set End Property
Public ReadOnly Property DataLength As Integer Get Return Me.mData.Length End Get End Property
Public ReadOnly Property ID As RID Get Return Me.mRID End Get End Property
Public ReadOnly Property Continues As List(Of Record) Get If (Me.mContinues Is Nothing) Then Me.mContinues = New List(Of Record) End If Return Me.mContinues End Get End Property
Private mRID As RID Private mData() As Byte Private mContinues As List(Of Record)
End Class
''' <summary> ''' BIFF记录的位置及长度信息 ''' </summary> ''' <remarks></remarks> Private Class RecordData
Sub New(ByVal rid As RID, ByVal rpos As Integer, ByVal rlen As Integer) Me.mRID = rid Me.mLen = rlen Me.mPos = rpos End Sub
Function Read(ByVal book() As Byte) As Record Try ' 复制到缓冲区 Dim rdata(Me.mLen - 1) As Byte : Array.Copy(book, Me.mPos, rdata, 0, mLen) Dim record As New Record(mRID, rdata) ' 有续项 If (mContinues IsNot Nothing) Then For Each pos As RecordData In mContinues record.Continues.Add(pos.Read(book)) Next End If Return record Catch ex As Exception Stop End Try Return Nothing End Function
Public ReadOnly Property ID As RID Get Return Me.mRID End Get End Property
Public ReadOnly Property Position As Integer Get Return Me.mPos End Get End Property
Public ReadOnly Property Length As Integer Get Return Me.mLen End Get End Property
Public ReadOnly Property Continues As List(Of RecordData) Get If (Me.mContinues Is Nothing) Then Me.mContinues = New List(Of RecordData) End If Return Me.mContinues End Get End Property
Private mRID As RID Private mLen As Integer Private mPos As Integer Private mContinues As List(Of RecordData)
End Class
''' <summary> ''' 工作表可见性 ''' </summary> ''' <remarks></remarks> Public Enum SheetVisibilities
[Default] = Visible Visible = 1 Hidden = 2 StrongHidden = 3
End Enum
''' <summary> ''' 工作表类型 ''' </summary> ''' <remarks></remarks> Public Enum SheetTypes [Default] = Worksheet Worksheet = 1 Chart = 2 VBModule = 3 End Enum
End Class
''' <summary> ''' Unicode字符串 ''' </summary> ''' <remarks></remarks> Public Class UnicodeString
Sub New() End Sub
Public Shared Function Read(ByVal bytes() As Byte, ByVal index As Integer, ByVal count As Integer, ByVal lengthBits As Integer) As String Dim buffer() As Byte = New Byte(count - 1) {} Array.Copy(bytes, index, buffer, 0, count) Return Read(buffer, lengthBits) End Function
Public Shared Function Read(ByVal bytes() As Byte, ByVal lengthBits As Integer) As String Dim compressed As Boolean, extst As Boolean, richstring As Boolean Dim countofchars As Integer, countofformating As Integer, countofextst As Integer, offset As Integer = 0 Dim optionsFlags As Byte, bytesChars() As Byte ' If (lengthBits = 8) Then ' Count of characters in the string ' (Note: this is the number of characters, NOT the number of bytes) countofchars = bytes(offset) : offset += 1 ' Option flags optionsFlags = bytes(offset) : offset += 1 Else ' 16 ' Count of characters in the string ' (Note: this is the number of characters, NOT the number of bytes) countofchars = BitConverter.ToUInt16(bytes, offset) ' Option flags optionsFlags = bytes(offset + 2) offset += 3 End If
' Compressed = 0: all the characters in the string have a high byte of 00h and only the low bytes are saved in the file ' Compressed = 1: if at least one character in the string has a nonzero high byte and therefore all characters in the string are saved as double-byte characters (not compressed) compressed = (optionsFlags And &H1) = 0 ' formating string extst = (optionsFlags And &H4) = 4 ' formating string richstring = (optionsFlags And &H8) = 8
' Count of formatting runs (runs follow the string and are not included in the character count ' if there are no formatting runs, this field does not exist). If (richstring) Then countofformating = BitConverter.ToUInt16(bytes, offset) offset += 2 Else countofformating = 0 End If
' Length of ExtRst data If (extst) Then countofextst = BitConverter.ToInt32(bytes, offset) offset += 4 Else countofextst = 0 End If
' 重新编码，压缩字符串仅有一位，非压缩字符串有两位 If (compressed) Then bytesChars = New Byte(countofchars * 2 - 1) {} ' For i As Integer = 0 To countofchars - 1 bytesChars(i * 2) = bytes(offset + i) Next ' Return System.Text.Encoding.Unicode.GetString(bytesChars) Else Return System.Text.Encoding.Unicode.GetString(bytes, offset, countofchars * 2) End If End Function
End Class
