Bay Six Software - [WIP] Telnet client

Bay Six Software
Beyond the Basics

Profile

[WIP] Telnet client

Bay Six Software Forum Index -> Internet Programming

View previous topic :: View next topic

Author

Message

Brent
Site Admin

Joined: 01 Jul 2005
Posts: 793

Posted: Jun 11th, 2006, 7:26pm Post subject: [WIP] Telnet client

THE FOLLOWING CODE MAY NOT BE COMPLETE ENOUGH TO COMPILE.

Code:

' Not Quite a Telnet Client
' By Brent D. Thorn, 5/2006
' PUBLIC DOMAIN

Global FALSE, TRUE
TRUE = Not(FALSE)

Global g.RawIn$, g.Escape$, g.bInEscape, g.ParseData$
Global g.bLogging

Global SUSP, ABORT, SE, NOP, DM, BREAK, IP, AO, AYT, EC, EL, GOAHEAD, SB
Global WILL, WONT, DODO, DONT, IAC

SUSP = 237: ABORT = 238: SE = 240: NOP = 241: DM = 242: BREAK = 243: IP = 244
AO = 245: AYT = 246: EC = 247: EL = 248: GOAHEAD = 249: SB = 250: WILL = 251
WONT = 252: DODO = 253: DONT = 254: IAC = 255

Global BIN, ECHO, RECONNECT, SGA, AMSN, STATUS, TIMING, RCTAN, OLW, OPS, OCRD
Global OHTS, OHTD, OFFD, OVTS, OVTD, OLFD, XASCII, LOGOUT, BYTEM, DET, SUPDUP
Global SUPDUPOUT, SENDLOC, TERMTYPE, EOR, TACACSUID, OUTPUTMARK, TERMLOCNUM
Global REGIME3270, X3PAD, NAWS, TERMSPEED, TFLOWCNTRL, LINEMODE, DISPLOC
Global ENVIRON, AUTHENTICATION, UNKNOWN39

BIN = 0: ECHO = 1: RECONNECT = 2: SGA = 3: AMSN = 4: STATUS = 5: TIMING = 6
RCTAN = 7: OLW = 8: OPS = 9: OCRD = 10: OHTS = 11: OHTD = 12: OFFD = 13
OVTS = 14: OVTD = 15: OLFD = 16: XASCII = 17: LOGOUT = 18: BYTEM = 19: DET = 20
SUPDUP = 21: SUPDUPOUT = 22: SENDLOC = 23: TERMTYPE = 24: EOR = 25: TACACSUID = 26
OUTPUTMARK = 27: TERMLOCNUM = 28: REGIME3270 = 29: X3PAD = 30: NAWS = 31
TERMSPEED = 32: TFLOWCNTRL = 33: LINEMODE = 34: DISPLOC = 35: ENVIRON = 36
AUTHENTICATION = 37: UNKNOWN39 = 39

Global main.fViews
Dim main.Char$(25), main.Attr$(25)

For i = 1 To 25
main.Char$(i) = Space$(80)
main.Attr$(i) = Space$(80)
Next

Global main.mnuConnection.Handle, main.mnuConnectionConnect.ID
Global main.mnuConnectionDisconnect.ID, main.mnuConnectionLogToFile.ID
Global main.mnuEdit.Handle, main.mnuEditPaste.ID
Global main.mnuView.Handle, main.mnuViewToolbar.ID
Global main.mnuViewStatusBar.ID

WindowWidth = 640
WindowHeight = 480
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)

Menu #main, _
"&Connection", _
"&Connect...", main.mnuConnctionConnect.Click, _
"&Disconnect", main.mnuConnectionDisconnect.Click, _
|, _
"&Log to File...", main.mnuConnectionLogToFile.Click, _
|, _
"E&xit", main.mnuConnectionExit.Click

Menu #main, _
"&Edit", _
"&Copy", main.mnuEditCopy.Click, _
"&Paste", main.mnuEditPaste.Click, _
|, _
"Select &All", main.mnuEditSelectAll.Click

Menu #main, _
"&View", _
"&Toolbar", main.mnuViewToolbar.Click, _
"&Status Bar", main.mnuViewStatusBar.Click, _
|, _
"&Font...", main.mnuViewFont.Click

Menu #main, _
"&Help", _
"&About Telnet...", main.mnuHelpAbout.Click

Open "Telnet" For Graphics_NSB As #main

Call main.GetMenuInfo

#main "TrapClose main.Close"

#main "Font Courier_New 8"
#main "Down; Fill Black; Flush"

Call main.ShowConnected FALSE

Wait

Sub main.Close Me$
Close #Me$

End
End Sub

Sub main.mnuConnctionConnect.Click
Call main.ShowConnected TRUE
End Sub

Sub main.mnuConnectionDisconnect.Click
Call main.ShowConnected FALSE
End Sub

Sub main.mnuConnectionLogToFile.Click
If g.bLogging = FALSE Then
' If not already logging, ask for a file name.
FileDialog "Log to File"+Chr$(0)+"Save", "*.log", file$

If file$ = "" Then Exit Sub

' Start logging.
Open file$ For Append As #logfile
Else
' Stop logging.
Close #logfile
End If

' Toggle variable and checkmark.
g.bLogging = Not(g.bLogging)

flags = IIf(g.bLogging, _MF_CHECKED, _MF_UNCHECKED)

CallDLL #user32, "CheckMenuItem", _
main.mnuConnection.Handle As ULong, _
main.mnuConnectionLogToFile.ID As ULong, _
flags As ULong, _
ret As Long
End Sub

Sub main.mnuConnectionExit.Click
Call main.Close "#main"
End Sub

Sub main.mnuEditCopy.Click
End Sub

Sub main.mnuEditPaste.Click
End Sub

Sub main.mnuEditSelectAll.Click
End Sub

Sub main.mnuViewToolbar.Click
End Sub

Sub main.mnuViewStatusBar.Click
End Sub

Sub main.mnuViewFont.Click
End Sub

Sub main.mnuHelpAbout.Click
End Sub

Sub main.GetMenuInfo
hWnd = HWnd(#main)

CallDLL #user32, "GetParent", _
hWnd As ULong, _
hWnd As ULong

CallDLL #user32, "GetMenu", _
hWnd As ULong, _
hMenu As ULong

' "Connection" menu
CallDLL #user32, "GetSubMenu", _
hMenu As ULong, _
0 As Long, _
main.mnuConnection.Handle As ULong

' "Connect" item
CallDLL #user32, "GetMenuItemID", _
main.mnuConnection.Handle As ULong, _
0 As Long, _
main.mnuConnectionConnect.ID As ULong

' "Disconnect" item
CallDLL #user32, "GetMenuItemID", _
main.mnuConnection.Handle As ULong, _
1 As Long, _
main.mnuConnectionDisconnect.ID As ULong

' "Log to File" item
CallDLL #user32, "GetMenuItemID", _
main.mnuConnection.Handle As ULong, _
3 As Long, _
main.mnuConnectionLogToFile.ID As ULong

' "Edit" menu
CallDLL #user32, "GetSubMenu", _
hMenu As ULong, _
1 As Long, _ ' "Edit" menu
main.mnuEdit.Handle As ULong

' "Paste" item
CallDLL #user32, "GetMenuItemID", _
main.mnuEdit.Handle As ULong, _
1 As Long, _
main.mnuEditPaste.ID As ULong

' "View" menu
CallDLL #user32, "GetSubMenu", _
hMenu As ULong, _
2 As Long, _ ' "View" menu
main.mnuView.Handle As ULong

' "Toolbar" item
CallDLL #user32, "GetMenuItemID", _
main.mnuView.Handle As ULong, _
0 As Long, _
main.mnuViewToolbar.ID As ULong

' "Status Bar" item
CallDLL #user32, "GetMenuItemID", _
main.mnuView.Handle As ULong, _
1 As Long, _
main.mnuViewStatusBar.ID As ULong
End Sub

Sub main.ShowConnected bConnected
fEnabled = _MF_ENABLED
fDisabled = _MF_DISABLED Or _MF_GRAYED

flags = IIf(bConnected, fDisabled, fEnabled)

CallDLL #user32, "EnableMenuItem", _
main.mnuConnection.Handle As ULong, _
main.mnuConnectionConnect.ID As ULong, _
flags As ULong, _
ret As Long

flags = IIf(bConnected, fEnabled, fDisabled)

CallDLL #user32, "EnableMenuItem", _
main.mnuConnection.Handle As ULong, _
main.mnuConnectionDisconnect.ID As ULong, _
flags As ULong, _
ret As Long

CallDLL #user32, "EnableMenuItem", _
main.mnuEdit.Handle As ULong, _
main.mnuEditPaste.ID As ULong, _
flags As ULong, _
ret As Long
End Sub

' Find the main window.
t$ = "Find me " + Str$(Time$("ms"))
TitleBar t$
CallDLL #user32, "FindWindowA", _
_NULL As Long, _
t$ As Ptr, _
hwndMainwin As ULong
TitleBar "Not Quite a Telnet Client"

' Prompt for host address and port.
Input "Enter host address: "; host$
If host$ = "" Then End
Input "Enter port number: "; port
If port < 1 Then End

' Using the following DLLs.
Open "WMLiberty.dll" For DLL As #wmlib
Open "ws2_32.dll" For DLL As #wsock

' Attempt to connect to the host.
sock = ConnectToHost(hwndMainwin, host$, port)

If sock <> -1 Then
' Wait for 30 seconds.
t = Time$("ms")
While Time$("ms") < t + 30000
Scan
CallDLL #kernel32, "Sleep", _
50 As Long, _
ret As Void
Wend
Else
' Print an error message.
e = WSAGetLastError()
Print "Error ";e;": ";GetWSAErrorString$(e)
End If

' Close out and clean up.
ret = closesocket(sock)
Call WSACleanup

Print
Print "CONNECTION CLOSED"

Close #wmlib
Close #wsock

End

Sub DoEvents
[localloop]
Do Until Len(g.RawIn$)
CallDLL #kernel32, "Sleep", _
50 As Long, _
ret As Void
Loop

cbIn = Len(g.RawIn$)
For i = 1 To cbIn
ch = Asc(Mid$(g.RawIn$, i, 1))
Select Case cmd
Case 0: cmd = ProcessChar(ch)
Case 1: cmd = IAC1(ch)
Case 2: cmd = IAC2(ch)
Case 3: cmd = IAC3(ch)
Case 4: cmd = IAC4(ch)
Case 5: cmd = IAC5(ch)
Case 6: cmd = IAC6(ch)
End Select
Next

g.RawIn$ = Mid$(g.RawIn$, cbIn + 1)

GoTo [localloop]
End Sub

Function IAC1 ( ch )
'TODO
Select Case ch
Case DODO
IAC1 = 2
Case DONT
IAC1 = 6
Case WILL
IAC1 = 3
Case WONT
IAC1 = 4
Case SB
IAC1 = 5
Case SE
Select Case Asc(g.ParseData$)
Case TERMTYPE
End Select
Case 255
Call WriteChar 255
End Select
End Function

Function IAC2 ( ch )
'TODO
Select Case ch
Case BIN
Call SendData Chr$(IAC) + Chr$(WONT) + Chr$(BIN)
Case ECHO
Call SendData Chr$(IAC) + Chr$(WONT) + Chr$(ECHO)
Case NAWS
g.bDoNAWS = TRUE
Call SendNAWS
Case SGA
If Not(g.IGoAhead) Then
Call SendData Chr$(IAC) + Chr$(WILL) + Chr$(SGA)
End If
Case TERMTYPE
If TERMTYPE$(g.TermSent) = "" Then g.TermSent = 0

Call SendData Chr$(IAC) + Chr$(WILL) + Chr$(TERMTYPE)
Call SendData Chr$(IAC) + Chr$(SB) + Chr$(TERMTYPE) + Chr$(0) + _
TERMTYPE$(g.TermSent) + Chr$(IAC) + Chr$(SE)
g.TermSent = g.TermSent + 1
Case Else
Call SendData Chr$(IAC) + Chr$(WONT) + Chr$(ch)
End Select
End Function

Function IAC3 ( ch )
End Function

Function IAC4 ( ch )
End Function

Function IAC5 ( ch )
End Function

Function IAC6 ( ch )
End Function

Function ProcessChar ( ch )
If g.bInEscape Then
Call ProcessEscape ch
Else
Select Case ch
Case 27
g.bInEscape = TRUE
g.Escape$ = ""
Case 255
ProcessChar = 1
Case Else
Call WriteChar ch
End Select
End If
End Function

Sub ProcessEscape ch
c$ = Chr$(ch)

If Len(g.Escape$) = 0 Then
If InStr("[()#cM", c$) Then
Else
If ch = 8 Or InStr("78DEHIZ", c$) > 0 Then
g.bInEscape = FALSE
Else
g.bInEscape = FALSE
Exit Sub
End If
End If
End If

g.Escape$ = g.Escape$ + c$

If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", c$) = 0 Then
If Len(g.Escape$) > 15 Then g.InEscape = FALSE

Exit Sub
End If

If InStr("ABCDHfr", c$) Then
g.Escape$ = Mid$(g.Escape$, 2)
Else
If ch = 109 Then 'm'
g.Escape$ = Mid$(g.Escape$, 2)

Do
Call SetAttrib Val(EscapeArg$(g.Escape$))
Loop While Len(g.Escape$)
End If
End If

g.InEscape = FALSE
g.Escape$ = ""
End Sub

Function EscapeArg$ ( ByRef a$ )
i = InStr(a$, ";")

If i = 0 Then
EscapeArg$ = a$
a$ = ""
Else
EscapeArg$ = Left$(a$, i - 1)
a$ = Mid$(a$, i + 1)
End If
End Function

Sub SetAttrib arg
Select Case
Case 0 = arg ' normal
' TODO
Case 1 = arg ' bold
' TODO
Case 3 = arg ' italic
' TODO
Case 4 = arg ' underline
' TODO
Case 5 = arg ' blinking
' TODO
Case 7 = arg ' reverse
' TODO
Case 8 = arg ' invisible
' TODO
Case 9 = arg ' strikethru
' TODO
Case 21 = arg ' double underline
' TODO
Case 22 = arg ' bold off
' TODO
Case 23 = arg ' italic off
' TODO
Case 24 = arg ' underline off
' TODO
Case 25 = arg ' blinking off
' TODO
Case 29 = arg ' strikethru off
' TODO
Case 30 <= arg And arg <= 37 ' fg color
' TODO
Case 39 = arg ' reset fg color
' TODO
Case 40 <= arg And arg <= 47 ' bg color
' TODO
Case 49 = arg ' reset bg color
' TODO
Case Else
' do nothing
End Select
End Sub

Function SockProc( hWnd, uMsg, sock, lParam )
Select Case LOWORD(lParam)
Case 1 'FD_READ
buf$ = Recv$(sock, 8192, 0)
While Len(buf$)
g.RawIn$ = g.RawIn$ + buf$

buf$ = Recv$(sock, 8192, 0)
Wend

Case 2 'FD_WRITE
'TODO

Case 16 'FD_CONNECT
Print "CONNECTED"

Case 32 'FD_CLOSE
buf$ = Recv$(sock, 8192, 0)
While Len(buf$)
Print buf$;

buf$ = Recv$(sock, 8192, 0)
Wend
End Select
End Function

Function ConnectToHost( hWnd, Host$, iPort )
ConnectToHost = -1
Call WinsockInit

If WSAStartup(MAKEWORD(2, 2)) <> 0 Then
Print "WSAStartup() error"
End If

sock = socket(2, 1, 6) 'AF_INET=2:SOCK_STREAM=1:IPPROTO_TCP=6

If sock = -1 Then
Print "socket() error"
Exit Function
End If

Call ResolveIP Host$

sockaddr.sinport.struct = htons(iPort)

Callback lpfnCB, SockProc( ULong, ULong, ULong, ULong ), Long
ret = SetWMHandler(hWnd, _WM_USER, lpfnCB, 1)

'FD_READ=1:FD_WRITE=2:FD_OOB=4:FD_ACCEPT=8:FD_CONNECT=16:FD_CLOSE=32
If WSAAsyncSelect(sock, hWnd, _WM_USER, 1 Or 2 Or 32) = -1 Then
Print "WSAAsyncSelect() error"
Exit Function
End If

If connect(sock) <> -1 Then
Print "connect() error"
Exit Function
End If

ConnectToHost = sock
End Function

Function GetWSAErrorString$( errnum )
Select Case errnum
Case 10004: e$ = "Interrupted system call."
Case 10009: e$ = "Bad file number."
Case 10013: e$ = "Permission Denied."
Case 10014: e$ = "Bad Address."
Case 10022: e$ = "Invalid Argument."
Case 10024: e$ = "Too many open files."
Case 10035: e$ = "Operation would block."
Case 10036: e$ = "Operation now in progress."
Case 10037: e$ = "Operation already in progress."
Case 10038: e$ = "Socket operation on nonsocket."
Case 10039: e$ = "Destination address required."
Case 10040: e$ = "Message too long."
Case 10041: e$ = "Protocol wrong type for socket."
Case 10042: e$ = "Protocol not available."
Case 10043: e$ = "Protocol not supported."
Case 10044: e$ = "Socket type not supported."
Case 10045: e$ = "Operation not supported on socket."
Case 10046: e$ = "Protocol family not supported."
Case 10047: e$ = "Address family not supported by protocol family."
Case 10048: e$ = "Address already in use."
Case 10049: e$ = "Can't assign requested address."
Case 10050: e$ = "Network is down."
Case 10051: e$ = "Network is unreachable."
Case 10052: e$ = "Network dropped connection."
Case 10053: e$ = "Software caused connection abort."
Case 10054: e$ = "Connection reset by peer."
Case 10055: e$ = "No buffer space available."
Case 10056: e$ = "Socket is already connected."
Case 10057: e$ = "Socket is not connected."
Case 10058: e$ = "Can't send after socket shutdown."
Case 10059: e$ = "Too many references: can't splice."
Case 10060: e$ = "Connection timed out."
Case 10061: e$ = "Connection refused."
Case 10062: e$ = "Too many levels of symbolic links."
Case 10063: e$ = "File name too long."
Case 10064: e$ = "Host is down."
Case 10065: e$ = "No route to host."
Case 10066: e$ = "Directory not empty."
Case 10067: e$ = "Too many processes."
Case 10068: e$ = "Too many users."
Case 10069: e$ = "Disk quota exceeded."
Case 10070: e$ = "Stale NFS file handle."
Case 10071: e$ = "Too many levels of remote in path."
Case 10091: e$ = "Network subsystem is unusable."
Case 10092: e$ = "Winsock DLL cannot support this application."
Case 10093: e$ = "Winsock not initialized."
Case 10101: e$ = "Disconnect."
Case 11001: e$ = "Host not found."
Case 11002: e$ = "Nonauthoritative host not found."
Case 11003: e$ = "Nonrecoverable error."
Case 11004: e$ = "Valid name, no data record of requested type."
Case Else: e$ = "Unknown error "; errnum; "."
End Select
GetWSAErrorString$ = e$
End Function

Function Recv$( s, buflen, flags )
Recv$ = Space$(buflen)+Chr$(0)
CallDLL #wsock, "recv", _
s As Long, _
Recv$ As Ptr, _
buflen As Long, _
flags As Long, _
buflen As Long
Recv$ = Left$(Recv$, buflen)
End Function

Sub ResolveIP Host$
addrinfo.aifamily.struct = 2 'AF_INET
addrinfo.aisocktype.struct = 1 'SOCK_STREAM
addrinfo.aiprotocol.struct = 6 'IPPROTO_TCP

Struct local1, paddrinfo As ULong

CallDLL #wsock, "getaddrinfo", _
Host$ As Ptr, _
_NULL As Long, _
_NULL As Long, _
local1 As Struct, _
ret As Long

pai = local1.paddrinfo.struct
lai = Len(addrinfo.struct)

CallDLL #kernel32, "RtlMoveMemory", _
addrinfo As Struct, _
pai As ULong, _
lai As Long, _
ret As Void

psa = addrinfo.aiaddr.struct
lsa = Len(sockaddr.struct)

CallDLL #kernel32, "RtlMoveMemory", _
sockaddr As Struct, _
psa As ULong, _
lsa As Long, _
ret As Void
End Sub

Sub WinsockInit
' Initializes structs used in Winsock calls.
Struct addrinfo, _
aiflags As Long, _
aifamily As Long, _
aisocktype As Long, _
aiprotocol As Long, _
aiaddrlen As Long, _
aicanonname As Ptr, _
aiaddr As ULong, _
ainext As ULong

Struct hostent, _
hname As Long, _
haliases As Long, _
haddrtype As Word, _
hlength As Word, _
haddrlist As Long

Struct sockaddr, _
sinfamily As Short, _
sinport As UShort, _
sinaddr As ULong, _
sinzero As Char[8]

Struct WSAData, _
wVersion As Word, _
wHighVersion As Word, _
szDescription As Char[257], _
szSystemStatus As Char[129], _
iMaxSockets As Word, _
iMaxUdpDg As Word, _
lpVendorInfo As Long
End Sub

Function closesocket( s )
CallDLL #wsock, "closesocket", _
s As Long, _
closesocket As Long
End Function

Function connect( s )
namelen = Len(sockaddr.struct)
CallDLL #wsock, "connect", _
s As Long, _
sockaddr As Struct, _
namelen As Long, _
connect As Long
End Function

Function htons( hostshort )
CallDLL #wsock, "htons", _
hostshort As Word, _
htons As Word
End Function

Function socket( af, type, protocol )
CallDLL #wsock, "socket", _
af As Long, _
type As Long, _
protocol As Long, _
socket As Long
End Function

Function WSAAsyncSelect( s, hWnd, wMsg, lEvent )
CallDLL #wsock, "WSAAsyncSelect", _
s As Long, _
hWnd As ULong, _
wMsg As ULong, _
lEvent As Long, _
WSAAsyncSelect As Long
End Function

Sub WSACleanup
CallDLL #wsock, "WSACleanup", _
r As Void
End Sub

Function WSAGetLastError()
CallDLL #wsock, "WSAGetLastError", _
WSAGetLastError As Long
End Function

Function WSAStartup( wVersionRequested )
CallDLL #wsock, "WSAStartup", _
wVersionRequested As Word, _
WSAData As Struct, _
WSAStartup As Long
End Function

Function SetWMHandler( hWnd, uMsg, lpfnCB, lSuccess )
CallDLL #wmlib, "SetWMHandler", _
hWnd As Long, _
uMsg As Long, _
lpfnCB As Long, _
lSuccess As Long, _
SetWMHandler As Long
End Function

[General_Purpose]

Function IIf ( Test, True, False )
If Test Then IIf = True Else IIf = False
End Function

Function LOWORD( dw )
LOWORD = (dw And 65535)
End Function

Function MAKEWORD( b1, b2 )
MAKEWORD = b1 Or (256 * b2)
End Function

_________________
Brent

Last edited by Brent on Jan 11th, 2007, 8:49pm; edited 1 time in total

Brent
Site Admin

Joined: 01 Jul 2005
Posts: 793

Posted: Jul 6th, 2006, 7:28pm Post subject: Re: [WIP] Telnet client

This update adds a GUI, but is unable to connect to a server. It also contains a start on Telnet protocol parsing for negotiations with the server. I'm partially translating the parser from an old MUD client I started in VB a few years ago, but never released a finished product. You can still find a review of it here. _________________ Brent

CryptoMan
Guest

Posted: Jan 11th, 2007, 5:09pm Post subject: Re: [WIP] Telnet client

This code is not compiling. It has a missing WriteChar SUB.

Brent
Site Admin

Joined: 01 Jul 2005
Posts: 793

Posted: Jan 11th, 2007, 8:47pm Post subject: Re: [WIP] Telnet client

I'll add a disclaimer. _________________ Brent

Display posts from previous:

	Bay Six Software Forum Index -> Internet Programming	All times are GMT
Page 1 of 1


	You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum You cannot attach files in this forum You can download files in this forum