EDIT:
Now im sure i got decompress working!
[code]
Private Sub ParseD2GS(Data As String)
Dim PacketID As String
      PacketID = Asc(Mid(Data, 1, 1))
Select Case PacketID
'Case &HAF:          Call modBNET.D2GShandle0xAF(Data)
'Case &H2:          Call modBNET.D2GSsend0x6A
Case Else
ShowChat vbRed, "Unparsed Packet: 0x" & Hex(PacketID) & GetLog(Data)
End Select
End Sub
[/code]
[code]
Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
Dim strTemp As String
Call Winsock3.GetData(strTemp, vbString, bytesTotal)
On Error Resume Next
Dim offset As Long
Dim Size As Long
Dim A As Integer
Dim H1 As String
Dim H2 As Integer
Dim outdata As String
Dim maxsize As Long
Dim outsize As Long
A = 5
H1 = GetPacketSize(strTemp)
outdata = String(Size + (A + 1), vbNullChar)
H2 = DecodePacket(Mid(strTemp, 1 + offset), Size + A, outdata)
Call ParseD2GS(strTemp)
End Sub
[/code]

Edited new parse..

Ok , here is my

[code]
Public Sub D2GSsend0x68(ByVal d2gshash As String, ByVal tokengs As String)
On Error Resume Next
    Const pdBuf As String = "000000008FD4773A18AE6F4B00000000"
    Dim tmpStr As String, i As Long
    For i = Len(hplayer) * 2 + 3 To 32 Step 2
        tmpStr = tmpStr & Chr("&H" & Mid(pdBuf, i, 2))
    Next i
    tmpStr = hplayer & Chr(0) & tmpStr
Call iClear
        Call iDWORD(Form1.Text9.Text)
        Call iWORD(Form1.Text8.Text)
        Call iBYTE(&H3) 
        Call iDWORD(&HB)   
       Call iDWORD(&HED5DCC50)
        Call iDWORD(&H91A519B6)
        Call iBYTE(&H0)
        Call iNTSTRING(tmpStr) 
        Call iHEADER(&H68, D2GS_HEADER)
         Call iPacket(Form1.Winsock3.SocketHandle)
         ShowChat vbGreen, "0x68 sent"
End Sub
[/code]
68 62 10 93 0E E1 03 03 0B 00 00 00 50 CC 5D ED hb..........P.].
B6 19 A5 91 00 6B 65 69 6A 6F 00 77 3A 18 AE 6F  .....keijo.w:..o
4B 00 00 00 00 00                                                    K.....

Here is token: 993
and here hash: 244519010
Please some1 explain meh..

After that my winsock3 got timeout, why?