VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmReceiving 
   BorderStyle     =   0  'None
   ClientHeight    =   90
   ClientLeft      =   0
   ClientTop       =   -45
   ClientWidth     =   105
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   7
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin MSWinsockLib.Winsock wsReceive 
      Left            =   0
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "frmReceiving"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const MAX_DATA_SIZE As Long = 16
Private Const MAX_NAME_SIZE As Long = 16
Private Const OLD_PACKET_SIZE As Long = 22  ' lDateValue(4)+bDataType(1)+bLength(1)+MAX_DATA_SIZE

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private MyID As Long
Private Type ReceiveDataType
    lDateValue As Long
    bDataType As Byte
    bLength As Byte
    bDatas(0 To (MAX_DATA_SIZE - 1)) As Byte
    bNames(0 To (MAX_NAME_SIZE - 1)) As Byte
End Type

Private m_sFilePath As String
Private m_lFile As Long

Public Sub SaveData(ByVal inFilePath As String)
    Dim lMaxDataCount As Long, i As Long
    Dim sData As String
    
    m_sFilePath = inFilePath
    
On Error Resume Next
          
   OpenFile
   With frmMain.lvEvent
        lMaxDataCount = .ListItems.Count
        
        For i = 1 To lMaxDataCount
            sData = .ListItems.Item(i).Text & "," & .ListItems(i).ListSubItems(1).Text & "," & .ListItems(i).ListSubItems(2).Text & "," & .ListItems(i).ListSubItems(3).Text
            Print #m_lFile, sData
            
        Next i
   End With
   Close #m_lFile

End Sub

Private Sub OpenFile()
On Error Resume Next
    
    m_lFile = FreeFile
    Open m_sFilePath For Append Shared As m_lFile
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    With wsReceive
        If .State <> sckClosed Then
            .Close
        End If
    End With
    CloseConnect MyID
End Sub

Public Function Prepare(ByVal ID As Long, ByVal requestID As Long)
  MyID = ID
  wsReceive.Accept requestID
End Function

Private Sub wsReceive_Close()
    On Error Resume Next
    wsReceive.Close
    Unload Me
End Sub

Private Function BytesToString(ByRef bBuffer() As Byte, ByVal lSize As Long) As String
    Dim szResult As String
    Dim i As Long, lLen As Long
    lLen = UBound(bBuffer) - LBound(bBuffer) + 1
    For i = LBound(bBuffer) To UBound(bBuffer)
        If bBuffer(i) = 0 Then
            lLen = i
        End If
    Next i
    If lLen > lSize And lSize > 0 Then
        lLen = lSize
    End If
    If lLen > 0 Then
        szResult = Space$(lLen)
        CopyMemory ByVal szResult, bBuffer(LBound(bBuffer)), lLen
    End If
    BytesToString = szResult
End Function

Private Sub wsReceive_DataArrival(ByVal bytesTotal As Long)
    Dim bValue() As Byte, szDate As String, szID As String
    Dim optReceiveData As ReceiveDataType
    Dim szName As String
    Dim bResult As Boolean
    Dim sTimeReference As String
    Dim oItem As ListItem
    Dim lPackageSize As Long
    Dim i As Long
    Dim bIsOldPackage As Boolean
    
    On Error GoTo Err_Proc

    If bytesTotal > 0 Then
        ReDim bValue(0 To bytesTotal - 1)
        'Data received here.
        wsReceive.GetData bValue, vbArray Or vbByte
        
        bIsOldPackage = False
        lPackageSize = Len(optReceiveData)
        If (bytesTotal Mod lPackageSize) <> 0 Then
            If (bytesTotal Mod OLD_PACKET_SIZE) = 0 Then
                bIsOldPackage = True
                lPackageSize = OLD_PACKET_SIZE
            End If
        End If
        For i = 0 To (bytesTotal - 1) Step lPackageSize
            CopyMemory optReceiveData, bValue(i), lPackageSize
            
            szDate = CDate((((Hex2Dec(Hex(optReceiveData.lDateValue)) / 60) / 60) + frmMain.g_vTimeZone) / 24 + 2)
            sTimeReference = "SNTP"
            
            szID = BytesToHex(optReceiveData.bDatas, , False, optReceiveData.bLength)
            If bIsOldPackage = False Then
                szName = BytesToString(optReceiveData.bNames, 16)
            Else
                szName = "<Not supported>"
            End If
                        
            With frmMain.lvEvent
                'clear list if listcount over 100.
                If .ListItems.Count > 100 Then
                    .ListItems.Clear
                End If
                
                'Add data to list
                Set oItem = .ListItems.Add(, , wsReceive.RemoteHostIP)
                With oItem
                    .SubItems(1) = szDate
                    .SubItems(2) = szID
                    .SubItems(3) = szName
                    .SubItems(4) = sTimeReference
                End With
                Set .SelectedItem = oItem
                .SelectedItem.EnsureVisible
            End With
            
            'store data here.

        Next i
    End If
Err_Exit:
    Exit Sub
Err_Proc:
    Resume Err_Exit
End Sub

Public Function BytesToHex(ByRef bData() As Byte, Optional ByVal szDelimiter As String = vbNullString, Optional bLSB As Boolean = True, Optional ByVal iByteSize As Integer = 0) As String
    Dim i As Long, szData As String, szHex As String
    Dim iUBoundIndex As Integer
    If iByteSize > 0 Then
        iUBoundIndex = LBound(bData) + iByteSize - 1
    Else
        iUBoundIndex = UBound(bData)
    End If
    On Error GoTo Error_Proc
    szData = vbNullString
    If szDelimiter = vbNullString Then
        For i = LBound(bData) To iUBoundIndex
            If i <= UBound(bData) Then
                szHex = Right$(Hex$(&H100 + bData(i)), 2)
            Else
                szHex = "00"
            End If
            If bLSB Then
                szData = szData & szHex
            Else
                szData = szHex & szData
            End If
        Next i
    Else
        For i = LBound(bData) To iUBoundIndex
            If i <= UBound(bData) Then
                szHex = Right$(Hex$(&H100 + bData(i)), 2)
            Else
                szHex = "00"
            End If
            If bLSB Then
                If szData <> "" Then szData = szData & szDelimiter
                szData = szData & szHex
            Else
                If szData <> "" Then szData = szDelimiter & szData
                szData = szHex & szData
            End If
        Next i
    End If
Error_Exit:
    BytesToHex = szData
    Exit Function
Error_Proc:
    szData = vbNullString
    Resume Error_Exit
End Function

Function Hex2Dec(num As String) As String
    Dim va As Long, sl As Integer, Result As String, vs As Integer
    Dim ts As String, i As Integer
    
    Do While Len(num) > 0
    
        sl = Len(num)
        For i = 0 To sl - 1
            va = va * 16 + Val("&h" & Mid$(num, i + 1, 1))
            vs = va \ 10
            va = va Mod 10
            If Len(ts) > 0 Or vs > 0 Then ts = ts + Hex(vs)
        Next
        
        num = ts
                
        ts = ""
        Result = Chr$(va + &H30) + Result
        va = 0
    Loop
    Hex2Dec = Result
End Function

