UNKNOWN '************************************** 'Windows API/Global Declarations for :Ma ' ceNET - A fully functional Telnet Client ' !! '************************************** None - Winsock takes care of it '************************************** ' 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 ' ' ' Inputs:None ' ' Returns:None ' '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 Fo ' rm: ' Combo * 1 ' Command Button * 7 ' Frame * 1 ' Label * 4 ' Textbox * 2 ' Timer * 1 ' VScrollBar * 1 ' Winsock * 1 ' '> With the frame, make these objects co ' ntained 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 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 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 V ' AX computer running OpenVMS on a LAN 2. Doesn't execute all control sequences 'This code is copyrighted and has limite ' d warranties. 'Please see http://www.Planet-Source-Cod ' e.com/xq/ASP/txtCodeId.2024/lngWId.1/qx/ ' vb/scripts/ShowCode.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.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