VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Buffer As String

Public Function InsertDWORD(Data As Long)
    Buffer = Buffer & MakeDWORD(Data)
End Function

Public Function InsertData(Data As String)
    Buffer = Buffer & 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

Public Function InsertNTString(Data As String)
    Buffer = Buffer & Data & vbNullChar
End Function

Public Function InsertNonNTString(Data As String)
    Buffer = Buffer & Data
End Function

Public Function MakeDWORD(value As Long) As String
Dim Result As String * 4
    CopyMemory ByVal Result, value, 4
    MakeDWORD = Result
End Function

Public 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 = ""
End Function

Public Function MakeByte(ByVal Data As Byte) As String
Dim Result As String * 1
    On Error Resume Next
    CopyMemory ByVal Result, Data, 1
    MakeByte = Result
    On Error GoTo 0
End Function

Public Function SendClient(Index As Integer, PacketID As Byte)
If frmMain.sckClient(Index).State <> sckConnected Then Exit Function
With frmMain.sckClient(Index)
  .SendData Chr(&HFF) & MakeByte(PacketID) & MakeWORD(Len(Buffer) + 4) & Buffer
End With
Clear
End Function

Public Function SendBNCS(Index As Integer, PacketID As Byte)
If frmMain.sckBNCS(Index).State <> sckConnected Then Exit Function
With frmMain.sckBNCS(Index)
  .SendData Chr(&HFF) & MakeByte(PacketID) & MakeWORD(Len(Buffer) + 4) & Buffer
End With

Clear
End Function

Public Function StrToHex(ByVal String1 As String) As String
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 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
    End If
    KillNull = Left(text, I - 1)
End Function
Public 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 CVL(X As String) As Long
    CopyMemory CVL, ByVal X, 4
End Function

Public Function MKL(value As Long) As String
    Dim Result As String * 4
    CopyMemory ByVal Result, value, 4
    MKL = Result
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 GetDWORD(Data As String) As Long
Dim lReturn As Long
    Call CopyMemory(lReturn, ByVal Data, 4)
    GetDWORD = lReturn
End Function

Public Function GetWORD(Data As String) As Long
Dim lReturn As Long
    Call CopyMemory(lReturn, ByVal Data, 2)
    GetWORD = lReturn
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 If
End Function

Public Function HexToStr(ByVal Hex1 As String) As String
On Error Resume Next
    Dim strTemp As String, strReturn As String, I As Long
    If Len(Hex1) Mod 2 <> 0 Then Exit Function
    For I = 1 To Len(Hex1) Step 2
    strReturn = strReturn & Chr(Val("&H" & Mid(Hex1, I, 2)))
    Next I
    HexToStr = strReturn
End Function

Public Function GetNumValue(ByVal C As String) As Long
    C = UCase(C)
    If IsNumeric(C) Then
       GetNumValue = Asc(C) - &H30
    Else
        GetNumValue = Asc(C) - &H37
    End If
End Function

Public Sub AddData(Data As String)
Buffer = Buffer & Data
End Sub

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

Public Function DebugOutput(ByVal sIn As String) As String
     Dim x1 As Long, y1 As Long
     Dim iLen As Long, iPos As Long
     Dim sB As String, sT As String
     Dim sOut As String
     Dim Offset As Long, sOffset As String
      
     iLen = Len(sIn)
     If iLen = 0 Then Exit Function
     sOut = ""
     Offset = 0
     For x1 = 0 To ((iLen - 1) \ 16)
         sOffset = Right$("0000" & Hex(Offset), 4)
         sB = String(48, " ")
         sT = "................"
         For y1 = 1 To 16
             iPos = 16 * x1 + y1
             If iPos > iLen Then Exit For
             Mid(sB, 3 * (y1 - 1) + 1, 2) = Right("00" & Hex(Asc(Mid(sIn, iPos, 1))), 2) & " "
             Select Case Asc(Mid(sIn, iPos, 1))
             Case 0, 9, 10, 13
             Case Else
                 Mid(sT, y1, 1) = Mid(sIn, iPos, 1)
             End Select
         Next y1
         If Len(sOut) > 0 Then sOut = sOut & vbCrLf
         sOut = sOut & sOffset & ":  "
         sOut = sOut & sB & "  " & sT
         Offset = Offset + 16
     Next x1
     DebugOutput = sOut
 End Function
Public Function ConvertToServer(Data As String) As String
ConvertToServer = CLng("&H" & ToHex(Mid(Data, 1, 1))) & "." & CLng("&H" & ToHex(Mid(Data, 2, 1))) & "." & CLng("&H" & ToHex(Mid(Data, 3, 1))) & "." & CLng("&H" & ToHex(Mid(Data, 4, 1)))
End Function
