//**************************************
    //     
    // Name: MaceNET - A fully functional Te
    //     lnet Client!!
    // Description:A fully functional Telnet
    //     Program designed to give you ease of use
    //     and solve your remote access problems.
    // By: Happy Lobster
    //
    // Assumes:'
    '....---' HERE'S WHAT TO DO '----....
    '| it may seem long but its worth it |
    '|___________________________________|
    '
    'Making MaceNET for yourself, sorted by ease of use:
    '
    '1. > Download the VB5 project from:
    '
    ' http:\\www.geocities.com\SiliconValley\Hub\3944\
    '
    ' It couldn't be simpler than that!
    '
    'or
    '
    '2. 
    '
    ' > Run NotePad 
    ' > Copy all the source code
    ' > Paste code into NotePad
    ' > Save file as Form1.frm
    ' > Use Visual Basic to view the form
    '
    ' or
    '3. > Add the following controls to a Form:
    ' Combo * 1
    ' Command Button * 7
    ' Frame * 1
    ' Label * 4
    ' Textbox * 2
    ' Timer * 1
    ' VScrollBar * 1
    ' Winsock * 1
    '
    '> With the frame, make these objects contained in it:
    '
    'Label1 - caption "Hostname:"
    'Combo1 - stores recent host names
    'Command1 - connects to the hostname
    'Text2 - multiline set to true, vscrolling enabled - logs events
    'Label2 - caption "Port:"
    'Text1 - is the port number to connect to
    'Command2 - disconnect button
    'Label4 - caption "Terminal:"
    'Command3 - text colour down
    'Command4 - text colour up
    'Command5 - background colour down
    'Command6 - background colour up
    'Command7 - Copy button
    '
    '> These should be on the form:
    '
    'Label3 - displays telnet text, set font to FixedSys
    '
    'Vscoll1 - controls label3 caption
    'Winsock1 - does the connecting
    'Timer1 - keeps track of resolve time
    '
    '> Copy the source code except the form's setup bit, and paste it in.
    '> Rearrange the objects to how you want them to appear
    '> Run
    '
    'All methods are tried and tested accessing a VAX with OpenVMS on a LAN, if u 'need help masonm@fhc.co.uk
    //
    // Side Effects:1. Tested on accessing a
    //     VAX computer running OpenVMS on a LAN
    2. Doesn't execute all control sequences
    //
    //This code is copyrighted and has    // limited warranties.Please see http://
    //     www.Planet-Source-Code.com/xq/ASP/txtCod
    //     eId.2024/lngWId.-10/qx/vb/scripts/ShowCo
    //     de.htm    //for details.    //**************************************
    //     
    
    VERSION 5.00
    Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
    Begin VB.Form Form1 
    BackColor = &H00C0C0C0;&
    Caption = "MaceNET"
    ClientHeight = 7485
    ClientLeft = 165
    ClientTop = 450
    ClientWidth = 10050
    BeginProperty Font 
    Name = "Fixedsys"
    Size = 9
    Charset = 0
    Weight = 400
    Underline = 0 'False
    Italic = 0 'False
    Strikethrough = 0 'False
    EndProperty
    KeyPreview = -1 'True
    LinkTopic = "Form1"
    ScaleHeight = 7485
    ScaleWidth = 10050
    StartUpPosition = 2 'CenterScreen
    Begin VB.Frame Frame1 
    Caption = "Telnet"
    Height = 1695
    Left = 0
    TabIndex = 2
    Top = 0
    Width = 9975
    Begin VB.ComboBox Combo1 
    Height = 345
    Left = 1440
    TabIndex = 15
    Text = "Combo1"
    Top = 240
    Width = 2175
    End
    Begin VB.CommandButton Command3 
    Caption = "-"
    Height = 375
    Left = 1440
    TabIndex = 11
    TabStop = 0 'False
    Top = 1200
    Width = 375
    End
    Begin VB.CommandButton Command4 
    Caption = "+"
    Height = 375
    Left = 1920
    TabIndex = 10
    TabStop = 0 'False
    Top = 1200
    Width = 375
    End
    Begin VB.CommandButton Command5 
    Caption = "-"
    Height = 375
    Left = 2520
    TabIndex = 9
    TabStop = 0 'False
    Top = 1200
    Width = 375
    End
    Begin VB.CommandButton Command6 
    Caption = "+"
    Height = 375
    Left = 3000
    TabIndex = 8
    TabStop = 0 'False
    Top = 1200
    Width = 375
    End
    Begin VB.Timer Timer1 
    Enabled = 0 'False
    Interval = 1000
    Left = 6120
    Top = 720
    End
    Begin VB.CommandButton Command7 
    Caption = "Copy"
    Height = 375
    Left = 3720
    TabIndex = 7
    TabStop = 0 'False
    Top = 1200
    Width = 1575
    End
    Begin VB.TextBox Text2 
    Height = 1335
    Left = 5400
    Locked = -1 'True
    MultiLine = -1 'True
    ScrollBars = 3 'Both
    TabIndex = 6
    Top = 240
    Width = 4215
    End
    Begin VB.CommandButton Command2 
    Caption = "&Disconnect;"
    Height = 375
    Left = 3720
    TabIndex = 5
    TabStop = 0 'False
    Top = 720
    Width = 1575
    End
    Begin VB.CommandButton Command1 
    Caption = "&Connect;"
    Height = 375
    Left = 3720
    TabIndex = 4
    TabStop = 0 'False
    Top = 240
    Width = 1575
    End
    Begin VB.TextBox Text1 
    Height = 330
    Left = 1440
    TabIndex = 3
    Top = 720
    Width = 2175
    End
    Begin MSWinsockLib.Winsock Winsock1 
    Left = 5640
    Top = 720
    _ExtentX = 741
    _ExtentY = 741
    End
    Begin VB.Label Label4 
    Caption = "Terminal:"
    Height = 255
    Left = 120
    TabIndex = 14
    Top = 1200
    Width = 1215
    End
    Begin VB.Label Label2 
    BackStyle = 0 'Transparent
    Caption = "Port:"
    Height = 255
    Left = 120
    TabIndex = 13
    Top = 720
    Width = 1095
    End
    Begin VB.Label Label1 
    BackStyle = 0 'Transparent
    Caption = "Host name:"
    Height = 255
    Left = 120
    TabIndex = 12
    Top = 240
    Width = 1455
    End
    End
    Begin VB.VScrollBar VScroll1 
    Height = 5655
    Left = 9720
    Max = 25
    TabIndex = 0
    Top = 1800
    Width = 256
    End
    Begin VB.Label Label3 
    BackColor = &H00000000;&
    Height = 5655
    Left = 0
    TabIndex = 1
    Top = 1800
    Width = 9615
    End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    'Below is the actual code
    '
    ' __ __ _ _ _____ _____
    ' | \/ | __ _ ___ ___| \ | | ____|_ _|
    ' | |\/| |/ _` |/ __/ _ \ \| | _| | |
    ' | | | | (_| | (_| __/ |\ | |___ | |
    ' |_| |_|\__,_|\___\___|_| \_|_____| |_|
    '
    'Created by M.Mason 9 June 1999
    'mailto: masonm@fhc.co.uk
    'For this program visit http:\\www.geocities.com\SiliconValley\Hub\3944\
    '
    Option Explicit 'We don't want any silly variables creating errors
    '---Terminal Information
    Dim Counter As Integer
    Dim SendChar As Integer
    Dim TotalText As String
    Dim TextColour As Integer
    Dim BackColour As Integer
    '---Terminal Constants
    Const BufferSize As Integer = 50
    Const ScreenSize As Integer = 25
    '---Host Information
    Dim HostCount As Integer
    Dim Host(20) As HostInfo
    Private Type HostInfo
    HostName As String
    Port As Long
    End Type
    '---Cursor Information
    Dim CurPos As Integer
    Dim DeleteMode As Boolean
    Dim CurShow As Boolean
    Dim LastPos As Integer
    Dim LastChar As String
    Private Sub Combo1_Click()
    With Combo1
    'If user clicks on a valid host then connect
    If .ListCount > 0 Then
    Text1 = Host(.ListIndex + 1).Port
    Command1_Click
    End If
    End With
    End Sub
    Sub UpdateHostInformation()
    'Updates the host variables from registry
    Dim HostNo As Integer
    HostCount = Val(GetSetting(App.Title, "HostInfo", "HostCounter", "0")) 'Get total no of hosts
    If HostCount > 0 Then 'If hosts stored add to combo
    For HostNo = 1 To HostCount
    'Get host name
    Host(HostNo).HostName = GetSetting(App.Title, "HostNames", Format(HostNo))
    'Get port number
    Host(HostNo).Port = Val(GetSetting(App.Title, "HostPorts", Format(HostNo)))
    Next
    End If
    End Sub
    Sub AddHostsToCombo()
    'Add host names to combo box
    Dim HostNo As Integer
    HostCount = Val(GetSetting(App.Title, "HostInfo", "HostCounter", "0")) 'Get total no of hosts
    Combo1.Clear 'Clear combo
    If HostCount > 0 Then 'If hosts stored add to combo
    For HostNo = 1 To HostCount
    'Add host name to combo
    Combo1.AddItem Host(HostNo).HostName
    Next
    End If
    End Sub
    Sub StoreNewHost()
    'Add's new host information to registry
    'Variable settings
    HostCount = HostCount + 1 'Increment total number of hosts
    Host(HostCount).HostName = Combo1.Text 'Store host name
    Host(HostCount).Port = Text1 'Store port value
    'Registry settings
    SaveSetting App.Title, "HostInfo", "HostCounter", Format(HostCount) 'Save host count
    SaveSetting App.Title, "HostNames", Format(HostCount), Combo1.Text 'Save host name
    SaveSetting App.Title, "HostPorts", Format(HostCount), Text1 'Save host port
    End Sub
    Private Sub Command1_Click()
    Dim StartTime As Date
    Dim HostNo As Integer
    Dim FoundHost As Boolean
    'Check text boxes aren't empty
    If Combo1.Text = "" Then
    Beep
    Combo1.SetFocus
    Exit Sub
    ElseIf Text1 = "" Then
    Beep
    Text1.SetFocus
    Exit Sub
    End If
    'Check if there is hosts in combo
    If HostCount > 0 Then
    FoundHost = False
    For HostNo = 1 To HostCount 'Look for host in list
    If UCase(Host(HostNo).HostName) = UCase(Combo1.Text) Then 'Found host?
    FoundHost = True 'Set flag
    Host(HostNo).Port = Text1 'Set host port
    SaveSetting App.Title, "HostPorts", Format(HostNo), Format(Text1) 'Save port change
    End If
    Next
    If FoundHost = False Then 'Has host been found in list
    'Add host to registry
    StoreNewHost
    End If
    Else
    'Add host to registry
    StoreNewHost
    End If
    'Wait cursor
    MousePointer = 13
    'Set the communication properties
    Winsock1.LocalPort = 0
    Winsock1.RemoteHost = Combo1.Text
    Winsock1.RemotePort = Text1
    'Add info to log
    AddLog "Connecting to: " & Combo1.Text & " Port " & Text1 & vbCrLf
    Winsock1.Connect
    AddLog "Connection."
    'Reset time counter
    Counter = 0
    'Enable status check
    Timer1.Enabled = True
    End Sub
    Private Sub Command2_Click()
    'Logoff button
    CloseConnection
    End Sub
    Private Sub Command3_Click()
    'Brightness down buton
    If TextColour > 0 Then
    TextColour = TextColour - 8
    ChangeColour TextColour, BackColour
    End If
    End Sub
    Private Sub Command4_Click()
    'Brightness up button
    If TextColour < 255 Then
    TextColour = TextColour + 8
    ChangeColour TextColour, BackColour
    End If
    End Sub
    Private Sub Command5_Click()
    'Contrast down
    If BackColour > 0 Then
    BackColour = BackColour - 8
    ChangeColour TextColour, BackColour
    End If
    End Sub
    Private Sub Command6_Click()
    'Contrast up button
    If BackColour < 255 Then
    BackColour = BackColour + 8
    ChangeColour TextColour, BackColour
    End If
    End Sub
    Sub ChangeColour(ByVal NewTextColour As Integer, ByVal NewBackColour As Integer)
    'Set terminal colours
    Label3.ForeColor = RGB(0, NewTextColour, 0)
    Label3.BackColor = RGB(NewBackColour, NewBackColour, NewBackColour)
    End Sub
    Private Sub Command7_Click()
    'Copy button
    With Clipboard
    .Clear
    .SetText TotalText
    End With
    End Sub
    Private Sub Form_KeyPress(KeyAscii As Integer)
    'Send Text if connected
    If Winsock1.State = 7 Then
    SendChar = KeyAscii
    Winsock1.SendData Chr(SendChar)
    End If
    End Sub
    Private Sub Form_Load()
    'Set initial colours
    TextColour = 128
    BackColour = 0
    ChangeColour TextColour, BackColour
    'Set object properties
    EnableConnect
    UpdateHostInformation
    'Add hosts to combo
    AddHostsToCombo
    Me.KeyPreview = True
    End Sub
    Private Sub Timer1_Timer()
    'Wait for host to be resolved
    'Inc Count
    Counter = Counter + 1
    AddLog "."
    'Client waiting to long, host not resolved
    If Counter >= 10 Then
    Winsock1.Close
    AddLog "Failed" & vbCrLf
    MousePointer = 0
    Timer1.Enabled = False
    End If
    End Sub
    Private Sub VScroll1_Change()
    'Updates the label view according to slider control
    Dim CurrentText As String
    Dim CRFound As Integer
    Dim Pos1 As Integer
    Dim Pos2 As Integer
    Dim A As Integer
    With Label3
    'Initial variables
    CurrentText = TotalText
    Pos1 = Len(CurrentText)
    Pos2 = 1
    CRFound = 0
    'Look for LFs
    For A = Len(CurrentText) - 1 To 1 Step -1
    If Mid(CurrentText, A, 1) = vbLf Then 'Found LF
    CRFound = CRFound + 1 'Inc number of LFs found
    If CRFound = VScroll1.Max - VScroll1.Value Then Pos1 = A + 1
    If CRFound = (VScroll1.Max - VScroll1.Value) + ScreenSize Then
    Pos2 = A + 1
    End If
    End If
    Next
    'Set new current label
    CurrentText = Mid(CurrentText, Pos2, (Pos1 - Pos2) + 1)
    Label3 = CurrentText
    End With
    End Sub
    Private Sub Winsock1_Close()
    CloseConnection
    End Sub
    Private Sub Winsock1_Connect()
    'Socket has connected with host
    AddLog "Successful" & vbCrLf
    'Disable timer
    Timer1.Enabled = False
    'Clear text box
    Label3.Caption = ""
    TotalText = Empty
    DeleteMode = False
    'Disable connect button
    DisableConnect
    'Restore mouse
    MousePointer = 0
    'Send beginning message
    Winsock1.SendData Chr(255) & Chr(251) & Chr(24) & vbCrLf
    End Sub
    Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim SockText As String
    Dim l As Integer
    Dim NewText As String
    Dim CRFound As Integer
    Dim LeftPos As Integer
    Dim A As Long
    Winsock1.GetData SockText, vbString
    'Disable delete mode if no text is returned
    If SockText = "" Then
    DeleteMode = False
    Exit Sub
    End If
    SockText = FindEscapeSeq(SockText)
    'Strip out unwanted characters
    NewText = Empty
    For A = 1 To Len(SockText)
    Select Case Asc(Mid(SockText, A, 1))
    Case 7 'Beep char
    Beep
    Case 0 To 9, 11 To 31, 128 To 255 'Unprintable control chars
    Case Else
    NewText = NewText + Mid(SockText, A, 1) 'Wanted chars
    End Select
    Next
    SockText = NewText
    'Calculates the invisible cursor position after BS has been pressed
    If SendChar = 8 Then
    DeleteMode = True
    If Len(TotalText) > 0 Then
    For A = 1 To Len(TotalText)
    If Mid(TotalText, A, 1) = vbLf Then
    CurPos = A + Len(SockText)
    End If
    Next
    End If
    Exit Sub
    ElseIf SendChar = 13 Then
    DeleteMode = False
    End If
    'Adds incoming text to Buffered Text variable at correct pos
    If DeleteMode = False Then
    TotalText = TotalText & SockText
    Else
    CurPos = CurPos + 1
    Mid(TotalText, CurPos, 1) = SockText
    If CurPos = Len(TotalText) Then DeleteMode = False
    End If
    'Ensures buffer zone is kept retaining BufferSize Number of lines
    If Len(TotalText) > 0 Then
    LeftPos = 0
    CRFound = 0
    For A = Len(TotalText) To 1 Step -1
    If Mid(TotalText, A, 1) = vbLf Then
    CRFound = CRFound + 1
    If CRFound = BufferSize + 1 Then
    LeftPos = A
    End If
    End If
    Next
    End If
    TotalText = Right(TotalText, Len(TotalText) - LeftPos)
    'Sets slider properties and updates caption
    With VScroll1
    If CRFound > ScreenSize Then
    If LeftPos > 0 Then
    .Max = BufferSize - ScreenSize
    Else
    .Max = CRFound - ScreenSize
    End If
    .Enabled = True
    .Value = .Max
    VScroll1_Change
    Else
    Label3.Caption = TotalText
    End If
    End With
    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)
    'Display Winsock Error
    MsgBox "A Winsock Error has occurred. Error No. " & Number & " " & Description
    End Sub
    Function FindEscapeSeq(ByVal TextInput As String) As String
    'Look for escape sequences
    Dim Pos As Integer
    Dim SeqLength As Integer
    Dim SeqText As String
    Pos = 0
    'Search for commands
    Do
    Pos = Pos + 1
    'Look for escape char
    If Mid(TextInput, Pos, 1) = Chr(27) Then
    'Reset
    SeqText = Empty
    Do
    Pos = Pos + 1
    SeqText = SeqText + Mid(TextInput, Pos, 1)
    If Mid(TextInput, Pos + 1, 1) = Chr(27) Then
    TermCommand SeqText 'Execute Command
    FindEscapeSeq = FindEscapeSeq + FindEscapeSeq(Right(TextInput, Len(TextInput) - (Pos)))
    Exit Function
    ElseIf Mid(TextInput, Pos + 1, 1) = Chr(13) Then
    TermCommand SeqText 'Execute command
    Exit Do
    End If
    If Pos = Len(TextInput) Then
    TermCommand SeqText
    Exit Do
    End If
    Loop
    Else
    FindEscapeSeq = FindEscapeSeq + Mid(TextInput, Pos, 1)
    End If
    If Pos = Len(TextInput) Then Exit Do
    Loop
    End Function
    Sub TermCommand(ByVal InCommand As String)
    'Sends response to escape seq command
    '
    'There are many Esc Sequences that terminal need to understand
    'but only the essentials ones are covered here
    '
    Dim OutCommand As String
    Select Case InCommand
    Case "[c" 'Server: What device are you?
    OutCommand = "[?1;2c" 'Terminal: I am a VT100 machine
    Case "[6n" 'Server: Gimme some cursor information
    OutCommand = "[25;80R" 'Terminal: Here's my cursor position
    Case Else 'Server: Unkown request
    Exit Sub 'Terminal: No reply
    End Select
    Winsock1.SendData Chr(27) + OutCommand
    End Sub
    Sub CloseConnection()
    'Close Socket connection
    Winsock1.Close
    AddLog "Connection to host lost" & vbCrLf
    MsgBox "Connection to host lost", vbInformation
    EnableConnect
    'Add hosts to combo box
    AddHostsToCombo
    End Sub
    Sub AddLog(LogEntry As String)
    'Add text to log
    With Text2
    .Text = .Text + LogEntry
    .SelStart = Len(.Text)
    End With
    Me.Refresh
    End Sub
    Sub EnableConnect()
    'Enable user to connect
    Command7.Enabled = False
    Command1.Enabled = True
    Command2.Enabled = False
    Combo1.Enabled = True
    Text1.Enabled = True
    VScroll1.Enabled = False
    End Sub
    Sub DisableConnect()
    'Disable user from connecting
    Command7.Enabled = True
    Command1.Enabled = False
    Command2.Enabled = True
    Combo1.Enabled = False
    Text1.Enabled = False
    End Sub