Public Function ParsePlayerInfo(theData As String)
On Error Resume Next 'i would never understand this playerinfo format without the wonderful help from trix.
'Debug.Print theData
Dim theID As Long, playerState As Long, tmpLastInfo As Integer, theCar As String
Dim byteX(3) As Byte
Dim byteY(3) As Byte
Dim byteZ(3) As Byte
Dim byteHealth(3) As Byte
Dim byteRotation(3) As Byte
Dim XPos As String, YPos As String, ZPos As String
theID = Val(Asc(GetChar(theData, 2)))
theCar = Val(Asc(GetChar(theData, 3)))
tmpLastInfo = -1
mydeb = vbNullString
For Xx = 1 To Len(theData)
toadd = Hex(Val(Asc(Mid(theData, Xx, 1))))
If Len(toadd) = 1 Then toadd = "0" & toadd
mydeb = mydeb & toadd & " "
Next Xx
If mydeb = tmpLP Then GoTo samepacket
tmpLP = mydeb
Dim tmpsave As Long
If Asc(Mid(theData, 3, 1)) > 0 Then ' In car
If players(theID).onFoot = True Then
If bWaitingForPacket = False Then ' CHECK IF NEED TO WAIT FOR NEXT PACKET
If Len(theData) = 14 Then
OnEnterVehicle CInt(theID), CInt(theCar) - 100, True
players(theID).onFoot = False
Else
lTempCarID = theCar
bWaitingForPacket = True
End If
Else
If Len(theData) = 14 And Val(Asc(Mid(theData, 3, 1))) = (lTempCarID + 100) Then 'PASSENGER
OnEnterVehicle CInt(theID), CInt(lTempCarID), True
Else
OnEnterVehicle CInt(theID), CInt(lTempCarID), False
End If
players(theID).onFoot = False
bWaitingForPacket = False
End If
End If
tempAsc = vbNullString
For i = 8 To Len(theData)
tempAsc = tempAsc & Asc(Mid(theData, i, 1))
If Asc(Mid(theData, i, 1)) = 13 And tmpLastInfo < 13 Then
byteX(0) = Asc(Mid(theData, i + 1, 1)): byteX(1) = Asc(Mid(theData, i + 2, 2)): byteX(2) = Asc(Mid(theData, i + 3, 3)): byteX(3) = Asc(Mid(theData, i + 4, 4))
byteY(0) = Asc(Mid(theData, i + 5, 1)): byteY(1) = Asc(Mid(theData, i + 6, 1)): byteY(2) = Asc(Mid(theData, i + 7, 1)): byteY(3) = Asc(Mid(theData, i + 8, 1))
byteZ(0) = Asc(Mid(theData, i + 9, 1)): byteZ(1) = Asc(Mid(theData, i + 10, 1)): byteZ(2) = Asc(Mid(theData, i + 11, 1)): byteZ(3) = Asc(Mid(theData, i + 12, 1)) 'Debug.Print byteX(0) & byteX(1) & byteX(2) & byteX(3) & " - " & byteY(0) & byteY(1) & byteY(2) & byteY(3) & " - "; byteZ(0) & byteZ(1) & byteZ(2) & byteZ(3) & " :: CAR"
tmpsave = i
i = 3
byteHealth(0) = Asc(Mid(theData, i + 1, 1)): byteHealth(1) = Asc(Mid(theData, i + 2, 1)): byteHealth(2) = Asc(Mid(theData, i + 3, 1)): byteHealth(3) = Asc(Mid(theData, i + 4, 1))
i = tmpsave
players(theID).carHealth = Val(GetCoordinate(byteHealth) / 80) & "%"
i = i + 12
tmpLastInfo = 13
End If
Next i
LastPacket = theData
ElseIf Asc(Mid(theData, 3, 1)) = 0 Then ' On foot
If players(theID).onFoot = False Then
OnExitVehicle CInt(theID), CInt(players(theID).car)
players(theID).onFoot = True
End If
Dim bWeaponChanged As Boolean
Dim iWeaponSlot
sAnimation = Asc(Mid(theData, 28, 1))
sExtra = Asc(Mid(theData, 33, 1))
aAction = Asc(Mid(theData, 15, 1))
Select Case aAction
Case 24 'entering vehicle
Case "58" ' getting in car
Case Else
End Select
If Asc(Mid(theData, 8, 1)) = "1" Then 'running
If Asc(Mid(theData, 22, 1)) = "219" Then OnPlayerCollision theID
If Asc(Mid(theData, 24, 1)) = "167" Then OnPlayerShooting theID, True
End If
bWeaponChanged = False
If Asc(Mid(theData, 8, 1)) = "2" Then 'STANDING
iWeaponSlot = Asc(Mid(theData, 19, 1)) ' GET WEAPON SLOT
If iWeaponSlot <> players(theID).CurrentSlot And iWeaponSlot <> 52 And iWeaponSlot <> 53 And iWeaponSlot <> 54 Then 'ID 53 and 54 happen when sidestepping for somereason
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
'OnChangeWeapon theID, CLng(players(theID).Weapon), CLng(iWeapon)
players(theID).CurrentSlot = iWeaponSlot
End If
If Asc(Mid(theData, 20, 1)) = "8" Then 'ROTATING (WEAPON ID CHANGES POSITION NOW)
tmpWeapon = Asc(Mid(theData, 26, 1))
If iWeaponSlot = 30 And tmpWeapon <> players(theID).Weapon And tmpWeapon > 0 Then
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
players(theID).CurrentSlot = iWeaponSlot
End If
If bWeaponChanged Then
If tmpWeapon = "0" Then
If iWeaponSlot = "30" Then
players(theID).Weapon = "0"
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
End If
Else
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
byteRotation(0) = Asc(Mid(theData, 21, 1))
byteRotation(1) = Asc(Mid(theData, 22, 1))
byteRotation(2) = Asc(Mid(theData, 23, 1))
byteRotation(3) = Asc(Mid(theData, 24, 1))
tmprotation = CStr(GetCoordinate(byteRotation))
If InStr(1, tmprotation, "E") Then tmprotation = "0"
players(theID).Rotation = tmprotation
ElseIf Asc(Mid(theData, 20, 1)) = 16 Then ' WEAPON CHANGING NO ROTATION
tmpWeapon = Asc(Mid(theData, 21, 1))
If iWeaponSlot = 30 And tmpWeapon <> players(theID).Weapon Then
bWeaponChanged = True
iWeapon = players(theID).Weapon 'temp storage for old weapon
players(theID).CurrentSlot = iWeaponSlot
End If
If bWeaponChanged Then
If tmpWeapon = "0" Then
If iWeaponSlot = "30" Then
players(theID).Weapon = "0"
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
End If
Else
players(theID).WeaponSlot(iWeaponSlot) = tmpWeapon
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
ElseIf Asc(Mid(theData, 20, 1)) = 0 Then 'WEIRD 0 PACKET IT DOES SOMETIMES (Punch / kick )
If bWeaponChanged Then
If iWeaponSlot = "30" Then players(theID).Weapon = "0" 'Asc(Mid(theData, 21, 1))
Else
players(theID).Weapon = players(theID).WeaponSlot(iWeaponSlot)
End If
End If
If bWeaponChanged Then
OnChangeWeapon theID, CLng(iWeapon), CLng(players(theID).WeaponSlot(iWeaponSlot))
End If
Exit Function
Else
If Asc(Mid(theData, 33, 1)) = "8" Then 'ROTATING
byteRotation(0) = Asc(Mid(theData, 34, 1)): byteRotation(1) = Asc(Mid(theData, 35, 1)): byteRotation(2) = Asc(Mid(theData, 36, 1)): byteRotation(3) = Asc(Mid(theData, 37, 1))
tmprotation = CStr(GetCoordinate(byteRotation))
If InStr(1, tmprotation, "E") Then tmprotation = "0"
players(theID).Rotation = tmprotation
End If
End If
tempAsc = vbNullString
For i = 3 To Len(theData)
tempAsc = tempAsc & Asc(Mid(theData, i, 1))
If Asc(Mid(theData, i, 1)) = 1 And tmpLastInfo < 1 Then
byteX(0) = Asc(Mid(theData, i + 1, 1)): byteX(1) = Asc(Mid(theData, i + 2, 1)): byteX(2) = Asc(Mid(theData, i + 3, 1)): byteX(3) = Asc(Mid(theData, i + 4, 1))
skipx1:
byteY(0) = Asc(Mid(theData, i + 5, 1)): byteY(1) = Asc(Mid(theData, i + 6, 1)): byteY(2) = Asc(Mid(theData, i + 7, 1)): byteY(3) = Asc(Mid(theData, i + 8, 1))
skipy1:
byteZ(0) = Asc(Mid(theData, i + 9, 1)): byteZ(1) = Asc(Mid(theData, i + 10, 1)): byteZ(2) = Asc(Mid(theData, i + 11, 1)): byteZ(3) = Asc(Mid(theData, i + 12, 1))
skipz1:
'Debug.Print byteX(0) & byteX(1) & byteX(2) & byteX(3) & " - " & byteY(0) & byteY(1) & byteY(2) & byteY(3) & " - "; byteZ(0) & byteZ(1) & byteZ(2) & byteZ(3) & " :: FOOT"
tmpsave = i
i = 3
byteHealth(0) = Asc(Mid(theData, i + 1, 1)): byteHealth(1) = Asc(Mid(theData, i + 2, 1)): byteHealth(2) = Asc(Mid(theData, i + 3, 1)): byteHealth(3) = Asc(Mid(theData, i + 4, 1))
i = tmpsave
i = i + 12
tmpLastInfo = 1
players(theID).playerHealth = GetCoordinate(byteHealth) & "%"
players(theID).carHealth = "<no car>" 'it will be 0 when they are not in a car!!
End If
Next
End If
XPos = modCoordinates.GetCoordinate(byteX)
YPos = modCoordinates.GetCoordinate(byteY)
ZPos = modCoordinates.GetCoordinate(byteZ)
If Asc(Mid(theData, 3, 1)) > 0 And XPos <> 0 And YPos <> 0 Then ' In car
If players(theID).xCoords <> XPos Then 'get angle
angle = Atan2(XPos - players(theID).xCoords, YPos - players(theID).yCoords)
If InStr(1, angle, "E") Then angle = 0
players(theID).carRotation = angle
End If
End If
If XPos = 0 Then GoTo skipx '0 = same as previous
players(theID).xCoords = XPos
skipx:
If YPos = 0 Then GoTo skipy '0 = same as previous
players(theID).yCoords = YPos
skipy:
If ZPos = 0 Then GoTo skipz '0 = same as previous
players(theID).zCoords = ZPos
skipz:
players(theID).car = theCar
samepacket:
End Function