Multiple-Connection Telnet Server (run as a service)
Put it all together - this program was compiled from a number of different articles on this service as well as a little modification of my own. It allows you to create a telnet server service to run commands or return data on your servers. Runs as a Windows NT/2000 service on Port 26 (by default) and even allows multiple users to be connected at once.
AI
AI-sammanfattning: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Källkod
Public strCommand As String Private Sub Form_Load() 'BE SURE TO READ THE "ASSUMES" SECTION ABOVE FIRST! objService.DisplayName = "Telnet Server Demo" objService.ServiceName = "telnetd" wsListen.LocalPort = 26 'This code is displayed if the user runs the program from 'the command-line. If Trim$(Command$) <> "" Then Select Case UCase$(Trim$(Command$)) Case "-INSTALL" If objService.Install Then MsgBox "Result: " & App.Title & " successfully installed as a Windows NT Service." & vbCrLf & "Service Name: " & objService.ServiceName, vbInformation, "Install Complete, Please Re-Start Application" Else MsgBox "Result: " & App.Title & " FAILED to installed as a Windows NT Service." & vbCrLf & "Service Name: " & objService.ServiceName & vbCrLf & vbCrLf & "Solutions: Check to see if the service is allready installed. If so, run " & App.EXEName & " -uninstall to remove it.", vbInformation, "Install Failed, Please Re-Start Application" End If End Case "-UNINSTALL" If objService.Uninstall Then MsgBox "Result: " & App.Title & " successfully uninstalled as a Windows NT Service." & vbCrLf & "Removed Service Name: " & objService.ServiceName, vbInformation, "UnInstall Complete, Please Re-Start Application" Else MsgBox "Result: " & App.Title & " FAILED to Uninstalled as a Windows NT Service." & vbCrLf & "Service Name: " & objService.ServiceName & vbCrLf & vbCrLf & "Solutions: Check to see if the service is installed. If not, run " & App.EXEName & " -install to install it.", vbInformation, "UnInstall Failed, Please Re-Start Application" End If End Case Else MsgBox "Valid Syntax: " & vbCrLf & vbCrLf & "-install To Install " & App.Title & " as a WinNT Service" & vbCrLf & vbCrLf & "-uninstall To UN-INSTALL " & App.Title & " from the WinNT Service List", vbInformation, "Invalid Syntax: Aborting Program Launch" End Select End If objService.ControlsAccepted = svcCtrlPauseContinue objService.StartService Me.Hide End Sub Private Sub objService_Start(Success As Boolean) 'This code is executed when the service is started On Error GoTo ErrHandler Success = True wsListen.Listen Exit Sub ErrHandler: 'If service fails, write an event to the system log. Call objService.LogEvent(svcMessageError, svcEventError, "[" & _ Err.Number & "] " & Err.Description) Resume Next End Sub Private Sub wsArray_DataArrival(Index As Integer, ByVal bytesTotal As Long) 'This code determinds what to do based on user input Dim strData(100) As String On Error GoTo ErrorHandler 'Get the current character user typed wsArray(Index).GetData strData(Index), vbString, bytesTotal If strData(Index) = vbCrLf Or strData(Index) = vbCr Then Select Case UCase(wsArray(Index).Tag) Case "RANDOM" 'Display a random number wsArray(Index).SendData vbCrLf & Rnd(1) * 100 & vbCrLf Case "TIME" 'Display the current time wsArray(Index).SendData vbCrLf & Time() & vbCrLf Case "HELP" wsArray(Index).SendData vbCrLf Call ShowMenu(Index) Case "QUIT" wsArray(Index).Tag = "" wsArray(Index).Close Exit Sub End Select wsArray(Index).Tag = "" wsArray(Index).SendData vbCrLf & "=> " ElseIf Asc(strData(Index)) = 8 Then 'Backspace was pressed If Not wsArray(Index).Tag = "" Then 'Remove one character from current input wsArray(Index).Tag = Left(wsArray(Index).Tag, Len(wsArray(Index).Tag) - 1) 'Move the cursor back one space wsArray(Index).SendData Chr(8) & " " & Chr(8) End If Else 'This represents the current command. The current command is 'each character the user types in until the user presses the 'enter key. wsArray(Index).Tag = wsArray(Index).Tag & strData(Index) 'This ECHOs the character back to the user wsArray(Index).SendData strData(Index) End If Exit Sub ErrorHandler: 'Display an error if one occurs Dim ErrDesc As String wsArray(Index).SendData vbCrLf & Err.Description & vbCrLf wsArray(Index).SendData vbCrLf & "=> " wsArray(Index).Tag = "" End Sub Private Sub wsListen_ConnectionRequest(ByVal requestID As Long) 'This listens for a connection and finds an open socket Dim Index As Integer Index = FindOpenWinsock wsArray(Index).Accept requestID Call ShowMenu(Index) wsArray(Index).SendData "=> " End Sub Private Sub ShowMenu(Index As Integer) 'This sends the menu. We used (Index) in every instance of 'socket array because we want the data send to the appropriate 'user, in case more than one person is connected. wsArray(Index).SendData "+-[Commands]--------------------+" & vbCrLf wsArray(Index).SendData "| RANDOM - Display random |" & vbCrLf wsArray(Index).SendData "| TIME - Show system time |" & vbCrLf wsArray(Index).SendData "| HELP |" & vbCrLf wsArray(Index).SendData "| QUIT |" & vbCrLf wsArray(Index).SendData "+-------------------------------+" & vbCrLf & vbCrLf End Sub Private Function FindOpenWinsock() 'This function finds the next open socket, allowing your program 'to accept more than one connection Static LocalPorts As Integer 'Find open socket For X = 0 To wsArray.UBound If wsArray(X).State = 0 Then FindOpenWinsock = X Exit Function End If Next X 'None are open so let's make one Load wsArray(wsArray.UBound + 1) 'Let's make sure we don't get conflicting local ports LocalPorts = LocalPorts + 1 wsArray(wsArray.UBound).LocalPort = wsArray(wsArray.UBound).LocalPort + LocalPorts FindOpenWinsock = wsArray.UBound End Function
Originalkommentarer (3)
Återställd från Wayback Machine