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 #697
Posted by:
Posted on: 2026-06-04 20:19:57
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)
.SelBold = True
.SelColor = RGB(0, 0, 0)
.SelText = who & ":" & vbCrLf
.SelBold = False
RenderMarkdown Text
.SelText = vbCrLf & vbCrLf
.SelStart = Len(.Text)
.SelLength = 0
End With
End Sub
Private Sub RenderMarkdown(ByVal txt As String)
Dim i As Long
Dim p As Long
i = 1
While i <= Len(txt)
' **bold**
If Mid$(txt, i, 2) = "**" Then
p = InStr(i + 2, txt, "**")
If p > 0 Then
rtbOutput.SelBold = True
rtbOutput.SelText = Mid$(txt, i + 2, p - i - 2)
rtbOutput.SelBold = False
i = p + 2
Else
rtbOutput.SelText = Mid$(txt, i, 1)
i = i + 1
End If
' *italic*
ElseIf Mid$(txt, i, 1) = "*" Then
p = InStr(i + 1, txt, "*")
If p > 0 Then
rtbOutput.SelItalic = True
rtbOutput.SelText = Mid$(txt, i + 1, p - i - 1)
rtbOutput.SelItalic = False
i = p + 1
Else
rtbOutput.SelText = Mid$(txt, i, 1)
i = i + 1
End If
' `code`
ElseIf Mid$(txt, i, 1) = "`" Then
p = InStr(i + 1, txt, "`")
If p > 0 Then
rtbOutput.SelFontName = "Courier New"
rtbOutput.SelText = Mid$(txt, i + 1, p - i - 1)
rtbOutput.SelFontName = "MS Sans Serif"
i = p + 1
Else
rtbOutput.SelText = Mid$(txt, i, 1)
i = i + 1
End If
Else
rtbOutput.SelText = Mid$(txt, i, 1)
i = i + 1
End If
Wend
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
