Option Explicit

' --- Глобальные ---
Public OpenChats As Collection
Private ServerChat As FormChat
Private RightClickedNode As Node
Private BlinkContacts As Collection  ' коллекция контактов, которые мигают
Private BlinkState As Boolean        ' текущий цвет мигания (True = красный, False = черный)
Public WaitingForLogin As Boolean
Public ServerChatWindow As formChat

' ===== Автологин и текущий пользователь =====
Public LoginUser As String
Public LoginPass As String
Public LoggedUser As String


' ======== Form Load ========
Private Sub Form_Load()

    Set tvContacts.ImageList = ImageList1

    LoginUser = "a"
    LoginPass = "a"
    LoggedUser = ""

    Set OpenChats = New Collection
    Me.Caption = "Messenger"

    tvContacts.LineStyle = 0
    tvContacts.Indentation = 150

    ' ==== Загружаем контакты или создаём категорию General ====
    If Dir(App.Path & "\contacts.dat") <> "" Then
        LoadContacts
    Else
        Dim grpGeneral As Node
        Set grpGeneral = tvContacts.Nodes.Add(, , "general", "General (0)")
        grpGeneral.Bold = True
        grpGeneral.Expanded = True
        grpGeneral.Image = 1
        grpGeneral.SelectedImage = 1
    End If

    ' ==== Инициализация коллекции для мигающих контактов ====
    Set BlinkContacts = New Collection

    ' ==== Настройка таймера для мигания ====
    tmrBlink.Interval = 400  ' интервал мигания в миллисекундах
    tmrBlink.Enabled = True

    ' ===== AUTOCONNECT =====
    Dim autoConnect As Boolean
    LoadSettings autoConnect

    If autoConnect Then
        
        With frmLogin
            .Left = Me.Left + (Me.Width - .Width) / 2
            .Top = Me.Top + (Me.Height - .Height) / 2
            .Show vbModal
        End With
        
    End If

End Sub

Private Sub JoinConferenceAction()

    ' ===== Проверка авторизации =====
    If LoggedUser = "" Then
        
        With frmLogin
            .Left = Me.Left + (Me.Width - .Width) / 2
            .Top = Me.Top + (Me.Height - .Height) / 2
            .Show vbModal
        End With
        
    Else
        frmJoinConference.Show vbModal
    End If

End Sub

Private Sub mnuJoinConference_Click()
    JoinConferenceAction
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

    ' Если нажата вторая кнопка
    If Button.Index = 2 Then
        Call mnuAddContact_Click
    End If

    ' Если нажата четвёртая кнопка
    If Button.Index = 4 Then
        JoinConferenceAction
    End If

End Sub

' ======== Connect / Disconnect ========
Private Sub mnuConnect_Click()

    If Winsock1.State = sckClosed Then
        
        ' Центрируем форму frmLogin относительно Form1
        With frmLogin
            .Left = Form1.Left + (Form1.Width - .Width) / 2
            .Top = Form1.Top + (Form1.Height - .Height) / 2
            .Show vbModal
        End With
        
    Else
        
        Winsock1.Close
        mnuConnect.Caption = "Connect..."
        lblConnectionState.Caption = "Disconnected!"
    End If

End Sub

Private Sub mnuSettings_Click()
    frmSettings.Show vbModal
End Sub



' ==== Инициализация категорий при загрузке ====
Dim cat As Node
For Each cat In tvContacts.Nodes
    If cat.Parent Is Nothing Then
        cat.Bold = True
        cat.Expanded = True      ' раскрыта сразу
        cat.Image = 2            ' картинка для открытой категории
        cat.SelectedImage = 2
    End If
Next

Private Sub UpdateCategoryIcon(n As Node)

    If n Is Nothing Then Exit Sub
    If Not n.Parent Is Nothing Then Exit Sub

    If n.Expanded Then
        n.Image = 2          ' открытая папка
        n.SelectedImage = 2
    Else
        n.Image = 1          ' закрытая папка
        n.SelectedImage = 1
    End If

End Sub

' ===== Принудительное обновление картинки при разворачивании/сворачивании =====
Private Sub tvContacts_NodeExpand(ByVal Node As MSComctlLib.Node)
    UpdateCategoryIcon Node
End Sub

Private Sub tvContacts_NodeCollapse(ByVal Node As MSComctlLib.Node)
    UpdateCategoryIcon Node
End Sub

Private Sub UpdateCategoryCounts()
    Dim n As Node
    Dim childCount As Long
    
    For Each n In tvContacts.Nodes
        ' Только верхние узлы (категории)
        If n.Parent Is Nothing Then
            childCount = n.Children
            ' Убираем старые скобки
            If InStr(n.Text, "(") > 0 Then
                n.Text = Left$(n.Text, InStr(n.Text, "(") - 2)
            End If
            ' Добавляем новое количество
            n.Text = n.Text & " (" & childCount & ")"
        End If
    Next
End Sub

Private Sub tvContacts_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button <> vbLeftButton Then Exit Sub
    
    Dim n As Node
    Set n = tvContacts.SelectedItem
    If n Is Nothing Then Exit Sub
    
    ' Только категории
    If n.Parent Is Nothing Then
        
        ' Даём TreeView завершить разворот
        DoEvents
        
        If n.Expanded Then
            n.Image = 2
            n.SelectedImage = 2
        Else
            n.Image = 1
            n.SelectedImage = 1
        End If
        
    End If

End Sub

Private Sub tvContacts_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = vbRightButton Then
        
        ' Берём уже выбранный элемент
        Set RightClickedNode = tvContacts.SelectedItem
        
        If RightClickedNode Is Nothing Then Exit Sub
        
        ' ===== ЕСЛИ ЭТО КОНТАКТ =====
        If InStr(1, RightClickedNode.Key, "_contact_", vbTextCompare) > 0 Then
            
            mnuDeleteContact.Enabled = True
            mnuDeleteCategory.Enabled = False
            mnuAddCategory.Enabled = False
            mnuAddContact.Enabled = False
        
        Else
            ' ===== ЭТО КАТЕГОРИЯ =====
            mnuDeleteContact.Enabled = False
            mnuAddCategory.Enabled = True
            mnuAddContact.Enabled = True
            
            If RightClickedNode.Key <> "general" Then
                mnuDeleteCategory.Enabled = True
            Else
                mnuDeleteCategory.Enabled = False
            End If
        End If

        PopupMenu mnuContactsPopup
        
    End If

End Sub

Private Sub tvContacts_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then   ' Enter
        KeyAscii = 0
    End If

End Sub

Private Sub tvContacts_KeyDown(KeyCode As Integer, Shift As Integer)

    Dim n As Node
    Set n = tvContacts.SelectedItem
    If n Is Nothing Then Exit Sub

    Select Case KeyCode

        ' ===== ENTER =====
        Case vbKeyReturn

            ' ===== КОНТАКТ =====
            If Not n.Parent Is Nothing Then
                
                If InStr(1, n.Key, "_contact_", vbTextCompare) > 0 Then
                    
                    KeyCode = 0
                    
                    If Form1.LoggedUser = "" Then
                        With frmLogin
                            .Left = Form1.Left + (Form1.Width - .Width) / 2
                            .Top = Form1.Top + (Form1.Height - .Height) / 2
                            .Show vbModal
                        End With
                        Exit Sub
                    End If

                    OpenPrivateChat n.Text
                End If

            Else
                ' ===== КАТЕГОРИЯ =====
                
                ' Даем TreeView выполнить стандартное раскрытие
                DoEvents
                
                ' Принудительно обновляем иконку
                If n.Expanded Then
                    n.Image = 2
                    n.SelectedImage = 2
                Else
                    n.Image = 1
                    n.SelectedImage = 1
                End If
            End If

        ' ===== DELETE =====
        Case vbKeyDelete
            
            ' ----- КОНТАКТ -----
            If Not n.Parent Is Nothing Then
                
                If MsgBox("Delete contact '" & n.Text & "' ?", _
                          vbYesNo + vbQuestion) = vbYes Then
                    
                    tvContacts.Nodes.Remove n.Key
                    UpdateCategoryCounts
                    SaveContacts
                    
                End If

            ' ----- КАТЕГОРИЯ -----
            Else
                
                If n.Key = "general" Then
                    MsgBox "You cannot delete the General category!", vbExclamation
                    Exit Sub
                End If
                
                If MsgBox("Delete category '" & n.Text & "' ?", _
                          vbYesNo + vbQuestion) = vbYes Then
                    
                    tvContacts.Nodes.Remove n.Key
                    UpdateCategoryCounts
                    SaveContacts
                    
                End If
                
            End If

            KeyCode = 0

    End Select

End Sub


Private Sub tvContacts_DblClick()

    Dim n As Node
    Set n = tvContacts.SelectedItem
    
    If n Is Nothing Then Exit Sub
    
    ' Если категория — ничего
    If n.Parent Is Nothing Then Exit Sub
    
    ' Если контакт
    If InStr(1, n.Key, "_contact_", vbTextCompare) > 0 Then
        OpenPrivateChat n.Text
    End If

End Sub

Private Sub OpenPrivateChat(ByVal username As String)

    Dim frm As FormChat

    ' ===== Проверяем, открыт ли уже чат =====
    On Error Resume Next
    Set frm = OpenChats(username)
    On Error GoTo 0

    If Not frm Is Nothing Then
        frm.Show
        frm.SetFocus
        Exit Sub
    End If

    ' ===== Если не открыт — создаём =====
    Set frm = New FormChat
    frm.SetContact username

    OpenChats.Add frm, username
    frm.Show

End Sub


Private Sub mnuDeleteContact_Click()

    If RightClickedNode Is Nothing Then Exit Sub
    
    ' Убеждаемся что это контакт
    If RightClickedNode.Parent Is Nothing Then Exit Sub
    
    If MsgBox("Delete contact '" & RightClickedNode.Text & "' ?", _
              vbYesNo + vbQuestion) = vbYes Then
              
        tvContacts.Nodes.Remove RightClickedNode.Key
        UpdateCategoryCounts
        Set RightClickedNode = Nothing
        
    End If

    SaveContacts

End Sub

Private Sub mnuDeleteCategory_Click()

    If tvContacts.SelectedItem Is Nothing Then Exit Sub
    
    Dim n As Node
    Set n = tvContacts.SelectedItem
    
    ' Нельзя удалить general
    If n.Key = "general" Then
        MsgBox "You cannot delete the General category!", vbExclamation
        Exit Sub
    End If
    
    ' Проверяем что это категория (верхний уровень)
    If Not n.Parent Is Nothing Then Exit Sub
    
    If MsgBox("Delete category '" & n.Text & "' ?", _
              vbYesNo + vbQuestion) = vbNo Then Exit Sub
              
    tvContacts.Nodes.Remove n.Key
    UpdateCategoryCounts

    SaveContacts

End Sub

Private Sub mnuAddAContact_Click()
    mnuAddContact_Click
End Sub

Private Sub mnuAddContact_Click()
    Dim frm As frmSelectCategory
    Dim parentNode As Node
    Dim newKey As String
    Dim n As Node, childNode As Node
    Dim exists As Boolean
    
    ' --- Создаем форму выбора категории ---
    Set frm = New frmSelectCategory
    frm.FillCategories tvContacts
    frm.Show vbModal
    
    ' --- Если пользователь отменил ---
    If Not frm.Confirmed Then
        Unload frm
        Set frm = Nothing
        Exit Sub
    End If
    
    ' --- Проверка глобально, чтобы контакт с таким именем не существовал ---
    exists = False
    For Each n In tvContacts.Nodes
        If n.Parent Is Nothing Then ' категория
            Set childNode = n.Child
            Do While Not childNode Is Nothing
                If StrComp(childNode.Text, frm.ContactName, vbTextCompare) = 0 Then
                    exists = True
                    Exit Do
                End If
                Set childNode = childNode.Next
            Loop
        End If
        If exists Then Exit For
    Next
    
    If exists Then
        MsgBox "A contact with this name already exists!", vbExclamation
        Unload frm
        Set frm = Nothing
        Exit Sub
    End If
    
    ' --- Получаем выбранную категорию по ключу ---
    Set parentNode = tvContacts.Nodes(frm.SelectedCategoryKey)
    
    ' --- Создаем уникальный ключ ---
    newKey = parentNode.Key & "_contact_" & frm.ContactName
    Dim counter As Long
    counter = 1
    Do While NodeExists(newKey)
        newKey = parentNode.Key & "_contact_" & frm.ContactName & "_" & counter
        counter = counter + 1
    Loop
    
    ' --- Добавляем контакт ---
    tvContacts.Nodes.Add parentNode, tvwChild, newKey, frm.ContactName
    
    ' --- Обновляем счетчик контактов в категории ---
    UpdateCategoryCounts
    
    ' --- Сохраняем контакты ---
    SaveContacts
    
    ' --- Завершение ---
    Unload frm
    Set frm = Nothing
End Sub

Private Function NodeExists(key As String) As Boolean
    On Error Resume Next
    NodeExists = Not tvContacts.Nodes(key) Is Nothing
    On Error GoTo 0
End Function

' ===== Категории =====
Private Sub mnuAddCategory_Click()
    Dim frm As frmAddCategory
    Dim baseKey As String, newKey As String, counter As Long, newCat As Node
    
    ' --- Открываем форму добавления категории ---
    Set frm = New frmAddCategory
    frm.Show vbModal
    
    If Not frm.Confirmed Then
        Unload frm
        Set frm = Nothing
        Exit Sub
    End If
    
    ' --- Генерация уникального ключа ---
    baseKey = "category_" & frm.CategoryName
    newKey = baseKey
    counter = 1
    Do While NodeExists(newKey)
        newKey = baseKey & "_" & counter
        counter = counter + 1
    Loop
    
    ' --- Добавляем новую категорию ---
    Set newCat = tvContacts.Nodes.Add(, tvwFirst, newKey, frm.CategoryName & " (0)")
    With newCat
        .Bold = True
        .Expanded = True        ' категория сразу раскрыта
        .Image = 2              ' картинка для открытой категории
        .SelectedImage = 2
    End With
    
    ' --- Обновляем счётчики и сохраняем ---
    UpdateCategoryCounts
    SaveContacts
    
    Unload frm
    Set frm = Nothing
End Sub

Private Function ContactExists(ByVal username As String) As Boolean

    Dim n As Node
    Dim childNode As Node
    
    For Each n In tvContacts.Nodes
        If n.Parent Is Nothing Then
            Set childNode = n.Child
            Do While Not childNode Is Nothing
                If StrComp(childNode.Text, username, vbTextCompare) = 0 Then
                    ContactExists = True
                    Exit Function
                End If
                Set childNode = childNode.Next
            Loop
        End If
    Next
    
    ContactExists = False

End Function

Private Function ContactExistsNode(ByVal username As String) As Node
    Dim n As Node, childNode As Node
    For Each n In tvContacts.Nodes
        If n.Parent Is Nothing Then
            Set childNode = n.Child
            Do While Not childNode Is Nothing
                If StrComp(childNode.Text, username, vbTextCompare) = 0 Then
                    Set ContactExistsNode = childNode
                    Exit Function
                End If
                Set childNode = childNode.Next
            Loop
        End If
    Next
    Set ContactExistsNode = Nothing
End Function

Public Sub StartBlinkContact(n As Node)
    Dim i As Long
    Dim key As String
    key = n.Key
    
    ' Проверяем, есть ли уже в списке
    For i = 1 To BlinkContacts.Count
        If BlinkContacts(i)(0).Key = key Then
            ' Сбрасываем время окончания мигания на 3 секунды от Now
            BlinkContacts(i)(1) = DateAdd("s", 3, Now)
            Exit Sub
        End If
    Next i
    
    ' Добавляем Node и время окончания мигания
    Dim item(1) As Variant
    Set item(0) = n
    item(1) = DateAdd("s", 3, Now)  ' мигаем 3 секунды
    BlinkContacts.Add item
End Sub

' ==== Таймер мигания ====
Private Sub tmrBlink_Timer()
    Dim i As Long
    If BlinkContacts.Count = 0 Then Exit Sub
    
    BlinkState = Not BlinkState
    
    For i = BlinkContacts.Count To 1 Step -1
        Dim node As Node
        Dim endTime As Date
        
        Set node = BlinkContacts(i)(0)
        endTime = BlinkContacts(i)(1)
        
        ' Мигаем только если время еще не прошло
        If Now < endTime Then
            node.Bold = BlinkState
            If BlinkState Then
                node.ForeColor = vbRed     ' красный текст на "включённом" мигании
            Else
                node.ForeColor = vbBlack   ' черный текст на "выключенном" мигании
            End If
        Else
            ' Время вышло — убираем жирность и цвет, удаляем из списка
            node.Bold = False
            node.ForeColor = vbBlack
            BlinkContacts.Remove i
        End If
    Next i
End Sub

' ======== Connected ========
Private Sub Winsock1_Connect()

    mnuConnect.Caption = "Disconnect"
    
    ' ===== ОБНОВЛЯЕМ СТАТУС =====
    lblConnectionState.Caption = "Connected!"

    ' ===== ЛОГИН =====
    Dim loginCmd As String
    loginCmd = "/login " & LoginUser & " " & LoginPass

    Winsock1.SendData StringToUTF8(loginCmd & vbCrLf)

    LoggedUser = LoginUser

End Sub

' ======== Closed ========
Private Sub Winsock1_Close()

    mnuConnect.Caption = "Connect..."

    lblConnectionState.Caption = "Disconnected!"

End Sub

' ======== Data Arrival ========
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Dim data() As Byte
    Winsock1.GetData data, vbByte

    Dim msg As String
    msg = UTF8ToString(data)

    ' ===== НОРМАЛИЗАЦИЯ =====
    msg = Replace(msg, Chr(0), "")
    msg = Replace(msg, vbCrLf, vbLf)
    msg = Replace(msg, vbCr, vbLf)
    msg = Replace(msg, vbLf, vbCrLf)

    msg = Trim(msg)
    
    ' ===== Убираем лишние пустые строки в конце =====
    Do While Right$(msg, 2) = vbCrLf
        msg = Left$(msg, Len(msg) - 2)
    Loop
    msg = Trim(msg)
    
    If msg = "" Then Exit Sub

    ' ===== ПРОВЕРКА ЛОГИНА =====
    If WaitingForLogin Then
        If InStr(msg, "Invalid username or password.") > 0 Then
            MsgBox "Invalid username or password!", vbExclamation, "Login Error"
            frmLogin.txtPassword.Text = ""
            frmLogin.txtPassword.SetFocus
            frmLogin.cmdOK.Enabled = True
            WaitingForLogin = False
            Exit Sub
        ElseIf InStr(msg, "Login successful.") > 0 Then
            LoggedUser = frmLogin.txtUsername.Text
            Unload frmLogin
            WaitingForLogin = False
            
            ' Теперь можно открывать серверный чат
            Exit Sub
        End If
    End If

    ' ===== ОТВЕТЫ НА /PM =====
    If InStr(msg, "User does not exist.") > 0 Then
        MsgBox "User does not exist.", vbExclamation, "Private Message Error"
        Exit Sub
    End If

    If InStr(msg, "You cannot send private messages to yourself.") > 0 Then
        MsgBox "You cannot send private messages to yourself.", vbExclamation, "Private Message Error"
        Exit Sub
    End If

    If InStr(msg, " is banned.") > 0 Then
        MsgBox "Receiver is banned.", vbExclamation, "Private Message Error"
        Exit Sub
    End If

    If StrComp(Left$(msg, 34), "Failed to send private message to ", vbTextCompare) = 0 Then
        
        Dim failedUser As String
            
        failedUser = Mid$(msg, 35)   ' всё после "to "
        failedUser = Replace(failedUser, ".", "")
        failedUser = Trim$(failedUser)
            
        MsgBox "Failed to send private message to " & failedUser & ".", _
               vbExclamation, "Private Message Error"
            
        Exit Sub
    End If

    If StrComp(Left$(msg, 24), "Private message sent to ", vbTextCompare) = 0 Then
        Exit Sub
    End If

    Dim username As String
    Dim messageBody As String
    Dim pos As Long

    ' ===== PRIVATE MESSAGE =====
    If Left$(msg, 10) = "(Private) " Then
        
        Dim tmp As String
        tmp = Mid$(msg, 11)
        
        Dim p As Long
        p = InStr(tmp, ":")
        
        If p > 0 Then
            
            username = Left$(tmp, p - 1)
            messageBody = Mid$(tmp, p + 1)
            messageBody = Trim$(messageBody)
            
            ' Проверяем есть ли контакт
            Dim nNode As Node
            Set nNode = ContactExistsNode(username)
            If Not nNode Is Nothing Then
                OpenPrivateChat username
                Dim frm As FormChat
                Set frm = OpenChats(username)
                frm.ReceiveMessage username, messageBody
                frm.Show
                frm.SetFocus

                ' Добавляем в мигающие
                StartBlinkContact nNode
            End If
            
        End If
        
    End If
    
    pos = InStr(msg, ":")

    ' ===== ТАЙМШТАМП =====
    Dim ts As String
    ts = "[" & Format$(Now, "hh:nn:ss") & "] "


    ' ===== Проверка формата НИК: =====
    If pos > 0 Then
        username = Left$(msg, pos - 1)
        messageBody = Mid$(msg, pos + 1)
        messageBody = Trim(messageBody)
    End If

    If Not ServerChatWindow Is Nothing Then
        ' ===== Пропускаем приватные сообщения =====
        If Left$(msg, 10) = "(Private) " Then Exit Sub

        ' ===== Системные сообщения =====
        If Left$(msg, 4) = "*** " Then
            With ServerChatWindow.txtChat
                .SelStart = Len(.Text)
                .SelLength = 0
                
                ' Таймштамп
                .SelColor = RGB(150, 150, 150)
                .SelBold = False
                .SelText = ts
                
                ' Сообщение жирным черным
                .SelColor = vbBlack
                .SelBold = True
                .SelText = msg & vbCrLf
                .SelBold = False
                
                ' Скролл вниз
                .SelStart = Len(.Text)
                .SelLength = 0
            End With
            Exit Sub   ' больше не обрабатываем
        End If

        If pos > 0 Then
            Dim nick As String, body As String
            nick = Left$(msg, pos - 1)
            body = Mid$(msg, pos + 1)
            body = Trim(body)
            
            ' ===== Ник без пробелов =====
            If InStr(nick, " ") = 0 And nick <> "" Then
                With ServerChatWindow.txtChat
                    .SelStart = Len(.Text)
                    .SelLength = 0
                    
                    ' Таймштамп
                    .SelColor = RGB(150, 150, 150)
                    .SelBold = False
                    .SelText = ts
                    
                    ' Ник: синий, если наш, иначе красный
                    If nick = Form1.LoggedUser Then
                        .SelColor = vbBlue
                    Else
                        .SelColor = vbRed
                    End If
                    .SelBold = False
                    .SelText = "<" & nick & "> "
                    
                    ' Сообщение чёрным
                    .SelColor = vbBlack
                    .SelText = body & vbCrLf
                    
                    ' Скролл вниз
                    .SelStart = Len(.Text)
                    .SelLength = 0
                End With
            Else
                ' ===== Обычное серверное сообщение =====
                With ServerChatWindow.txtChat
                    .SelStart = Len(.Text)
                    .SelLength = 0
                    
                    ' Таймштамп
                    .SelColor = RGB(150, 150, 150)
                    .SelBold = False
                    .SelText = ts
                    
                    ' Текст чёрным
                    .SelColor = vbBlack
                    .SelBold = False
                    .SelText = msg & vbCrLf
                    
                    ' Скролл вниз
                    .SelStart = Len(.Text)
                    .SelLength = 0
                End With
            End If
        Else
            ' ===== Обычное серверное сообщение =====
            With ServerChatWindow.txtChat
                .SelStart = Len(.Text)
                .SelLength = 0
                
                ' Таймштамп
                .SelColor = RGB(150, 150, 150)
                .SelBold = False
                .SelText = ts
                
                ' Текст чёрным
                .SelColor = vbBlack
                .SelBold = False
                .SelText = msg & vbCrLf
                
                ' Скролл вниз
                .SelStart = Len(.Text)
                .SelLength = 0
            End With
        End If
    End If


End Sub
' ======== Отправка сообщений ========
Public Sub SendMessageToUser(ByVal username As String, ByVal message As String)

    If Winsock1.State = sckConnected Then
        Winsock1.SendData StringToUTF8(message & vbCrLf)
    End If

End Sub

' ======== UTF8 БЕЗ BOM ========
Public Function StringToUTF8(ByVal text As String) As Byte()

    Dim stm As Object
    Set stm = CreateObject("ADODB.Stream")

    stm.Type = 2
    stm.Charset = "utf-8"
    stm.Open
    stm.WriteText text
    stm.Position = 0
    stm.Type = 1

    Dim bytes() As Byte
    bytes = stm.Read

    stm.Close
    Set stm = Nothing

    ' --- Убираем BOM ---
    If UBound(bytes) >= 2 Then
        If bytes(0) = &HEF And bytes(1) = &HBB And bytes(2) = &HBF Then
            Dim tmp() As Byte
            ReDim tmp(UBound(bytes) - 3)

            Dim i As Long
            For i = 3 To UBound(bytes)
                tmp(i - 3) = bytes(i)
            Next

            StringToUTF8 = tmp
            Exit Function
        End If
    End If

    StringToUTF8 = bytes

End Function

Public Function UTF8ToString(ByRef bytes() As Byte) As String

    Dim stm As Object
    Set stm = CreateObject("ADODB.Stream")

    stm.Type = 1
    stm.Open
    stm.Write bytes
    stm.Position = 0
    stm.Type = 2
    stm.Charset = "utf-8"

    UTF8ToString = stm.ReadText

    stm.Close
    Set stm = Nothing

End Function

' ===========================
' ===== СОХРАНЕНИЕ ==========
' ===========================

Private Sub SaveContacts()

    Dim f As Integer
    f = FreeFile
    
    Open App.Path & "\contacts.dat" For Output As #f
    
    Dim n As Node
    
    For Each n In tvContacts.Nodes
        
        If n.Parent Is Nothing Then
            ' Категория
            Print #f, "C|" & n.Key & "|" & n.Text & "|"
        Else
            ' Контакт
            Print #f, "U|" & n.Key & "|" & n.Text & "|" & n.Parent.Key
        End If
        
    Next
    
    Close #f

End Sub

' ===========================
' ===== ЗАГРУЗКА ============
' ===========================

Private Sub LoadContacts()

    Dim path As String
    path = App.Path & "\contacts.dat"
    
    If Dir(path) = "" Then Exit Sub
    
    tvContacts.Nodes.Clear
    
    Dim f As Integer
    f = FreeFile
    Open path For Input As #f
    
    Dim line As String
    Dim parts() As String
    
    Do Until EOF(f)
    
        Line Input #f, line
        parts = Split(line, "|")
        
        If UBound(parts) < 2 Then GoTo ContinueLoop
        
        Dim typeNode As String
        Dim key As String
        Dim txt As String
        Dim parentKey As String
        
        typeNode = parts(0)
        key = parts(1)
        txt = parts(2)
        
        If typeNode = "C" Then
            Dim cat As Node
            Set cat = tvContacts.Nodes.Add(, tvwLast, key, txt)
            cat.Bold = True
            cat.Expanded = True
            cat.Image = 2            ' картинка для открытой категории
            cat.SelectedImage = 2
            
        ElseIf typeNode = "U" Then
            
            parentKey = parts(3)
            
            If NodeExists(parentKey) Then
                tvContacts.Nodes.Add parentKey, tvwChild, key, txt
            End If
            
        End If
        
ContinueLoop:
    Loop
    
    Close #f

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Dim f As Form
    For Each f In Forms
        If TypeOf f Is FormChat Then
            Unload f
        End If
    Next

End Sub


Private Sub mnuExit_Click()
    If MsgBox("Do you really want to exit?", vbYesNo + vbQuestion) = vbYes Then
        Unload Me
        End
    End If
End Sub

Private Sub mnuAutoConnect_Click()

    ' Переключаем галочку
    mnuAutoConnect.Checked = Not mnuAutoConnect.Checked
    
    ' Сохраняем состояние
    SaveSettings mnuAutoConnect.Checked

End Sub

Private Sub SaveSettings(ByVal autoConnect As Boolean)

    Dim f As Integer
    f = FreeFile
    
    Open App.Path & "\settings.dat" For Output As #f
        Print #f, CStr(autoConnect)
    Close #f

End Sub


' ===== ЗАГРУЗКА AUTOCONNECT =====
Private Sub LoadSettings(ByRef autoConnect As Boolean)

    Dim f As Integer
    Dim value As String
    
    If Dir(App.Path & "\settings.dat") = "" Then Exit Sub
    
    f = FreeFile
    Open App.Path & "\settings.dat" For Input As #f
        Line Input #f, value
    Close #f
    
    autoConnect = (LCase(value) = "true")

End Sub