 |
Bay Six Software Beyond the Basics
|
View previous topic :: View next topic |
Author |
Message |
Brent Site Admin
Joined: 01 Jul 2005 Posts: 790
|
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 |
|
Back to top |
|
 |
Brent Site Admin
Joined: 01 Jul 2005 Posts: 790
|
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 |
|
Back to top |
|
 |
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. |
|
Back to top |
|
 |
Brent Site Admin
Joined: 01 Jul 2005 Posts: 790
|
Posted: Jan 11th, 2007, 8:47pm Post subject: Re: [WIP] Telnet client |
|
|
I'll add a disclaimer. _________________ Brent |
|
Back to top |
|
 |
|
|
|
|
|
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
|
|
|