'%%%%%%%Packet Functions Here
Public Function InsertNTString(Data As String)
If Connected = False And frmMain.wSock.State <> sckConnected Then Exit Function
Buffer = Buffer & Data & Chr(0)
End Function
Public Function InsertNonNTString(Data As String)
If Connected = False And frmMain.wSock.State <> sckConnected Then Exit Function
Buffer = Buffer & Data
End Function
Public Function LShift(ByVal pnValue As Long, ByVal pnShift As Long) As Double
On Error Resume Next
LShift = CDbl(pnValue * (2 ^ pnShift))
End Function
Public Function RShift(ByVal pnValue As Long, ByVal pnShift As Long) As Double
On Error Resume Next
RShift = CDbl(pnValue \ (2 ^ pnShift))
End Function
Public Function KillNull(ByVal text As String) As String
Dim I As Integer
I = InStr(1, text, Chr(0))
If I = 0 Then: KillNull = text: Exit Function
KillNull = Left(text, I - 1)
End Function
Public Function GetHexValue(ByVal v As Long) As String
v = v And &HF
If v < 10 Then: GetHexValue = Chr$(v + &H30): Else GetHexValue = Chr$(v + &H37)
End Function
Public Function GetNumValue(ByVal C As String) As Long
On Error Resume Next
C = UCase(C)
If IsNumeric(C) Then: GetNumValue = Asc(C) - &H30: Else GetNumValue = Asc(C) - &H37
End Function
Public Function InsertDWORD(Data As Long)
Buffer = Buffer & MakeDWORD(Data)
End Function
Public Function InsertWORD(Data As Integer)
Buffer = Buffer & MakeWORD(Data)
End Function
Public Function InsertBYTE(Data As Integer)
Buffer = Buffer & Chr(Data)
End Function
Function MakeDWORD(Value As Long) As String
Dim Result As String * 4
CopyMemory ByVal Result, Value, 4
MakeDWORD = Result
End Function
Function MakeWORD(Value As Integer) As String
Dim Result As String * 2
CopyMemory ByVal Result, Value, 2
MakeWORD = Result
End Function
Public Function Clear()
Buffer = vbNullString
End Function
Public Function SendPacket(PacketID As Byte)
On Error Resume Next
If frmMain.wSock.State <> sckConnected And Connected = False Then Exit Function
Dim PacketData As String
Dim PACKET As String
bytesSent = bytesSent + Len(Chr(&HFF) & Chr(PacketID) & MakeWORD(Len(Buffer) + 4) & Buffer)
frmMain.wSock.SendData Chr(&HFF) & Chr(PacketID) & MakeWORD(Len(Buffer) + 4) & Buffer
Clear
End Function
Public Function GetWORD(Data As String) As Long
Dim tmp As String
tmp = ToHex(Data)
Dim A As String, b As String
A = Mid(tmp, 1, 2)
b = Mid(tmp, 3, 2)
tmp = b & A
GetWORD = Val("&H" & tmp)
End Function
Public Function StrToHex(ByVal String1 As String) As String
On Error Resume Next
Dim strTemp As String, strReturn As String, I As Long
For I = 1 To Len(String1)
strTemp = Hex(Asc(Mid(String1, I, 1)))
If Len(strTemp) = 1 Then strTemp = "0" & strTemp
strReturn = strReturn & " " & strTemp
Next I
StrToHex = strReturn
End Function
Public Function NullTruncString(text As String)
Dim I As Integer
I = InStr(text, Chr(0))
If I = 0 Then Exit Function
NullTruncString = Left(text, I - 1)
End Function
Function MakeLong(x As String) As Long
If Len(x) < 4 Then
Exit Function
End If
CopyMemory MakeLong, ByVal x, 4
End Function
Public Function GetDWORD(Data As String) As Long
Dim tmp As String
tmp = ToHex(Data)
Dim A As String, b As String, C As String, D As String
A = Mid(tmp, 1, 2)
b = Mid(tmp, 3, 2)
C = Mid(tmp, 5, 2)
D = Mid(tmp, 7, 2)
tmp = D & C & b & A
GetDWORD = Val("&H" & tmp)
End Function
Public Function ToHex(Data As String) As String
Dim I As Integer
For I = 1 To Len(Data)
ToHex = ToHex & Right("00" & Hex(Asc(Mid(Data, I, 1))), 2)
Next I
End Function