'**************************************
' Name: MaceNET - A fully functional Tel
'     net 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, vscrolli
    '     ng enabled - logs events
    'Label2 - caption "Port:"
    'Text1 - is the port number to connect t
    '     o
    '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 fo
    '     rm's setup bit, and paste it in.
    '> Rearrange the objects to how you w
    '     ant them to appear
    '> Run
    '
    'All methods are tried and tested access
    '     ing a VAX with OpenVMS on a LAN, if u 'n
    '     eed 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://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=2024&lngWId;=1'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.geoci
'     ties.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 con
        '     nect

        If .ListCount > 0 Then
            Text1 = Host(.ListIndex + 1).Port
            Command1_Click
        End If

    End With

End Sub


Sub UpdateHostInformation()

    'Updates the host variables from registr
    '     y
    
    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 resolv
    '     ed

    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 sli
    '     der 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 retur
    '     ned

    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 positio
'     n 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 var
'     iable 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 B
'     ufferSize 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 capt
'     ion

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 termi
    '     nal need to understand
    'but only the essentials ones are covere
    '     d 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