Zlib Packet Compression

[rm2kdev]

Hi guys, im rm2kdev aka ryan
Ive been using mirage for a long time but ive never posted anything i lernt alot of things from these forums and the old ones and the ones before that lol so i figure its my turn to give something back um this is my first tutorial ever for anything so pls dont flame =D

Okay here goes

This tutorial is designed for IOCP, easly changeable to Winsock
Difficulty 3\5

Download and install the Zlib Library from Verrigan Zlib Compression Tutorial
http://www.freewebs.com/miragesource/zlib.dll

Create the Zlib Module Also From Verrigans Zlib Compression Tutorial in the Server and Client Projects

Code:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ZCompress Lib "zlib.dll" Alias "compress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long
Private Declare Function ZUncompress Lib "zlib.dll" Alias "uncompress" (dest As Any, destLen As Any, src As Any, ByVal srcLen As Long) As Long

Public Function Compress(Data, Optional Key)
   Dim lKey As Long  'original size
   Dim sTmp As String  'string buffer
   Dim bData() As Byte  'data buffer
   Dim bRet() As Byte  'output buffer
   Dim lCSz As Long  'compressed size
    
   If TypeName(Data) = "Byte()" Then 'if given byte array data
      bData = Data  'copy to data buffer
   ElseIf TypeName(Data) = "String" Then 'if given string data
      If Len(Data) > 0 Then 'if there is data
         sTmp = Data 'copy to string buffer
         ReDim bData(Len(sTmp) - 1) 'allocate data buffer
         CopyMemory bData(0), ByVal sTmp, Len(sTmp) 'copy to data buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
   End If
   If StrPtr(bData)  0 Then 'if data buffer contains data
      lKey = UBound(bData) + 1 'get data size
      lCSz = lKey + (lKey * 0.01) + 12 'estimate compressed size
      ReDim bRet(lCSz - 1) 'allocate output buffer
      Call ZCompress(bRet(0), lCSz, bData(0), lKey) 'compress data (lCSz returns actual size)
      ReDim Preserve bRet(lCSz - 1) 'resize output buffer to actual size
      Erase bData 'deallocate data buffer
      If IsMissing(Key) Then 'if Key variable not supplied
         ReDim bData(lCSz + 3) 'allocate data buffer
         CopyMemory bData(0), lKey, 4 'copy key to buffer
         CopyMemory bData(4), bRet(0), lCSz 'copy data to buffer
         Erase bRet 'deallocate output buffer
         bRet = bData 'copy to output buffer
         Erase bData 'deallocate data buffer
      Else 'Key variable is supplied
         Key = lKey 'set Key variable
      End If
      If TypeName(Data) = "Byte()" Then 'if given byte array data
         Compress = bRet 'return output buffer
      ElseIf TypeName(Data) = "String" Then 'if given string data
         sTmp = Space(UBound(bRet) + 1) 'allocate string buffer
         CopyMemory ByVal sTmp, bRet(0), UBound(bRet) + 1 'copy to string buffer
         Compress = sTmp 'return string buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
      Erase bRet 'deallocate output buffer
   End If
End Function

Public Function Uncompress(Data, Optional ByVal Key)
   Dim lKey As Long  'original size
   Dim sTmp As String  'string buffer
   Dim bData() As Byte  'data buffer
   Dim bRet() As Byte  'output buffer
   Dim lCSz As Long  'compressed size
    
   If TypeName(Data) = "Byte()" Then 'if given byte array data
      bData = Data 'copy to data buffer
   ElseIf TypeName(Data) = "String" Then 'if given string data
      If Len(Data) > 0 Then 'if there is data
         sTmp = Data 'copy to string buffer
         ReDim bData(Len(sTmp) - 1) 'allocate data buffer
         CopyMemory bData(0), ByVal sTmp, Len(sTmp) 'copy to data buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
   End If
   If StrPtr(bData)  0 Then 'if there is data
      If IsMissing(Key) Then 'if Key variable not supplied
         lCSz = UBound(bData) - 3 'get actual data size
         CopyMemory lKey, bData(0), 4 'copy key value to key
         ReDim bRet(lCSz - 1) 'allocate output buffer
         CopyMemory bRet(0), bData(4), lCSz 'copy data to output buffer
         Erase bData 'deallocate data buffer
         bData = bRet 'copy to data buffer
         Erase bRet 'deallocate output buffer
      Else 'Key variable is supplied
         lCSz = UBound(bData) + 1 'get data size
         lKey = Key 'get Key
      End If
      ReDim bRet(lKey - 1) 'allocate output buffer
      Call ZUncompress(bRet(0), lKey, bData(0), lCSz) 'decompress to output buffer
      Erase bData 'deallocate data buffer
      If TypeName(Data) = "Byte()" Then 'if given byte array data
         Uncompress = bRet 'return output buffer
      ElseIf TypeName(Data) = "String" Then 'if given string data
         sTmp = Space(lKey) 'allocate string buffer
         CopyMemory ByVal sTmp, bRet(0), lKey 'copy to string buffer
         Uncompress = sTmp 'return string buffer
         sTmp = vbNullString 'deallocate string buffer
      End If
      Erase bRet 'deallocate return buffer
   End If
End Function

Now heres the masterful part i did some testing and found out with zlib compression on every packet you send you actually use MORE bandwidth than u would without it because a small ammount of data being compressed isnot compressed very well so your actually sending the small ammount of compressed data in the compression table which increases the size of small packets , what i have done is gone through mirage and created a system that lets me compress "cirtain" packets e.g the mapdata userdata and npcdata dramaticallly increasing speed.


Now Find the ModServerTCP: and replace
Sub SendDataTo(ByVal Index As Long, ByVal Data As String) with

Code:

Sub SendDataTo(ByVal Index As Long, ByVal Data As String, Optional Compressed As Integer)
Dim dbytes() As Byte
Dim DataTemp As String

    If Compressed = 1 Then
        Data = Compress(Data)
        DataTemp = "¿" & Data
        Data = DataTemp
    End If

    dbytes = StrConv(Data, vbFromUnicode)
    If IsConnected(Index) Then
        GameServer.Sockets.Item(Index).WriteBytes dbytes
        DoEvents
    End If
End Sub

What this does is allows you to optionally compress the data with a header packet so its identifyable at the client side because we dont want to compress everypacet we only want to compress packets above hrmmmz maby 1000bytes (cough mapdata was roughly 8000bytes on a virgin mirage definatly not good )



Now thats all for the Server Lets move onto the CLIENT: =D
Find Sub IncomingData(ByVal DataLength As Long)
and replace it with

Code:

Sub IncomingData(ByVal DataLength As Long)
Dim Buffer As String
Dim Buffer2 As String
Dim Parse() As String
Dim Packet As String
Dim top As String * 3
Dim Start As Integer

    frmMirage.Socket.GetData Buffer, vbString, DataLength
    If Left$(Buffer, 1) = "¿" Then
        Buffer = Mid(Buffer, 2, Len(Buffer) - 2)
        Buffer = Uncompress(Buffer)
    End If
    
    PlayerBuffer = PlayerBuffer & Buffer
        
    Start = InStr(PlayerBuffer, END_CHAR)
    Do While Start > 0
        Packet = Mid(PlayerBuffer, 1, Start - 1)
        PlayerBuffer = Mid(PlayerBuffer, Start + 1, Len(PlayerBuffer))
        Start = InStr(PlayerBuffer, END_CHAR)
        If Len(Packet) > 0 Then
            Call HandleData(Packet)
        End If
    Loop
End Sub

What this does it checks for the ¿ at the start of the packet then removes it rember ¿ defines the packet as compressed then once it has realised that the packet it is dealing with is compressed it does the appropriate Decompression then handles it as normal

Now the last stage Server:
In all of these replace the SendDataTo(Index,Packet) with
SendDataTo(Index, Packet, 1)

Sub SendMap()
Sub SendJoinMap()
Sub SendInventory()
Sub SendClasses()
Sub SendNewCharClasses()
Sub SendEditItemTo()
Sub SendEditNpcTo()
Sub SendEditShopTo()
Sub EditSpellTo()
Sub SendChars()


And Thats It =D
I Hope u guys enjoy this tutorial
Ps. Please mind my spelling (english is my first and only language haha just never botherd lerning it well =D XD)


Oh one quick expansion
Server: This is optional
U can put 3 labels on your server
lblUncompressed
lblCompressed
lblPercentage

and in your servers senddatato you can replace

Code:

If Compressed = 1 Then
        Data = Compress(Data)
        DataTemp = "¿" & Data
        Data = DataTemp
    End If

with

Code:

If Compressed = 1 Then
        frmServer.lblUncompresed.Caption = frmServer.lblUC.Caption + (LenB(Data) / 1000)
        Data = Compress(Data)
        DataTemp = "¿" & Data
        Data = DataTemp
        frmServer.lblCompressed.Caption = frmServer.lblC.Caption + (LenB(Data) / 1000)
    End If

Then in lblCompressed and lblUncompresseds Change sub
put in

Code:

On Error Resume Next
    lblPercent.Caption = Int(100 - ((lblC.Caption / lblUC.Caption) * 100)) & "%"

This shows you How much data would have been sent (uncompressed)
shows your how much data has been sent (compressed)
and the Total Percentage of compression

From my experiances - 1 player loading a map uses 8000bytes of data (8kb) just to load 1 map now if u x that by how many players u have this is how much bandwidth that is being waisted.
However when the data is compressed the map is only 600 - 1000bytes (depending on the map / mapsize ect) when u timmes 600 x ammount of players the ammount of data being sent is muchmuch less this reduces latency and bandwidth consumption

A small feature u can also do is monitor the ammount of total data sent
Dim TotalBytes as byte
TotalBytes = TotalBytes + lenb(data)
TotalBytes = TotalBytes / 1000 'Converts bytes to kilabytes
and create a bandwidth limet on the server
if TotalBytes => 100000 then '100mb
'Message Everyone
'ShutDown server
end if

This is useful if the person hosting ur server doesnt want u to use more than Xkb of data a month ^__^ :p might annoy your players tho hahahaha but just an example



Cheers, Ryan ^__^ rm2kdev


Just a quick Edit

Code:

If LenB(Data) > 800 Then
        frmServer.lblUC.Caption = frmServer.lblUC.Caption + (LenB(Data) / 1000)
        Data = Compress(Data)
        DataTemp = "¿" & Data
        Data = DataTemp
        frmServer.lblC.Caption = frmServer.lblC.Caption + (LenB(Data) / 1000)
    End If

You can use LenB(Data) > 800 0 (0.8kb) insted of using the optional Compresion tag this will let the server decide what data to compress rather than u setting it with the 1

[lucidar]

Haha, pretty funny I was looking at the Zlib compression and pondering about compressing the data. Though I only looked at StringCompress and it's opposite.
I'm check this out in a moment using winsock since I havn't updated my source.
Woo~ Something to do.

[edit]
Ah, nevermind I'm not going to bother since you mentioned that this method isn't good for 'smaller' packets.

I'll continue going about my little 'tests' XP

[rm2kdev]

Lol, yay first reply ahahah
Um no its not good for small packets But it really reduces a lot of the load off of the MD packet and a few others its quite good for winsock if u use the lenb(data) > 800 method because then the server actually makes a decision about weather the data is large or not 800bytes is large and mapdata ranges from about 2500 to 8000 and more XD

[Gilgamesch]

well uhm...its not williams tutorial, it was verrigans or grimskaters, but anyway, really helpful


EDIT: somehow my server starts sucking...sometimes it doesnt connect, sometimes some data isnt beging send o.O

[Spodi]

The only time I have ever found use with packet compression is for sending files (update server), but in which case, it is better to compress the whole file before sending it instead of compressing the individual packets so it only takes extra time at runtime.

[rm2kdev]

I know packet compression doesnt seem that great because of resoruce usage but thats what this system does
it only compressess large packets it doesnt compress "all" packets only ones larger than 1kb mapdata is like 8kb :p do it does thta it also does character data(requesting char info) not the live stuff that happenens in the game

[Exile]

Anyone wanna convert for winsock =D?

[Egon]

He doesn't know any better guys, put the weapons away.

[Matt]

He doesn't know any better guys, put the weapons away.

Old thread.

[Tony]

He doesn't know any better guys, put the weapons away.

Old thread.

Yeah but not that post

[Rian]

Doesn't matter if it's an old thread, it's a relevant question.

[Matt]

Doesn't matter if it's an old thread, it's a relevant question.

Yes, I'm aware. Just looked like Egon was talking to whoever posted before that kid did.

[El_Dindonnier]

Anyone wanna convert for winsock =D?

+1

it's say on the tutorial :

This tutorial is designed for IOCP, easly changeable to Winsock

What is the difference with winsock please ?
I don't understand., and it's say "easy". :|

Please help me.
thanks you in advance.