This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Paste #696

Posted by:
Posted on: 2026-06-04 20:16:59
Age: 10 days ago
Views: 24

Option Explicit

Private Sub Form_Load()

    rtbOutput.Locked = True
    rtbOutput.Text = ""

End Sub


Private Sub btnSend_Click()
    SendMessage
End Sub


Private Sub txtInput_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then
        KeyAscii = 0
        SendMessage
    End If

End Sub


Private Sub SendMessage()

    Dim http As Object
    Dim stream As Object
    Dim url As String
    Dim msg As String
    Dim response As String

    msg = txtInput.Text
    If msg = "" Then Exit Sub

    AddLine "You", msg

    url = "http://10.41.1.3:8543/chat?msg=" & URLEncode(msg)

    On Error GoTo errh

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", url, False
    http.Send

    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 1
    stream.Open
    stream.Write http.responseBody
    stream.Position = 0
    stream.Type = 2
    stream.Charset = "windows-1251"

    response = stream.ReadText

    stream.Close

    AddLine "AI", response

    txtInput.Text = ""

    Exit Sub

errh:
    AddLine "AI", "connection error"

End Sub


Private Sub AddLine(ByVal who As String, ByVal Text As String)

    With rtbOutput

        .SelStart = Len(.Text)

        If who = "You" Then
            .SelBold = True
            .SelColor = RGB(0, 0, 255)
            .SelText = "You: "
            .SelBold = False
        Else
            .SelBold = True
            .SelColor = RGB(200, 0, 0)
            .SelText = "AI: "
            .SelBold = False
        End If

        .SelColor = RGB(0, 0, 0)
        .SelText = Text & vbCrLf

        ' Автопрокрутка вниз
        .SelStart = Len(.Text)
        .SelLength = 0

    End With

End Sub


Private Function URLEncode(ByVal Text As String) As String

    Dim stream As Object
    Dim bytes() As Byte
    Dim i As Long
    Dim result As String

    Set stream = CreateObject("ADODB.Stream")

    stream.Type = 2
    stream.Charset = "utf-8"
    stream.Open
    stream.WriteText Text
    stream.Position = 0

    stream.Type = 1
    bytes = stream.Read

    stream.Close

    For i = 0 To UBound(bytes)

        Select Case bytes(i)
            Case 48 To 57, 65 To 90, 97 To 122
                result = result & Chr(bytes(i))
            Case 45, 46, 95, 126
                result = result & Chr(bytes(i))
            Case Else
                result = result & "%" & Right("0" & Hex(bytes(i)), 2)
        End Select

    Next i

    URLEncode = result

End Function

Download raw | Create new paste

Recent Posts

Paste #696