[Visual Basic] 纯文本查看 复制代码
Option Explicit
'atlas.atlasindex文件格式说明
'atlas.atlasindex file format specification
'Offset 0 1 2 3 4 5 6 7 8 9 A B C D E F
'00000000 68 2E 00 00 B4 30 00 00 00 00 00 00 00 00 00 00 h. ?
Type TAtlasHeader
lOffsetTable As Long '&h2e68
lOffsetNamelist As Long '&h30b4
End Type 'TAtlasHeader
Type TAtlasOffset
lOffset As Long
lNameIndex As Long '&h14
lType As Long '&hc
End Type
Sub ParseAtlasIndexFile(Optional sFile As String)
If sFile = "" Then
sFile = "atlas.atlasindex"
End If
Dim TAH As TAtlasHeader
Dim f As Integer
f = FreeFile
Open sFile For Binary As f
Get #f, , TAH
If TAH.lOffsetNamelist = 0 Then
Close f
GoTo exitIt
End If
Seek #f, TAH.lOffsetTable + 1
Dim lNumItems As Long
Get #f, , lNumItems
Dim alItems() As Long
Dim i As Long
If lNumItems > 0 Then
ReDim alItems(lNumItems - 1)
For i = 0 To lNumItems - 1
Get f, TAH.lOffsetTable + 1 + 4 + i * 8 + 4, alItems(i)
Next
Dim asItems() As String
ReDim asItems(lNumItems - 1)
Dim abTmp() As Byte
For i = 1 To lNumItems - 1
ReDim abTmp((alItems(i) - alItems(i - 1)) - 1)
Get f, alItems(i - 1) + 1, abTmp
asItems(i - 1) = StrConv(TrimByteArray(abTmp), vbUnicode)
Next
ReDim abTmp((LOF(f) - alItems(i - 1)) - 1)
Get f, alItems(i - 1) + 1, abTmp
asItems(i - 1) = StrConv(TrimByteArray(abTmp), vbUnicode)
'parse the listindexes:
Seek #f, &H70 + 1
Dim lPnt As Long
Get #f, , lPnt
Dim lNodes As Long
Dim p As Dictionary
Set p = JSON.parse("{}")
If lPnt Then
Get #f, lPnt + 1 + 4, lNodes
If lNodes Then
'parse the listOffsets:
Dim atTao() As TAtlasOffset
ReDim atTao(lNodes - 1)
Seek #f, &H80 + 1 + 8
Dim Itm As Dictionary
Dim dItm As Dictionary
'Itm.Add i + 1
Set Itm = Nothing
Set Itm = New Dictionary
'Itm.Add "data"
p.Add "data", Itm
p.Add "Number of Images", lNodes
Dim lSeekNodes As Long
lSeekNodes = Seek(f)
Dim lNodeItems As Long
For i = 0 To lNodes - 1
Get #f, lSeekNodes + i * 12, atTao(i)
Debug.Print asItems(atTao(i).lNameIndex); " ";
Seek #f, atTao(i).lOffset + 1 + 4
Get #f, , lNodeItems
Dim j As Integer
Dim sTmp As String
Set dItm = Nothing
Set dItm = New Dictionary
Seek #f, atTao(i).lOffset + 1 + 4 + 4 + 4
Dim lSeek As Long
Dim lNameIndex As Long
Dim lType As Long
For j = 0 To lNodeItems - 1
Get #f, , lNameIndex
sTmp = asItems(lNameIndex)
Get #f, , lType
Get #f, , lPnt
lSeek = Seek(f)
If lType = &H4 Then
'is long
Get #f, lPnt + 1, lPnt
dItm.Add sTmp, lPnt
ElseIf lType = &HA Then
'is string
ReDim abTmp(128)
Get #f, lPnt + 1, abTmp
dItm.Add sTmp, StrConv(TrimByteArray(abTmp), vbUnicode)
ElseIf lType = &H9 Then
' Stop
Dim iTmp As Integer
Get #f, lPnt + 1, iTmp
dItm.Add sTmp, iTmp
Else
Get #f, lPnt + 1, lPnt
dItm.Add sTmp, lPnt
End If
Seek (f), lSeek
Next
Itm.Add asItems(atTao(i).lNameIndex), dItm
Next
debug.print JSON.toString(p)
End If
End If
End If
Seek #f, TAH.lOffsetNamelist + 1
Close f
End Sub