Прием данных в WinSock - VB

Option Explicit
 
Dim viewData As Double  'переменная хранящая данные (температуру)
Dim connectionState As Boolean ' переменная, отвечающая за состояние подключения
 
Public Function WinToUTF8(ByRef inString As String, ByVal lMaxSize As Long) As String
  Dim hMemLock1 As Long, hMemLock2 As Long
  Dim iStrSize As Long
  hMemLock1 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)
  hMemLock2 = LocalAlloc(LMEM_ZEROINIT, lMaxSize)
  iStrSize = MultiByteToWideChar(0&, 0&, inString, &HFFFF, hMemLock1, lMaxSize)
  iStrSize = WideCharToMultiByte(65001, 0&, hMemLock1, iStrSize, hMemLock2, lMaxSize, 0&, 0&) ' CP_UTF8
  If Len(iStrSize) Then
  WinToUTF8 = String$(iStrSize, 0&)
  Call CopyMemory(ByVal WinToUTF8, ByVal hMemLock2, iStrSize)
  End If
  Call LocalFree(hMemLock1)
  Call LocalFree(hMemLock2)
End Function
 
Public Function WinToUTF8TXT(Txt As Variant) As String
 If Txt & "" = "" Then Exit Function
 Dim i As Long, s As String, Tmp As String
 Tmp = Txt
 i = (Len(Tmp) + 1) * 2
  s = WinToUTF8(Tmp, i)
  s = Left(s, Len(Tmp) * 2)
  WinToUTF8TXT = s
End Function
 
Private Sub LabelPref()
'Набор настроек элементов управления
    lbData.Caption = CStr(viewData) + "°C"
    lbData.ForeColor = vbGreen
    lbData.Font = "Times New Roman"
    lbData.FontSize = 100
    lbData.Alignment = 2
    frTP.Caption = "Температура процесса"
    frTP.FontSize = 12
    frCS.Caption = "Состояние подключения"
    frCS.FontSize = 12
    Shape1.BackStyle = 1
    Shape2.BackStyle = 1
    Shape1.BackColor = vbRed
    Shape2.BackColor = vbRed
    lbChat.Font = "Times New Roman"
    lbChat.FontSize = 24
    lbChat.Caption = " Чат"
    lbChat.ForeColor = vbYellow
    lbCData.Font = "Times New Roman"
    lbCData.FontSize = 24
    lbCData.Caption = " Данные"
    lbCData.ForeColor = vbYellow
    txtOutput.Text = ""
    txtSendData.Text = ""
    cmdSendData.Caption = "Отправить"
    txtOutput.Locked = True
End Sub
 
Private Sub cmdSendData_Click()
    Dim b As String
    'Преобразовываем строку в кодировку UTF-8
    b = WinToUTF8TXT(txtSendData.Text & vbCrLf)
    'Отправляем сообщение
    Winsock1.SendData b
    'Записываем в лог чата
    txtOutput.Text = txtOutput.Text & vbNewLine & "Сервер: " & txtSendData.Text
    'Стираем текст
    txtSendData.Text = ""
    txtSendData.SetFocus
End Sub
 
Private Sub Form_Load()
    viewData = 10
    LabelPref
    connectionState = False
    'Устанавливаем порт для прослушивания
    Winsock1.LocalPort = 6574
    Winsock2.LocalPort = 6575
    'Начинаем прослушивать
    Winsock1.Listen
    Winsock2.Listen
    Timer1.Interval = 1000
End Sub
 
Private Sub txtSendData_KeyPress(KeyAscii As Integer)
'Если нажат Enter - отправляем данные
If KeyAscii = 13 Then cmdSendData_Click
End Sub
 
Private Sub Winsock1_Close()
'Закрываем соединение, если оно еще не закрыто
If Winsock1.State <> sckClosed Then Winsock1.Close
'Начинаем прослушивать еще раз
Winsock1.Listen
End Sub
 
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    'Останавливаем прослушивание
    '(Обязательно!)
    Winsock1.Close
    'Подключаем клиента
    Winsock1.Accept requestID
    'Очищаем лог разговора
    txtOutput.Text = "ЕСТЬ ПОДКЛЮЮЧЕНИЕ!!!"
    Shape1.BackColor = vbGreen
End Sub
 
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim s As String
    'Принимаем все данные
    Winsock1.GetData s, vbString
    'Записываем данные в лог разговора
    txtOutput.Text = txtOutput.Text & vbNewLine & "Клиент: " & s
    'Перемещаем курсор в конец лога
    txtOutput.SelStart = txtOutput.SelLength
End Sub
 
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description, vbCritical
    Winsock1_Close
End Sub
 
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
    'Останавливаем прослушивание
    '(Обязательно!)
    Winsock2.Close
    'Подключаем клиента
    Winsock2.Accept requestID
    connectionState = True
    'Очищаем лог разговора
    txtOutput.Text = txtOutput.Text & vbNewLine & "ЕСТЬ ПОДКЛЮЮЧЕНИЕ ДАННЫХ!!!"
    Shape2.BackColor = vbGreen
End Sub
 
Private Sub Winsock2_Close()
    'Закрываем соединение, если оно еще не закрыто
    If Winsock2.State <> sckClosed Then Winsock2.Close
    'Начинаем прослушивать еще раз
    Winsock2.Listen
End Sub
 
Private Sub Winsock2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description, vbCritical
    Winsock2_Close
End Sub
 
Private Sub cmdSendData2_Click()
    viewData = viewData - 1
End Sub
 
Private Sub cmdSendData3_Click()
    viewData = viewData + 1
End Sub
 
Private Sub DataResultMax()
        viewData = viewData + 0.3
    If viewData < 15 And viewData > 5 Then
        lbData.ForeColor = vbGreen
        lbData.Caption = CStr(viewData) + "°C"
    End If
    If viewData < 16.5 And viewData > 15 Then
        lbData.ForeColor = vbYellow
        lbData.Caption = CStr(viewData) + "°C"
    End If
    If viewData > 16.5 Then
        lbData.ForeColor = vbRed
        lbData.Caption = CStr(viewData) + "°C"
    End If
End Sub
 
Private Sub Timer1_Timer()
    DataResultMax
    If connectionState = True Then
        Winsock2.SendData CStr(viewData & vbCrLf)
    End If
End Sub
 
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
    'Dim s As String
    Dim i As Integer
    'Принимаем все данные
    Winsock2.GetData i, vbInteger
   'i = CInt(s)
    If i = 1 Then
        viewData = viewData - 1
    End If
    If i = 2 Then
        viewData = viewData + 1
    End If
    'Записываем данные в лог разговора
    txtOutput.Text = txtOutput.Text & vbNewLine & "Клиент: " & i
    'Перемещаем курсор в конец лога
    txtOutput.SelStart = txtOutput.SelLength
End Sub