blackd
03-01-2014, 12:19
People used to read chat through GUI pointers at GUI structure, but I could not find it nowadays in Tibia 10.35, so I investigated an alternative way and I finally found the solution. I am sharing it for experienced programmers. If you are not an experienced programmer you still can buy a full working example for 50 euros :cool: , just contact me by email to daniel@blackdtools.com with subject "BUY CHAT READER"
- Code is VB.NET 2010 (a nice free Visual Basic editor that you can download from Microsoft)
Public Module modTibiaChatReader
' Designed for Tibia 10.35!
' Version 1.1
' An experienced programmer will find here all what you need to know
' to read Tibia full chat from memory.
' Code made by Blackd (http://blackdtools.net)
' This module can be only be published in blackdtools.net
' YOU ARE NOT ALLOWED TO REPOST THIS CODE IN ANY OTHER WEB DOMAIN.
' However you CAN use this module in your bots or tools. That is no problem.
' You can also purchase the code of a full working example for VB.NET 2010 contacting Blackd.
' That full code costs 50 euros. You will be allowed to reuse it in your tools too.
' Contact email: daniel@blackdtools.com
Public Structure TibiaChatLine
Public Sender As String
Public Msg As String
Public Level As String
Public Time As String
Public Channel As String
Public Type As Byte
End Structure
' We will store all chat lines here:
Public TibiaFullChat() As TibiaChatLine
' We will store all available channel names here:
Public TibiaChannelNames() As String
' We will store active chat channel here:
Public SelectedChannel As String
' For fast checks we will also store totals here:
Public TotalChatLines As Integer
Public TotalChannelNames As Integer
' An aux function to read Tibia strings.
Private Function MyReadString(ByVal tibiaPID As Integer, ByVal adrString As Integer, Optional ByVal maxSize As Integer = 2048) As String
Dim res As String
Dim b As Byte
Dim i As Integer
i = 0
res = ""
Do
b = Memory_ReadByte(tibiaPID, adrString + i, , True)
i = i + 1
If Not (b = 0) Then
res = res & Chr(CInt(b))
End If
Loop Until (b = 0) Or (i = maxSize)
Return res
End Function
' An aux function to init our local structs.
Private Sub ResetLocalTibiaChatStructs()
ReDim TibiaFullChat(0)
TotalChatLines = 0
SelectedChannel = ""
TibiaFullChat(0).Sender = ""
TibiaFullChat(0).Msg = ""
TibiaFullChat(0).Level = ""
TibiaFullChat(0).Time = ""
TibiaFullChat(0).Channel = ""
TibiaFullChat(0).Type = &H0
End Sub
' LoadTibiaChatLog: It will load all the chat lines in TibiaFullChat()
' Only tested in Tibia 10.35
Public Sub LoadTibiaChatLog(ByVal tibiaPID As Integer, ByVal adrChatStruct As Integer, ByVal initialJumpBytes As String)
Const cteMaxChannels As Integer = 1000 ' just to avoid a infinite loop in case something goes wrong....
Const cteMaxMsgsPerChannel As Integer = 100000 ' (same)
Dim totalLines As Integer
Dim totalChannels As Integer
Dim thisChannelMsgCount As Integer
Dim channelName As String
Dim adrPos As Integer
Dim adrSelector As Integer
Dim adrFirstChatChannel As Integer
Dim adrSelectedChatChannel As Integer
Dim ptrChannelName As Integer
Dim ptr As Integer
Dim addr As Integer
Dim msgPointer As Integer
Dim jumpParts() As String
Dim i As Integer
Dim thisJump As Integer
Dim lastJump As Integer
totalLines = 0
totalChannels = 0
ResetLocalTibiaChatStructs()
' First read is a special read that do the initial translation for computers with ASRL activated (win7+)
' We set our last paramater of our Memory_ReadLong function to false,
' then it will consider the address as an relative address that needs to be translated to absolute according ASRL)
adrPos = Memory_ReadLong(tibiaPID, adrChatStruct, , False)
' Debug.Print("adrPos =" + Hex(adrPos))
jumpParts = Split(initialJumpBytes, ",")
lastJump = UBound(jumpParts)
For i = 0 To UBound(jumpParts)
thisJump = Convert.ToInt32(jumpParts(i), 16)
adrPos = adrPos + thisJump
If Not (i = lastJump) Then
adrPos = Memory_ReadLong(tibiaPID, adrPos, , True)
If (adrPos < 1000) Then
' Integrity check check failed. We should stop.
Debug.Print("Integrity check failed at debug point 1")
ResetLocalTibiaChatStructs()
Exit Sub
End If
End If
Next i
adrSelector = adrPos
' We reached the interesting zone of Tibia memory:
' We have a pointer to the first channel struct and
' 0xC bytes later, we have a pointer to the active channel struct
adrFirstChatChannel = Memory_ReadLong(tibiaPID, adrSelector, , True)
adrSelectedChatChannel = Memory_ReadLong(tibiaPID, adrSelector + &HC, , True)
If (adrFirstChatChannel < 1000) Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 2")
ResetLocalTibiaChatStructs()
Exit Sub
End If
If (adrSelectedChatChannel < 1000) Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 3")
ResetLocalTibiaChatStructs()
Exit Sub
End If
ptr = adrFirstChatChannel
While (ptr > 0)
' iterate through the list of channels
ptrChannelName = Memory_ReadLong(tibiaPID, ptr + &H2C, , True)
channelName = MyReadString(tibiaPID, ptrChannelName)
ReDim Preserve TibiaChannelNames(totalChannels)
TibiaChannelNames(totalChannels) = channelName
totalChannels = totalChannels + 1
' Check if current channel is the active chat channel
If ptr = adrSelectedChatChannel Then
SelectedChannel = channelName ' Update SelectedChannel
End If
addr = Memory_ReadLong(tibiaPID, ptr + &H24, , True)
addr = Memory_ReadLong(tibiaPID, addr + &H10, , True)
thisChannelMsgCount = 0
While (addr > 0)
' iterate through the list of messages for this channel
thisChannelMsgCount = thisChannelMsgCount + 1
ReDim Preserve TibiaFullChat(totalLines)
TibiaFullChat(totalLines).Sender = MyReadString(tibiaPID, addr + &H14)
msgPointer = Memory_ReadLong(tibiaPID, addr + &H4C, , True)
TibiaFullChat(totalLines).Msg = MyReadString(tibiaPID, msgPointer)
TibiaFullChat(totalLines).Level = MyReadString(tibiaPID, addr + &H3C)
TibiaFullChat(totalLines).Time = MyReadString(tibiaPID, addr + &H8, 6)
TibiaFullChat(totalLines).Channel = channelName
TibiaFullChat(totalLines).Type = Memory_ReadByte(tibiaPID, addr + &H4, , True)
totalLines = totalLines + 1
addr = Memory_ReadLong(tibiaPID, addr + &H5C, , True)
If thisChannelMsgCount = cteMaxMsgsPerChannel Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 4")
ResetLocalTibiaChatStructs()
Exit Sub
End If
End While
If totalChannels = cteMaxChannels Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 5")
ResetLocalTibiaChatStructs()
Exit Sub
End If
ptr = Memory_ReadLong(tibiaPID, ptr + &H10, , True)
End While
TotalChannelNames = totalChannels
TotalChatLines = totalLines
End Sub
' FilterChatLog will read the full chat log of your desired channel.
' - Requires a previous call to LoadTibiaChatLog.
' You can skip mark symbols { } with the optional parameter removeMarks.
Public Function FilterChatLog(ByRef channelName As String, Optional ByVal removeMarks As Boolean = False) As String
Dim res As String
Dim i As Integer
Dim last As Integer
Dim filteredLine As String
last = TotalChatLines - 1
res = ""
For i = 0 To last
If TibiaFullChat(i).Channel = channelName Then
If Not (res = "") Then
res = res & vbCrLf
End If
If removeMarks = False Then
res = res & TibiaFullChat(i).Msg
Else
filteredLine = Replace(TibiaFullChat(i).Msg, "{", "")
filteredLine = Replace(filteredLine, "}", "")
res = res & filteredLine
End If
End If
Next i
Return res
End Function
' Reads current active Tibia chat window.
' Default values are ok for Tibia 10.35
Public Function ReadTibiaChatLog(ByVal tibiaPID As Integer, Optional ByVal adrChatStruct As Integer = &H9E955C, Optional ByVal initialJumpBytes As String = "1C,C,6C") As String
LoadTibiaChatLog(tibiaPID, adrChatStruct, initialJumpBytes)
Dim res As String
res = FilterChatLog(SelectedChannel, True)
Return res
End Function
End Module
- Code is VB.NET 2010 (a nice free Visual Basic editor that you can download from Microsoft)
Public Module modTibiaChatReader
' Designed for Tibia 10.35!
' Version 1.1
' An experienced programmer will find here all what you need to know
' to read Tibia full chat from memory.
' Code made by Blackd (http://blackdtools.net)
' This module can be only be published in blackdtools.net
' YOU ARE NOT ALLOWED TO REPOST THIS CODE IN ANY OTHER WEB DOMAIN.
' However you CAN use this module in your bots or tools. That is no problem.
' You can also purchase the code of a full working example for VB.NET 2010 contacting Blackd.
' That full code costs 50 euros. You will be allowed to reuse it in your tools too.
' Contact email: daniel@blackdtools.com
Public Structure TibiaChatLine
Public Sender As String
Public Msg As String
Public Level As String
Public Time As String
Public Channel As String
Public Type As Byte
End Structure
' We will store all chat lines here:
Public TibiaFullChat() As TibiaChatLine
' We will store all available channel names here:
Public TibiaChannelNames() As String
' We will store active chat channel here:
Public SelectedChannel As String
' For fast checks we will also store totals here:
Public TotalChatLines As Integer
Public TotalChannelNames As Integer
' An aux function to read Tibia strings.
Private Function MyReadString(ByVal tibiaPID As Integer, ByVal adrString As Integer, Optional ByVal maxSize As Integer = 2048) As String
Dim res As String
Dim b As Byte
Dim i As Integer
i = 0
res = ""
Do
b = Memory_ReadByte(tibiaPID, adrString + i, , True)
i = i + 1
If Not (b = 0) Then
res = res & Chr(CInt(b))
End If
Loop Until (b = 0) Or (i = maxSize)
Return res
End Function
' An aux function to init our local structs.
Private Sub ResetLocalTibiaChatStructs()
ReDim TibiaFullChat(0)
TotalChatLines = 0
SelectedChannel = ""
TibiaFullChat(0).Sender = ""
TibiaFullChat(0).Msg = ""
TibiaFullChat(0).Level = ""
TibiaFullChat(0).Time = ""
TibiaFullChat(0).Channel = ""
TibiaFullChat(0).Type = &H0
End Sub
' LoadTibiaChatLog: It will load all the chat lines in TibiaFullChat()
' Only tested in Tibia 10.35
Public Sub LoadTibiaChatLog(ByVal tibiaPID As Integer, ByVal adrChatStruct As Integer, ByVal initialJumpBytes As String)
Const cteMaxChannels As Integer = 1000 ' just to avoid a infinite loop in case something goes wrong....
Const cteMaxMsgsPerChannel As Integer = 100000 ' (same)
Dim totalLines As Integer
Dim totalChannels As Integer
Dim thisChannelMsgCount As Integer
Dim channelName As String
Dim adrPos As Integer
Dim adrSelector As Integer
Dim adrFirstChatChannel As Integer
Dim adrSelectedChatChannel As Integer
Dim ptrChannelName As Integer
Dim ptr As Integer
Dim addr As Integer
Dim msgPointer As Integer
Dim jumpParts() As String
Dim i As Integer
Dim thisJump As Integer
Dim lastJump As Integer
totalLines = 0
totalChannels = 0
ResetLocalTibiaChatStructs()
' First read is a special read that do the initial translation for computers with ASRL activated (win7+)
' We set our last paramater of our Memory_ReadLong function to false,
' then it will consider the address as an relative address that needs to be translated to absolute according ASRL)
adrPos = Memory_ReadLong(tibiaPID, adrChatStruct, , False)
' Debug.Print("adrPos =" + Hex(adrPos))
jumpParts = Split(initialJumpBytes, ",")
lastJump = UBound(jumpParts)
For i = 0 To UBound(jumpParts)
thisJump = Convert.ToInt32(jumpParts(i), 16)
adrPos = adrPos + thisJump
If Not (i = lastJump) Then
adrPos = Memory_ReadLong(tibiaPID, adrPos, , True)
If (adrPos < 1000) Then
' Integrity check check failed. We should stop.
Debug.Print("Integrity check failed at debug point 1")
ResetLocalTibiaChatStructs()
Exit Sub
End If
End If
Next i
adrSelector = adrPos
' We reached the interesting zone of Tibia memory:
' We have a pointer to the first channel struct and
' 0xC bytes later, we have a pointer to the active channel struct
adrFirstChatChannel = Memory_ReadLong(tibiaPID, adrSelector, , True)
adrSelectedChatChannel = Memory_ReadLong(tibiaPID, adrSelector + &HC, , True)
If (adrFirstChatChannel < 1000) Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 2")
ResetLocalTibiaChatStructs()
Exit Sub
End If
If (adrSelectedChatChannel < 1000) Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 3")
ResetLocalTibiaChatStructs()
Exit Sub
End If
ptr = adrFirstChatChannel
While (ptr > 0)
' iterate through the list of channels
ptrChannelName = Memory_ReadLong(tibiaPID, ptr + &H2C, , True)
channelName = MyReadString(tibiaPID, ptrChannelName)
ReDim Preserve TibiaChannelNames(totalChannels)
TibiaChannelNames(totalChannels) = channelName
totalChannels = totalChannels + 1
' Check if current channel is the active chat channel
If ptr = adrSelectedChatChannel Then
SelectedChannel = channelName ' Update SelectedChannel
End If
addr = Memory_ReadLong(tibiaPID, ptr + &H24, , True)
addr = Memory_ReadLong(tibiaPID, addr + &H10, , True)
thisChannelMsgCount = 0
While (addr > 0)
' iterate through the list of messages for this channel
thisChannelMsgCount = thisChannelMsgCount + 1
ReDim Preserve TibiaFullChat(totalLines)
TibiaFullChat(totalLines).Sender = MyReadString(tibiaPID, addr + &H14)
msgPointer = Memory_ReadLong(tibiaPID, addr + &H4C, , True)
TibiaFullChat(totalLines).Msg = MyReadString(tibiaPID, msgPointer)
TibiaFullChat(totalLines).Level = MyReadString(tibiaPID, addr + &H3C)
TibiaFullChat(totalLines).Time = MyReadString(tibiaPID, addr + &H8, 6)
TibiaFullChat(totalLines).Channel = channelName
TibiaFullChat(totalLines).Type = Memory_ReadByte(tibiaPID, addr + &H4, , True)
totalLines = totalLines + 1
addr = Memory_ReadLong(tibiaPID, addr + &H5C, , True)
If thisChannelMsgCount = cteMaxMsgsPerChannel Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 4")
ResetLocalTibiaChatStructs()
Exit Sub
End If
End While
If totalChannels = cteMaxChannels Then
' Integrity check failed. We should stop.
Debug.Print("Integrity check failed at debug point 5")
ResetLocalTibiaChatStructs()
Exit Sub
End If
ptr = Memory_ReadLong(tibiaPID, ptr + &H10, , True)
End While
TotalChannelNames = totalChannels
TotalChatLines = totalLines
End Sub
' FilterChatLog will read the full chat log of your desired channel.
' - Requires a previous call to LoadTibiaChatLog.
' You can skip mark symbols { } with the optional parameter removeMarks.
Public Function FilterChatLog(ByRef channelName As String, Optional ByVal removeMarks As Boolean = False) As String
Dim res As String
Dim i As Integer
Dim last As Integer
Dim filteredLine As String
last = TotalChatLines - 1
res = ""
For i = 0 To last
If TibiaFullChat(i).Channel = channelName Then
If Not (res = "") Then
res = res & vbCrLf
End If
If removeMarks = False Then
res = res & TibiaFullChat(i).Msg
Else
filteredLine = Replace(TibiaFullChat(i).Msg, "{", "")
filteredLine = Replace(filteredLine, "}", "")
res = res & filteredLine
End If
End If
Next i
Return res
End Function
' Reads current active Tibia chat window.
' Default values are ok for Tibia 10.35
Public Function ReadTibiaChatLog(ByVal tibiaPID As Integer, Optional ByVal adrChatStruct As Integer = &H9E955C, Optional ByVal initialJumpBytes As String = "1C,C,6C") As String
LoadTibiaChatLog(tibiaPID, adrChatStruct, initialJumpBytes)
Dim res As String
res = FilterChatLog(SelectedChannel, True)
Return res
End Function
End Module