VB의 Winsock으로 Telnet프로그램 구현하려고 했는데...
신익권
로그인 프롬프트가 나타나는 것이 아니가
물음표(????)만 나타나고 아무런 작동이 되지
않습니다.
샘플프로그램은 http://www.planet-source-code.com/PlanetSourceCode/에서
가져온 것입니다.
파일이 잘 올려지지 않아서 아래에 적습니다.
==========================================================================
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
Icon = "MaceNET.frx":0000
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
' __ __ _ _ _____ _____
' | \/ | __ _ ___ ___| \ | | ____|_ _|
' | |\/| |/ _` |/ __/ _ \ \| | _| | |
' | | | | (_| | (_| __/ |\ | |___ | |
' |_| |_|\__,_|\___\___|_| \_|_____| |_|
'
'Created by M.Mason 9 June 1999
'mailto: mas...@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
'Show start up caption
MainCaption
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
Sub MainCaption()
'This code makes a title screen
Dim Title(25) As String
Dim A As Integer
'
' The program used to do the ASCII text below and at the
' beginning of this program is called FigWin
'
' Available from: http://st-www.cs.uiuc.edu/users/chai/figlet.html
'
'Set the title text in to array
Title(1) = String(80, "-")
Title(2) = ""
Title(3) = ". __ .
."
Title(4) = "/ | ___ | ___ __. , _ , _ ___
_/_ __."
Title(5) = "| | .' ` | .' ` .' \ |' `|' `. .' `
| .' \"
Title(6) = "| /\ / |----' | | | | | | | |----'
| | |"
Title(7) = "|,' \,' `.___, /\__ `._.' `._.' / ' / `.___,
\__/ `._.'"
Title(8) = ""
Title(9) = " _______ _______ _______ _______ _
_______ _________ "
Title(10) = " ( ) ( ___ ) ( ____ \ ( ____ \ ( ( /|
____ \ \__ __/"
Title(11) = " | () () | | ( ) | | ( \/ | ( \/ | \ ( | |
( \/ ) ("
Title(12) = " | || || | | (___) | | | | (__ | \ | | |
(__ | |"
Title(13) = " | |(_)| | | ___ | | | | __) | (\ \) | |
__) | |"
Title(14) = " | | | | | ( ) | | | | ( | | \ | |
( | |"
Title(15) = " | ) ( | | ) ( | | (____/\ | (____/\ | ) \ | |
(____/\ | |"
Title(16) = " |/ \| |/ \| (_______/ (_______/ |/ )_)
(_______/ )_("
Title(17) = ""
Title(18) = ""
Title(19) = " ______ __ __ _______ _______ _______ _______
_____ __ _"
Title(20) = " |_____] \_/ | | | | | | |_____| |______
| | | \ |"
Title(21) = " |_____] | | | | . | | | | | ______|
|_____| | \_|"
Title(22) = ""
Title(23) = ""
Title(24) = "mas...@fhc.co.uk"
Title(25) = String(80, "=")
'OR...
' Make a title screen in NotePad and use this code instead:
' Dim InputStr As String
' With Label3
' Open "c:\title.txt" For Input As #1
' Do While Not EOF(1)
' Line Input #1, InputStr
' .Caption = .Caption + InputStr + vbCrLf
' Loop
' Close #1
' End With
'Add title text to screen
With Label3
.Caption = ""
For A = 1 To 25
.Caption = .Caption & Title(A) & vbCrLf
Next
End With
End Sub
==========================================