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 "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 |
Subject: [WIP] Telnet client
Last edited by Brent on Jan 11th, 2007, 8:49pm; edited 1 time in total
THE FOLLOWING CODE MAY NOT BE COMPLETE ENOUGH TO COMPILE.
Last edited by Brent on Jan 11th, 2007, 8:49pm; edited 1 time in total
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.
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.
Subject: Re: [WIP] Telnet client
This code is not compiling.
It has a missing WriteChar SUB.
It has a missing WriteChar SUB.
Subject: Re: [WIP] Telnet client
I'll add a disclaimer.
Page 1 of 1
You cannot post new topics in this forumYou 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