Option Explicit

Dim g_strHostName As String
Dim g_strPortName As String
Dim g_bLocalEcho As Integer
Dim lastcolor
Dim lasttime
Public DefaultMudColor, DefaultMudBackcolor
Public DefaultComColor, DefaultComBackcolor
Public pstrDesc As String

Sub AddColText(ParseCol As String)

On Error Resume Next
Dim CcStart, CcEnd, cCode, bCode
Dim StartCcP, EndCcP, oldSel, OldLen ', LastColor
Dim AnsiBright As Boolean
Static strBroken As String

Dim strSndStart, strSndEnd, strCcode As String
Dim intSndStart, intSndEnd, intBroken As Integer
strSndStart = "!!SOUND("
strSndEnd = ")"

strCcode = (Chr(27) + "[0m")
CcStart = (Chr(27) + "[")
'CcStart = ".["
CcEnd = "m"
'LastColor = RGB(255, 255, 255)
'add broken code to begining of next output
If strBroken <> "" Then
    ParseCol = strBroken + ParseCol
    strBroken = ""
End If
'search the last 7 chars for broken codes
intBroken = InStr(Len(ParseCol) - 7, ParseCol, Chr(27))
If intBroken <> 0 Then
    strBroken = Right(ParseCol, Len(ParseCol) - (intBroken - 1))
    If strBroken = strCcode Then
        strBroken = ""
    Else
        ParseCol = Left(ParseCol, intBroken - 1)
    End If
End If

If ANSIstate = 1 Then

Do
    AnsiBright = False

    Textboxtmp.SelStart = Len(Textboxtmp.Text)
    Textboxtmp.SelColor = DefaultMudColor
    Textboxtmp.SelBold = False
    Textboxtmp.SelUnderline = False
    Textboxtmp.SelItalic = False
    
   
    Textboxtmp.SelLength = 0
    
    StartCcP = InStr(ParseCol, CcStart)
    If StartCcP < 1 Then
        Exit Do
        End If
    
    EndCcP = InStr(StartCcP, ParseCol, CcEnd)
    
    If EndCcP < 1 Then
        Exit Do
        End If
    cCode = Mid(ParseCol, StartCcP + Len(CcStart), 2)
    If EndCcP - StartCcP > 4 Then
        bCode = Mid(ParseCol, StartCcP + Len(CcStart), 1)
        cCode = Mid(ParseCol, StartCcP + Len(CcStart) + 2, 2)
        AnsiBright = True
    End If
    
    If lastcolor = 1 Then
        Textboxtmp.SelBold = True
    ElseIf lastcolor = 4 Then
        Textboxtmp.SelUnderline = True
    ElseIf lastcolor = 2 Then
        Textboxtmp.SelItalic = True
    Else
        Textboxtmp.SelColor = lastcolor
    End If
    
    Textboxtmp.SelText = Left(ParseCol, StartCcP - 1)
    If AnsiBright = False Then  'no brightness code
    lastcolor = retColorCode(cCode)
    Else    'if there is a brightness code
    lastcolor = retColorCode2(bCode, cCode)
    End If
    
    ParseCol = Mid(ParseCol, EndCcP + 1)
    
    'TextBox.SelStart = StartCcP
    'TextBox.SelLength = 0 ' Len(TextBox.Text)
    
    Loop
Else
    Textboxtmp.SelStart = Len(Textboxtmp.Text)
    Textboxtmp.SelColor = DefaultMudColor
    Textboxtmp.SelBold = False
    Textboxtmp.SelUnderline = False
    Textboxtmp.SelItalic = False
    Textboxtmp.SelLength = 0
End If
intSndStart = InStr(Textboxtmp.Text, strSndStart)
intSndEnd = InStr(Textboxtmp.Text, strSndEnd)
'If intSndStart > 0 And intSndEnd > intSndStart Then
'    Textboxtmp.SelStart = intSndStart - 1
'    Textboxtmp.SelLength = intSndEnd - intSndStart + 1
'    Textboxtmp.SelColor = RGB(195, 195, 195)
'End If

If triggers = 0 Then
If intSndStart > 0 And intSndEnd > intSndStart Then
    Textboxtmp.SelStart = intSndStart - 1
    Textboxtmp.SelLength = intSndEnd - intSndStart + 1
    Textboxtmp.SelColor = RGB(0, 255, 0)
    Else
    If triggers = 1 Then
    If intSndStart > 0 And intSndEnd > intSndStart Then
    Textboxtmp.SelStart = intSndStart - 1
    Textboxtmp.SelLength = intSndEnd - intSndStart + 1
    Textboxtmp.SelColor = RGB(195, 195, 195)
End If
End If
End If
End If


Textboxtmp.SelText = ParseCol
Textboxtmp.SelStart = Len(Textboxtmp.Text)

' TextBox.SelStart = oldSel
' TextBox.SelLength = OldLen

End Sub
Private Sub editViewport_KeyPress(KeyAscii As Integer)
    If Not sockTelnet.Connected Then
        KeyAscii = 0
    Else
        Dim byteBuffer(1) As Byte
        
        byteBuffer(0) = CByte(KeyAscii)
        sockTelnet.WriteBytes byteBuffer, 1
        
        If Not g_bLocalEcho Then KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
    'Initialize
    DefaultMudColor = RGB(255, 255, 255)
    DefaultComColor = RGB(255, 255, 255)
    menuConnect_Click
End Sub

Sub ShowError(ByVal strError As String)
    MsgBox strError, vbExclamation, "Telnet"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu And sockTelnet.Connected Then
        Dim nType As Integer
        nType = vbYesNo + vbQuestion
        If MsgBox("Do you wish to terminate this connection?", nType, "Telnet") = vbNo Then
            Cancel = True
            'Statusbar.Caption = "Disconnected"
        End If
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    editViewport.Move 100, 100, Me.ScaleWidth - 200, Me.ScaleHeight - 700
    editViewport.RightMargin = editViewport.Width - 400
    inputtext.Top = editViewport.Top + editViewport.Height
    inputtext.Width = editViewport.Width
    
    Statusbar.Top = editViewport.Top + editViewport.Height + 350
    Statusbar.Width = editViewport.Width
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If sockTelnet.Connected Then sockTelnet.Action = SOCKET_DISCONNECT
    Statusbar.Caption = "Disconnected"
End Sub

Private Sub Initialize()
    '
    ' Center the form
    '
    Me.Top = (Screen.Height / 2) - (Me.Height / 2)
    Me.Left = (Screen.Width / 2) - (Me.Width / 2)

    '
    ' Intialize global variables
    '
    g_strHostName = ""
    g_strPortName = ""
    g_bLocalEcho = False

    '
    ' Show the form and update the user interface
    '
    Me.Show
    UpdateForm
    menuConnect_Click
End Sub

Private Sub Inputtext_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyPageUp Or KeyCode = vbKeyPageDown Then
    editViewport.SetFocus
    KeyCode = 0
End If


End Sub

Private Sub inputtext_KeyPress(KeyAscii As Integer)
Dim sChar As String
Dim retval, foundi, i

        If KeyAscii = 13 Then
       'KeyAscii = 0
'        sChar = Chr$(KeyAscii)
'        Socket1.SendLen = Len(InputBox.Text)
            
                sChar = inputtext.Text + vbCrLf
                
            If sockTelnet.Connected Then
                 sockTelnet.Write sChar, Len(sChar)
            End If
            inputtext.AddItem inputtext.Text
          
            Dim Templist
            Templist = inputtext.List(inputtext.NewIndex)
            For i = inputtext.NewIndex To 0 Step -1
                inputtext.List(i) = inputtext.List(i - 1)
            Next i
            inputtext.List(0) = Templist
                        
            If inputtext.ListCount > 15 Then inputtext.RemoveItem 15
            inputtext.Text = ""
        End If
'KeyAscii = 0

End Sub


Private Sub menuConnect_Click()
    '
    ' Load the connection dialog that will prompt the
    ' user to enter the hostname or IP address and the
    ' port service name or number
    '
    'Load formConnect
    'formConnect.editHostName.Text = g_strHostName
    'formConnect.comboPort.Text = g_strPortName
    'formConnect.Show vbModal

    'If formConnect.Tag = "Cancel" Then
        'Unload formConnect
        'Exit Sub
    'End If

    'g_strHostName = Trim(formConnect.editHostName.Text)
    'g_strPortName = Trim(formConnect.comboPort.Text)
    'Unload formConnect

    '
    ' Initialize the socket control
    '
    g_strHostName = mdiMain.pstrIp
    g_strPortName = mdiMain.pstrPort
    
    sockTelnet.AutoResolve = False
    sockTelnet.Blocking = False
    sockTelnet.Binary = True
    sockTelnet.AddressFamily = AF_INET
    sockTelnet.Protocol = IPPROTO_TCP
    sockTelnet.SocketType = SOCK_STREAM

    On Error Resume Next: Err = 0
    sockTelnet.HostName = g_strHostName
    sockTelnet.RemoteService = g_strPortName
        
    '
    ' If the user enters an invalid service name, then
    ' an error will be generated; note that an invalid
    ' host name will cause the connection attempt to fail,
    ' but will not generate an error here
    '
    If Err <> 0 Then
        ShowError "The specified service name is invalid"
        Exit Sub
    End If

    '
    ' Initiate the connection. Because we are in non-
    ' blocking mode, the connection request is made and
    ' we immediately return to execute the next line of
    ' code; when the connection has actually been established,
    ' the Connect event will fire
    '
    sockTelnet.Action = SOCKET_CONNECT
    If Err <> 0 Then
        ShowError "Unable to connect to " & g_strHostName
        Exit Sub
    End If
        
    On Error GoTo 0
        
    '
    ' Set the Interval property so that the Timer event will
    ' fire after 60 seconds. This is how we handle connection
    ' timeouts with asynchronous connections; if the Timer
    ' event fires before the Connect event does, we simply
    ' close the connection and tell the user that we could
    ' not connect to the server
    '
    sockTelnet.Interval = 60000 ' 60 seconds
    
    '
    ' Update the user interface
    '
    formMain.MousePointer = vbHourglass
    'menuConnect.Enabled = False
    'menuDisconnect.Enabled = True
    editViewport.Text = ""
    
End Sub

Private Sub menuDisconnect_Click()
    '
    ' Terminate the connection and update the user interface
    '
    sockTelnet.Action = SOCKET_DISCONNECT
    Statusbar.Caption = "Disconnected"
    UpdateForm
End Sub

Private Sub menuExit_Click()
    Unload Me
End Sub

Private Sub menuLocalEcho_Click()
    g_bLocalEcho = Not g_bLocalEcho
    UpdateForm
End Sub

Private Sub sockTelnet_Connect()
    '
    ' A connection has been established with the server, so disable
    ' the timer by setting the interval to 0
    '
    sockTelnet.Interval = 0
    Statusbar.Caption = "Connected to " & g_strHostName
    editViewport.SelColor = RGB(255, 255, 255)
    formMain.MousePointer = vbDefault
    UpdateForm
End Sub

Private Sub sockTelnet_Disconnect()
    '
    ' The server has terminated the connection; make
    ' sure the timer is disabled by setting the interval
    ' to 0 and close the socket.
    '
    sockTelnet.Interval = 0
    sockTelnet.Action = SOCKET_DISCONNECT
    
    Statusbar.Caption = "Disconnected"
    UpdateForm
    MsgBox "Connection closed", vbInformation, "Telnet"
End Sub

Private Sub sockTelnet_Read(DataLength As Integer, IsUrgent As Integer)
    Dim sBuffer As String, sOutput As String, sReply As String
    Dim nRead As Integer, nIndex As Integer, nChar As Integer
    Dim nCmd As Integer, nOpt As Integer, nQual As Integer

    nRead = sockTelnet.Read(sBuffer, DataLength)

    nIndex = 1
    While nIndex <= nRead
        nChar = Asc(Mid$(sBuffer, nIndex, 1))
        '
        ' If this is the Telnet IAC (Is A Command) character, then
        ' the next byte is the command
        '
        If nChar = TELCMD_IAC Then
            nIndex = nIndex + 1: nCmd = Asc(Mid$(sBuffer, nIndex, 1))
            Select Case nCmd
            '
            ' Two IAC bytes means that this isn't really a command
            '
            Case TELCMD_IAC
                sOutput = sOutput + Chr$(nChar)
            '
            ' The SB (sub-option) command tells us that the server
            ' wants to negotiate. In this case, the only sub-option
            ' that we will deal with is the terminal type
            '
            Case TELCMD_SB
                nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
                nIndex = nIndex + 1: nQual = Asc(Mid$(sBuffer, nIndex, 1))
                If nOpt = TELOPT_TTYPE Then
                    '
                    ' Build a sub-option reply string and send it to
                    ' the server. In this case, we're saying that we are
                    ' a DEC VT100 terminal
                    '
                    sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_SB) + Chr$(nOpt) + Chr$(TELQUAL_IS) + "DEC-VT100" + Chr$(TELCMD_IAC) + Chr$(TELCMD_SE)
                    sockTelnet.Write sReply, Len(sReply)
                End If
            '
            ' The DO, DONT, WILL and WONT commands are sent by the server
            ' to tell us what it is capable (or not capable) of, and the
            ' options that it would like us to use; the next byte is the
            ' option code
            '
            Case TELCMD_DO, TELCMD_DONT, TELCMD_WILL, TELCMD_WONT
                nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
                Select Case nOpt
                '
                ' The only options that we'll deal with is binary mode,
                ' echo and terminal type
                '
                Case TELOPT_BINARY, TELOPT_ECHO, TELOPT_TTYPE
                    If nCmd = TELCMD_DO Then
                        sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WILL) + Chr$(nOpt)
                        sockTelnet.Write sReply, 3
                    ElseIf nCmd = TELCMD_WILL Then
                        sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DO) + Chr$(nOpt)
                        sockTelnet.Write sReply, 3
                    End If
                '
                ' For anything else, tell the server that we wont
                ' support it, or don't want the server to
                '
                Case Else
                    If nCmd = TELCMD_DO Then
                        sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WONT) + Chr$(nOpt)
                        sockTelnet.Write sReply, 3
                    ElseIf nCmd = TELCMD_WILL Then
                        sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DONT) + Chr$(nOpt)
                        sockTelnet.Write sReply, 3
                    End If
                End Select
            End Select
        Else
            If nChar <> 13 Then
            sOutput = sOutput + Chr$(nChar)
        End If
        End If
        nIndex = nIndex + 1
    Wend

    '
    ' Append the output to the edit control
    '
    If Len(sOutput) > 0 Then
'        TextBox.SelStart = 65535: TextBox.SelLength = 0
        Dim TempStart
'        TempStart = Len(TextBox.Text)
'        TextBox.Text = TextBox.Text + sOutput
'        ReplaceStringColors (TempStart)
        
        Textboxtmp.TextRTF = Textboxtmp.TextRTF + sOutput & Chr$(13)
        
        Dim OlSelstart, OlSellength
        
        SoundCheck (sOutput)
        AddColText (sOutput)
        
   '     Dim Soutput2, OutputLn
   '     Soutput2 = sOutput + vbCrLf
   '     Do While Soutput2 <> ""
   '         OutputLn = Left(Soutput2, InStr(Soutput2, vbCrLf) - 1)
   '         Soutput2 = Mid(Soutput2, InStr(Soutput2, vbCrLf) + 2)
   '         If OutputLn = "" Then OutputLn = Soutput2
            
            
   '     Loop
        
        
        
        editViewport.SelStart = Len(editViewport.TextRTF)
        editViewport.SelLength = 0
        editViewport.SelRTF = Textboxtmp.TextRTF
        Textboxtmp.TextRTF = ""
        editViewport.SelStart = Len(editViewport.TextRTF)
        End If
'        TextBox.SelStart = Len(TextBox.Text)
    'replace ANSI color codes with RTF colors
    
End Sub

Public Function retColorCode(ByVal cd As String)
'4 underlind 1 fat 2 Dark


Select Case Val(cd)
    Case 0 'for normal display
        retColorCode = RGB(240, 240, 240)
    Case 1 'for bold on
        retColorCode = 1
    Case 2 'for Dark on
        retColorCode = 2
    Case 4 ' underline (mono only)
        retColorCode = 4
    Case 5 ' blink on
        retColorCode = RGB(240, 240, 240)
    Case 7 'reverse video on
        retColorCode = RGB(240, 240, 240)
    Case 8 'nondisplayed (invisible)
        retColorCode = RGB(0, 0, 0)
    Case 30 'black foreground
        retColorCode = RGB(107, 107, 107)
    Case 31 'red foreground
        retColorCode = RGB(240, 0, 0)
    Case 32 'green foreground
        retColorCode = RGB(0, 240, 0)
    Case 33 'yellow foreground
        retColorCode = RGB(240, 240, 0)
    Case 34 'blue foreground
        retColorCode = RGB(0, 0, 240)
    Case 35 'magenta foreground
        retColorCode = RGB(240, 0, 240)
    Case 36 'cyan foreground
        retColorCode = RGB(0, 255, 255)
    Case 37 'white foreground
        retColorCode = RGB(240, 240, 240)
    Case 40 'black background
        retColorCode = "#FFFFFF"
    Case 41 'red background
        retColorCode = "#FFFFFF"
    Case 42 'green background
        retColorCode = "#FFFFFF"
    Case 43 'yellow background
        retColorCode = "#FFFFFF"
    Case 44 'blue background
        retColorCode = "#FFFFFF"
    Case 45 'magenta background
        retColorCode = "#FFFFFF"
    Case 46 'cyan background
        retColorCode = "#FFFFFF"
    Case 47 'white background
        retColorCode = "#FFFFFF"
End Select

End Function
Public Function retColorCode2(ByVal bd As String, ByVal cd As String)

If Val(bd) = 0 Then 'normal colors
Select Case Val(cd)
    Case 30 'black foreground
        retColorCode2 = RGB(0, 0, 0)
    Case 31 'red foreground
        retColorCode2 = RGB(170, 0, 0)
    Case 32 'green foreground
        retColorCode2 = RGB(0, 170, 0)
    Case 33 'yellow foreground
        retColorCode2 = RGB(204, 204, 0)
    Case 34 'blue foreground
        retColorCode2 = RGB(0, 0, 170)
    Case 35 'magenta foreground
        retColorCode2 = RGB(128, 0, 128)
    Case 36 'cyan foreground
        retColorCode2 = RGB(0, 85, 85)
    Case 37 'white foreground
        retColorCode2 = RGB(195, 195, 195)
End Select
Else    'light colors
Select Case Val(cd)
    Case 30 'black foreground
        retColorCode2 = RGB(107, 107, 107)
    Case 31 'red foreground
        retColorCode2 = RGB(240, 0, 0)
    Case 32 'green foreground
        retColorCode2 = RGB(0, 240, 0)
    Case 33 'yellow foreground
        retColorCode2 = RGB(255, 255, 0)
    Case 34 'blue foreground
        retColorCode2 = RGB(0, 0, 240)
    Case 35 'magenta foreground
        retColorCode2 = RGB(240, 0, 240)
    Case 36 'cyan foreground
        retColorCode2 = RGB(0, 240, 240)
    Case 37 'white foreground
        retColorCode2 = RGB(240, 240, 240)
End Select
End If
End Function


Private Sub sockTelnet_Timer()
    '
    ' The connection attempt has exceeded the number of milliseconds
    ' specified by the Interval property; disable the timer and
    ' close the connection
    '
    sockTelnet.Interval = 0
    sockTelnet.Action = SOCKET_DISCONNECT
    Statusbar.Caption = "Disconnected"
    ShowError "Unable to connect to " & g_strHostName
    UpdateForm
End Sub

Private Sub UpdateForm()
    If sockTelnet.State <> SOCKET_UNUSED Then
        'menuConnect.Enabled = False
        'menuDisconnect.Enabled = True
    Else
        'menuConnect.Enabled = True
        'menuDisconnect.Enabled = False
    End If

    If g_bLocalEcho Then
        'menuLocalEcho.Checked = True
    Else
        'menuLocalEcho.Checked = False
    End If

    formMain.MousePointer = vbDefault
End Sub


Public Function SoundCheck(strInput As String)
Dim strStart, strEnd, strWav, strPath As String
Dim intStart, intEnd As Integer
strStart = "!!SOUND("
strEnd = ".wav"
strPath = App.Path + "\muds\" + pstrDesc + "\sounds\"
intStart = InStr(strInput, strStart)
intEnd = InStr(strInput, strEnd)
If intStart > 0 And intEnd > intStart Then
    strWav = Mid(strInput, intStart + 8, intEnd - (intStart + 4))
    If Dir(strPath + strWav) = "" Then
    MsgBox strWav + " Not Found"
    Else
        Call sndPlaySound(strPath + strWav, &H1 Or &H2 Or &H10)
    End If
End If



End Function