All pastes #350237 Raw Edit

Someone

public text v1 · immutable
·published 2007-02-11 09:16 UTC
rendered paste body
'%%%%%%%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