Public Class Form1
Dim dataArray As sType()
Public maxID As Integer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim id As Integer
If Integer.TryParse(txtClientID.Text, id) AndAlso id >= 100 Then
If id < dataArray.Length Then
Dim stype As sType = dataArray(id - 100)
cmbSprites.DataSource = stype.sprites
txtAlwaysOnTopOrder.Text = stype.alwaysOnTopOrder
txtAnimationLength.Text = stype.animationLength
txtBlendFrames.Text = stype.blendFrames
txtDivX.Text = stype.divX
txtDivY.Text = stype.divY
txtDivZ.Text = stype.divZ
txtDrawHeight.Text = stype.drawHeight
txtHeight.Text = stype.height
txtLightColor.Text = stype.lightColor
txtLightLevel.Text = stype.lightLevel
txtMinimapColor.Text = stype.minimapColor
txtNumSprites.Text = stype.numSprites
txtSpeed.Text = stype.speed
txtWidth.Text = stype.width
txtXOffset.Text = stype.xOffset
txtYOffset.Text = stype.yOffset
chkAlwaysOnTop.Checked = stype.alwaysOnTop
chkAlwaysUsed.Checked = stype.alwaysUsed
chkBlocking.Checked = stype.blocking
chkBlocksMissile.Checked = stype.blocksMissile
chkBlocksMonsterMovement.Checked = stype.blocksMonsterMovement
chkContainer.Checked = stype.container
chkEquipable.Checked = stype.equipable
chkFluidContainer.Checked = stype.fluidContainer
chkGround.Checked = stype.ground
chkHangable.Checked = stype.hangable
chkHorizontal.Checked = stype.horizontal
chkImmoveable.Checked = stype.immoveable
chkLadder.Checked = stype.ladder
chkReadable.Checked = stype.readable
chkRotateable.Checked = stype.rotateable
chkRune.Checked = stype.rune
chkSplash.Checked = stype.splash
chkStackable.Checked = stype.stackable
chkUsable.Checked = stype.useable
chkVertical.Checked = stype.vertical
chkWriteable.Checked = stype.writeable
End If
End If
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim FileName As String = vbNullString
MessageBox.Show("Please locate and open your Tibia.dat file", ".dat Reader")
With OpenFileDialog1
.Filter = "Dat file (*.dat)|*.dat|" & "All files|*.*"
If .ShowDialog = Windows.Forms.DialogResult.OK Then
FileName = .FileName
Else
Application.Exit()
End If
End With
Using reader As New IO.BinaryReader(IO.File.OpenRead(FileName))
Dim datversion As Integer = reader.ReadUInt32()
Dim items As Integer = reader.ReadUInt16()
Dim outfits As Integer = reader.ReadUInt16()
Dim effects As Integer = reader.ReadUInt16()
Dim distance As Integer = reader.ReadUInt16()
Dim maxID As Integer = items + outfits + effects + distance
Dim ID As Integer = 100
dataArray = Array.CreateInstance(GetType(sType), maxID - ID)
Do While ID < maxID
Dim sType As sType
sType.id = ID
Do
Dim optbyte As Byte
optbyte = reader.ReadByte()
Select Case optbyte
Case &H0 'ground tile
sType.speed = reader.ReadUInt16()
sType.ground = True
sType.alwaysOnTopOrder = 0
Case &H1, &H2, &H3 'on top, walk through (doors etc.), walk through (arches etc.)
sType.alwaysOnTop = True
sType.alwaysOnTopOrder = optbyte
Case &H4 'container
sType.container = True
Case &H5 'stackable
sType.stackable = True
Case &H6 'ladder?
sType.alwaysUsed = True
Case &H7 'usable
sType.useable = True
Case &H8 'rune
sType.rune = True
Case &H9 'writeable
sType.writeable = True
reader.ReadUInt16() 'max text length
Case &HA 'readable
sType.readable = True
reader.ReadUInt16() 'max text length
Case &HB 'fluid container
sType.fluidContainer = True
Case &HC 'splash
sType.splash = True
Case &HD 'blocking
sType.blocking = True
Case &HE 'immoveable
sType.immoveable = True
Case &HF 'blocks missile
sType.blocksMissile = True
Case &H10 'blocks monster movement
sType.blocksMonsterMovement = True
Case &H11 'equipable
sType.equipable = True
Case &H12 'hangable (wall item)
sType.hangable = True
Case &H13 'horizontal (wall item)
sType.horizontal = True
Case &H14 'vertical (wall item)
sType.vertical = True
Case &H15 'rotateable
sType.rotateable = True
Case &H16 'light info
sType.lightLevel = reader.ReadUInt16()
sType.lightColor = reader.ReadUInt16()
Case &H17 'unknown?
Case &H18 'floor change down?
Case &H19 'draw offset
sType.xOffset = reader.ReadUInt16()
sType.yOffset = reader.ReadUInt16()
Case &H1A 'height
sType.drawHeight = reader.ReadUInt16()
Case &H1B 'draw with height offset for all parts (2x2) of the sprite
Case &H1C 'offset life-bar (for larger monsters)
Case &H1D 'minimap color
sType.minimapColor = reader.ReadUInt16()
Case &H1E 'floor change?
'fs.ReadByte() '86 -> openable holes, 77-> can be used to go down, 76 can be used to go up, 82 -> stairs up, 79 switch
'fs.ReadByte() 'always 4
reader.ReadUInt16()
Case &H1F 'unknown?
Case &HFF
Exit Do
End Select
Loop
sType.width = reader.ReadByte()
sType.height = reader.ReadByte()
If sType.width > 1 Or sType.height > 1 Then
reader.ReadByte()
End If
sType.blendFrames = reader.ReadByte()
sType.divX = reader.ReadByte()
sType.divY = reader.ReadByte()
sType.divZ = reader.ReadByte()
sType.animationLength = reader.ReadByte()
Dim numSpr As Integer = sType.width * sType.height
numSpr *= sType.blendFrames * sType.divX
numSpr *= sType.divY * sType.divZ
numSpr *= sType.animationLength
sType.numSprites = numSpr
sType.sprites = Array.CreateInstance(GetType(Integer), sType.numSprites)
For i As Integer = 0 To sType.numSprites - 1
sType.sprites(i) = reader.ReadUInt16()
Next
dataArray(ID - 100) = sType
ID += 1
Loop
txtItems.Text = items
txtOutfits.Text = outfits
txtEffects.Text = effects
txtDistance.Text = distance
End Using
End Sub
Private Structure sType
Dim id As Integer
Dim speed As Integer
Dim ground As Boolean
Dim alwaysOnTopOrder As Integer
Dim alwaysOnTop As Boolean
Dim container As Boolean
Dim stackable As Boolean
Dim ladder As Boolean
Dim alwaysUsed As Boolean
Dim useable As Boolean
Dim rune As Boolean
Dim writeable As Boolean
Dim readable As Boolean
Dim fluidContainer As Boolean
Dim splash As Boolean
Dim blocking As Boolean
Dim immoveable As Boolean
Dim blocksMissile As Boolean
Dim blocksMonsterMovement As Boolean
Dim equipable As Boolean
Dim hangable As Boolean
Dim horizontal As Boolean
Dim vertical As Boolean
Dim rotateable As Boolean
Dim lightLevel As Integer
Dim lightColor As Integer
Dim xOffset As Integer
Dim yOffset As Integer
Dim drawHeight As Integer
Dim minimapColor As Integer
Dim width As Integer
Dim height As Integer
Dim blendFrames As Integer
Dim divX As Integer
Dim divY As Integer
Dim divZ As Integer
Dim animationLength As Integer
Dim numSprites As Integer
Dim sprites As Integer()
End Structure
End Class