to cloudyly() 已发送,包括TELNET的服务端和客户端,只是个示例代码,比较简陋,自己好好研究研究,写出更好的:)
Private Sub Form_Load() lstStatus.Clear gsLogin = frmLogin.txtLogin.Text gsPWD = frmLogin.txtPassword.Text End SubPrivate Sub Form_Unload(Cancel As Integer) End End SubPublic Sub cmdStart_Click() If gsLogin = "" Or gsPWD = "" Then frmLogin.Show vbModal Exit Sub End If
If cmdStart.Caption = "Start" Then lstStatus.AddItem "Telnet Server start at " & Now lstStatus.AddItem " - On " & Winsock1.LocalHostName & ": " & Winsock1.LocalIP & " Port 23" cmdStart.Caption = "Reset" cmdTelnet.Enabled = True Else lstStatus.AddItem "Telnet Server Restart at " & Now cmdTelnet.Enabled = False End If
blnLogin = False blnEnter = False strLogin = "" strPassword = "" End Sub Private Sub mnuStart_Click() If mnuStart.Caption = "S&tart" Then mnuStart.Caption = "S&top" cmdStart_Click cmdTelnet.Enabled = True Else mnuStart.Caption = "S&tart" Winsock1.Close cmdStart.Caption = "Start" cmdTelnet.Enabled = False lstStatus.AddItem "Telnet Server Stop at " & Now lstStatus.Selected(lstStatus.ListCount - 1) = True End If End SubPrivate Sub mnuClear_Click() lstStatus.Clear End SubPrivate Sub mnuLogin_Click() frmLogin.Show vbModal End SubPrivate Sub mnuExit_Click() Unload Me End SubPrivate Sub cmdExit_Click() Unload Me End Sub
Private Sub mnuSave_Click() Dim i As Integer Dim iFile As Integer iFile = FreeFile Open App.Path & "\log.log" For Append As #iFile Print #iFile, vbCrLf & " -- " & Time & " --" For i = 0 To lstStatus.ListCount - 1 Print #iFile, lstStatus.List(i) Next i Close #iFile MsgBox "Log file has been saved.", vbInformation End Sub Private Sub cmdTelnet_Click() Shell "telnet " & Winsock1.LocalIP, vbNormalFocus End Sub Public Sub Winsock1_ConnectionRequest(ByVal requestID As Long) With Winsock1 If .State <> sckClosed Then .Close .Accept requestID .SendData "Trying " & .LocalIP & "..." & vbCrLf .SendData "Connected to " & .LocalIP & "." & vbCrLf .SendData "Escape character is '^]'." & vbCrLf & vbCrLf .SendData "Welcome to Telnet Server: " & .LocalHostName & " " & .LocalIP & " Port: " & .LocalPort & vbCrLf & vbCrLf .SendData "Connect from: " & .RemoteHostIP & " at " & Now & vbCrLf & vbCrLf .SendData "Login: " lstStatus.AddItem "Attempt to connect from " & .RemoteHostIP & ":" & .RemotePort & " - " & Now End With lstStatus.Selected(lstStatus.ListCount - 1) = True End Sub Public Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim i As Integer Winsock1.GetData strData If Not blnLogin Then If blnEnter = False Then If strData <> vbCrLf Then strLogin = strLogin & strData Winsock1.SendData strData Else blnEnter = True Winsock1.SendData vbCrLf & "Password: " Exit Sub End If Else If strData <> vbCrLf Then strPassword = strPassword & strData Winsock1.SendData "" Else If strLogin = gsLogin And strPassword = gsPWD Then blnLogin = True gsPrompt = strLogin & "@" & Winsock1.RemoteHostIP & "\> " ShowWelcomeMenu lstStatus.AddItem " - Login OK" lstStatus.Selected(lstStatus.ListCount - 1) = True Exit Sub Else lstStatus.AddItem "- Login Failed From Login: " & strLogin & " - Password: " & strPassword lstStatus.Selected(lstStatus.ListCount - 1) = True
blnEnter = False strLogin = "" strPassword = "" Exit Sub End If End If End If Else If strData = vbCrLf Then Select Case gsCommand Case "?" lstStatus.AddItem " - help command requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True ShowHelpMenu gsCommand = "" Exit Sub Case "help" lstStatus.AddItem " - help command requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True
ShowHelpMenu gsCommand = "" Exit Sub Case "exit" lstStatus.AddItem " - " & gsLogin & " logout at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True cmdStart_Click gsCommand = "" Exit Sub Case "date" lstStatus.AddItem " - date command requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True Winsock1.SendData vbCrLf & vbCrLf & " Server Date: " & Format(Date, "Ddd, mmm d yyyy") & vbCrLf Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub Case "time" lstStatus.AddItem " - time command requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True Winsock1.SendData vbCrLf & vbCrLf & " Server Time: " & Time & vbCrLf Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub Case "log" lstStatus.AddItem " - view Telnet Server log requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True Winsock1.SendData vbCrLf For i = 0 To lstStatus.ListCount - 1 Winsock1.SendData " " & lstStatus.List(i) & vbCrLf Next i Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub Case "restart" lstStatus.AddItem " - telnet server restart requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True cmdStart_Click gsCommand = "" Exit Sub Case "system" lstStatus.AddItem " - system information requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True GetSystemInformation gsCommand = "" Exit Sub Case "lptest" lstStatus.AddItem " - lptest command requested by " & gsLogin & " at " & Time lstStatus.Selected(lstStatus.ListCount - 1) = True Shell "rundll32.exe msprint2.dll,RUNDLL_PrintTestPage" With Winsock1 .SendData vbCrLf & " Server test page has been printed." & vbCrLf & vbCrLf & gsPrompt End With gsCommand = "" Exit Sub Case Else If Left(gsCommand, 3) = "man" Then If Trim(gsCommand) = "man" Then Winsock1.SendData vbCrLf & "Syntax: man <command>" & vbCrLf Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub Else strCommand = Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand))) End If
ManPage (strCommand) DoEvents
gsCommand = "" Exit Sub End If
If Left(gsCommand, 3) = "run" Then If Trim(gsCommand) = "run" Then Winsock1.SendData vbCrLf & "Syntax: run <file name>" & vbCrLf Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub End If
RunProgram (gsCommand) DoEvents gsCommand = "" Exit Sub End If If Left(gsCommand, 3) = "cat" Then If Trim(gsCommand) = "cat" Then Winsock1.SendData vbCrLf & "Syntax: cat <file name>" & vbCrLf Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub Else strFile = Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand))) End If If Dir(strFile) <> "" Then i = FreeFile Open Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand))) For Input As #i Do While Not EOF(i) Line Input #i, sData Winsock1.SendData vbCrLf & sData Loop Close #i Else Winsock1.SendData vbCrLf & "File not found." & vbCrLf End If Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub End If If Len(gsCommand) > 0 Then Winsock1.SendData vbCrLf & gsCommand & ": Syntax Error." & vbCrLf Winsock1.SendData vbCrLf & "Type ? or help for help menu." & vbCrLf End If Winsock1.SendData vbCrLf & gsPrompt gsCommand = "" Exit Sub End Select End If gsCommand = gsCommand & strData Winsock1.SendData strData End If End Sub Public Sub Winsock1_Close() lstStatus.AddItem "Telnet Server shut down succesfuly." lstStatus.AddItem "Restarting...." lstStatus.Selected(lstStatus.ListCount - 1) = True Winsock1.Close Winsock1.LocalPort = 23 Winsock1.Listen blnLogin = False blnEnter = False strLogin = "" strPassword = "" End SubPublic 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) Winsock1.Close Winsock1.LocalPort = 23 Winsock1.Listen
blnLogin = False blnEnter = False strLogin = "" strPassword = "" End Sub Public blnLogin As Boolean Public blnEnter As Boolean Public blnStart As Boolean Public strLogin As String Public strPassword As String Public gsLogin As String Public gsPWD As String Public strData As String Public gsPrompt As String Public gsCommand As StringPrivate Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long wProcessorLevel As Integer wProcessorRevision As Integer End TypePrivate Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End TypePrivate Const VER_PLATFORM_WIN32_NT& = 2 Private Const VER_PLATFORM_WIN32_WINDOWS& = 1Private Const PROCESSOR_INTEL_386 = 386 Private Const PROCESSOR_INTEL_486 = 486 Private Const PROCESSOR_INTEL_PENTIUM = 586 Private Const PROCESSOR_MIPS_R4000 = 4000 Private Const PROCESSOR_ALPHA_21064 = 21064Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Main() blnStart = True
frmMain.Show End SubPublic Sub ShowWelcomeMenu() With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " --------- Welcome to Leo Huang Telnet Server --------" & vbCrLf .SendData " --------- --------" & vbCrLf .SendData " --------- Type ? or help for the help menu --------" & vbCrLf .SendData " --------- --------" & vbCrLf .SendData " -----------------------------------------------------" & vbCrLf & vbCrLf & gsPrompt End With End Sub
Public Sub ShowHelpMenu() With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " ? or help ------------ Help on Help" & vbCrLf .SendData " cat ------------ Cat File" & vbCrLf .SendData " date ------------ Server Date" & vbCrLf .SendData " exit ------------ Exit" & vbCrLf .SendData " log ------------ View Server Log" & vbCrLf .SendData " lptest ------------ Print Test Page" & vbCrLf .SendData " man ------------ On Line Manual" & vbCrLf .SendData " restart ------------ Restart Telnet Server" & vbCrLf .SendData " run ------------ Run Server Program" & vbCrLf .SendData " system ------------ System Information" & vbCrLf .SendData " time ------------ Server Time" & vbCrLf & vbCrLf & gsPrompt End With End SubPublic Sub ShowCatMenu() With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " Syntax: cat <Path\Filename>" & vbCrLf & vbCrLf .SendData " Example:" & vbCrLf & vbCrLf .SendData " cat C:\Windows\win.ini" & vbCrLf & vbCrLf & gsPrompt End With End SubPublic Sub ShowRunMenu() With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " Syntax: run <Path\Filename>" & vbCrLf & vbCrLf .SendData " Example:" & vbCrLf & vbCrLf .SendData " run C:\Windows\Explorer.exe" & vbCrLf & vbCrLf & gsPrompt End With End SubPublic Sub ManPage(sCommand As String) Select Case sCommand Case "help" ShowHelpMenu Case "cat" ShowCatMenu Case "run" ShowRunMenu Case "date" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " date ----------- Show Server Date" & vbCrLf & vbCrLf & gsPrompt End With Case "exit" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " exit ----------- Exit Telnet" & vbCrLf & vbCrLf & gsPrompt End With Case "log" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " log ------------ View Server Log" & vbCrLf & vbCrLf & gsPrompt End With Case "lptest" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " lptest --------- Print Test Page" & vbCrLf & vbCrLf & gsPrompt End With Case "restart" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " restart -------- Restart Telnet Server" & vbCrLf & vbCrLf & gsPrompt End With Case "run" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " run ------------ Run Server Program" & vbCrLf & vbCrLf & gsPrompt End With Case "system" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " system --------- System Information" & vbCrLf & vbCrLf & gsPrompt End With Case "time" With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " time ----------- Server Time" & vbCrLf & vbCrLf & gsPrompt End With Case Else With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " Bad Command. Please type help for help." & vbCrLf & vbCrLf & gsPrompt End With End Select End SubPublic Sub RunProgram(sCommand As String) Dim sProgram As String Dim lReturn As Long
On Error Resume Next
If sCommand = "run /?" Then ShowRunMenu gsCommand = "" Exit Sub End If
With frmMain If lReturn > 32 Then .lstStatus.AddItem " - " & sProgram & " was run at " & Time .Winsock1.SendData vbCrLf & vbCrLf & " Program has been run." & vbCrLf ElseIf lReturn = 2 Then .lstStatus.AddItem " - File " & sProgram & " not found." .Winsock1.SendData vbCrLf & vbCrLf & " File not found." & vbCrLf End If
.Winsock1.SendData vbCrLf & gsPrompt End With End SubPublic Sub GetSystemInformation() Dim SysInfo As SYSTEM_INFO Dim OSVer As String Dim OSVersion As OSVERSIONINFO OSVersion.dwOSVersionInfoSize = 148 GetVersionEx OSVersion
With OSVersion If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then If .dwMajorVersion = 4 And .dwMinorVersion > 0 Then OSVer = "Windows 98 " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&) ElseIf .dwMajorVersion = 4 And .dwMinorVersion = 0 Then OSVer = "Windows 95 " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&) End If
ElseIf .dwPlatformId = VER_PLATFORM_WIN32_NT Then OSVer = "Windows NT " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&) End If End With
GetSystemInfo SysInfo
With frmMain.Winsock1 .SendData vbCrLf & vbCrLf .SendData " " & OSVer & vbCrLf & vbCrLf .SendData " The number of Processors in the server: " & SysInfo.dwNumberOfProcessors & vbCrLf .SendData " The type of Processor in the server: "
Select Case SysInfo.dwProcessorType Case PROCESSOR_INTEL_386 .SendData "Intel 386" Case PROCESSOR_INTEL_486 .SendData "Intel 486" Case PROCESSOR_INTEL_PENTIUM .SendData "Intel Pentium" Case PROCESSOR_MIPS_R4000 .SendData "MIPS R4000" Case PROCESSOR_ALPHA_21064 .SendData "Alpha 21064" End Select
.SendData vbCrLf & vbCrLf & gsPrompt End With End Sub
[email protected]
已发送,包括TELNET的服务端和客户端,只是个示例代码,比较简陋,自己好好研究研究,写出更好的:)
lstStatus.Clear
gsLogin = frmLogin.txtLogin.Text
gsPWD = frmLogin.txtPassword.Text
End SubPrivate Sub Form_Unload(Cancel As Integer)
End
End SubPublic Sub cmdStart_Click()
If gsLogin = "" Or gsPWD = "" Then
frmLogin.Show vbModal
Exit Sub
End If
If cmdStart.Caption = "Start" Then
lstStatus.AddItem "Telnet Server start at " & Now
lstStatus.AddItem " - On " & Winsock1.LocalHostName & ": " & Winsock1.LocalIP & " Port 23"
cmdStart.Caption = "Reset"
cmdTelnet.Enabled = True
Else
lstStatus.AddItem "Telnet Server Restart at " & Now
cmdTelnet.Enabled = False
End If
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.Close
Winsock1.LocalPort = 23
Winsock1.Listen
blnLogin = False
blnEnter = False
strLogin = ""
strPassword = ""
End Sub
Private Sub mnuStart_Click()
If mnuStart.Caption = "S&tart" Then
mnuStart.Caption = "S&top"
cmdStart_Click
cmdTelnet.Enabled = True
Else
mnuStart.Caption = "S&tart"
Winsock1.Close
cmdStart.Caption = "Start"
cmdTelnet.Enabled = False
lstStatus.AddItem "Telnet Server Stop at " & Now
lstStatus.Selected(lstStatus.ListCount - 1) = True
End If
End SubPrivate Sub mnuClear_Click()
lstStatus.Clear
End SubPrivate Sub mnuLogin_Click()
frmLogin.Show vbModal
End SubPrivate Sub mnuExit_Click()
Unload Me
End SubPrivate Sub cmdExit_Click()
Unload Me
End Sub
Dim i As Integer
Dim iFile As Integer
iFile = FreeFile
Open App.Path & "\log.log" For Append As #iFile
Print #iFile, vbCrLf & " -- " & Time & " --"
For i = 0 To lstStatus.ListCount - 1
Print #iFile, lstStatus.List(i)
Next i
Close #iFile
MsgBox "Log file has been saved.", vbInformation
End Sub
Private Sub cmdTelnet_Click()
Shell "telnet " & Winsock1.LocalIP, vbNormalFocus
End Sub
Public Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
With Winsock1
If .State <> sckClosed Then .Close
.Accept requestID
.SendData "Trying " & .LocalIP & "..." & vbCrLf
.SendData "Connected to " & .LocalIP & "." & vbCrLf
.SendData "Escape character is '^]'." & vbCrLf & vbCrLf
.SendData "Welcome to Telnet Server: " & .LocalHostName & " " & .LocalIP & " Port: " & .LocalPort & vbCrLf & vbCrLf
.SendData "Connect from: " & .RemoteHostIP & " at " & Now & vbCrLf & vbCrLf
.SendData "Login: "
lstStatus.AddItem "Attempt to connect from " & .RemoteHostIP & ":" & .RemotePort & " - " & Now
End With
lstStatus.Selected(lstStatus.ListCount - 1) = True
End Sub
Public Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim i As Integer
Winsock1.GetData strData
If Not blnLogin Then
If blnEnter = False Then
If strData <> vbCrLf Then
strLogin = strLogin & strData
Winsock1.SendData strData
Else
blnEnter = True
Winsock1.SendData vbCrLf & "Password: "
Exit Sub
End If
Else
If strData <> vbCrLf Then
strPassword = strPassword & strData
Winsock1.SendData ""
Else
If strLogin = gsLogin And strPassword = gsPWD Then
blnLogin = True
gsPrompt = strLogin & "@" & Winsock1.RemoteHostIP & "\> "
ShowWelcomeMenu
lstStatus.AddItem " - Login OK"
lstStatus.Selected(lstStatus.ListCount - 1) = True
Exit Sub
Else
lstStatus.AddItem "- Login Failed From Login: " & strLogin & " - Password: " & strPassword
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.SendData vbCrLf & "Login Failed" & vbCrLf & vbCrLf & "Login: "
blnEnter = False
strLogin = ""
strPassword = ""
Exit Sub
End If
End If
End If
Else
If strData = vbCrLf Then
Select Case gsCommand
Case "?"
lstStatus.AddItem " - help command requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
ShowHelpMenu
gsCommand = ""
Exit Sub
Case "help"
lstStatus.AddItem " - help command requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
ShowHelpMenu
gsCommand = ""
Exit Sub
Case "exit"
lstStatus.AddItem " - " & gsLogin & " logout at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
cmdStart_Click
gsCommand = ""
Exit Sub
Case "date"
lstStatus.AddItem " - date command requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.SendData vbCrLf & vbCrLf & " Server Date: " & Format(Date, "Ddd, mmm d yyyy") & vbCrLf
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
Case "time"
lstStatus.AddItem " - time command requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.SendData vbCrLf & vbCrLf & " Server Time: " & Time & vbCrLf
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
Case "log"
lstStatus.AddItem " - view Telnet Server log requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.SendData vbCrLf
For i = 0 To lstStatus.ListCount - 1
Winsock1.SendData " " & lstStatus.List(i) & vbCrLf
Next i
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
Case "restart"
lstStatus.AddItem " - telnet server restart requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
cmdStart_Click
gsCommand = ""
Exit Sub
Case "system"
lstStatus.AddItem " - system information requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
GetSystemInformation
gsCommand = ""
Exit Sub
Case "lptest"
lstStatus.AddItem " - lptest command requested by " & gsLogin & " at " & Time
lstStatus.Selected(lstStatus.ListCount - 1) = True
Shell "rundll32.exe msprint2.dll,RUNDLL_PrintTestPage"
With Winsock1
.SendData vbCrLf & " Server test page has been printed." & vbCrLf & vbCrLf & gsPrompt
End With
gsCommand = ""
Exit Sub
Case Else
If Left(gsCommand, 3) = "man" Then
If Trim(gsCommand) = "man" Then
Winsock1.SendData vbCrLf & "Syntax: man <command>" & vbCrLf
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
Else
strCommand = Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand)))
End If
ManPage (strCommand)
DoEvents
gsCommand = ""
Exit Sub
End If
If Left(gsCommand, 3) = "run" Then
If Trim(gsCommand) = "run" Then
Winsock1.SendData vbCrLf & "Syntax: run <file name>" & vbCrLf
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
End If
DoEvents
gsCommand = ""
Exit Sub
End If
If Left(gsCommand, 3) = "cat" Then
If Trim(gsCommand) = "cat" Then
Winsock1.SendData vbCrLf & "Syntax: cat <file name>" & vbCrLf
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
Else
strFile = Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand)))
End If
If Dir(strFile) <> "" Then
i = FreeFile
Open Trim(Mid(gsCommand, InStr(1, gsCommand, " "), Len(gsCommand))) For Input As #i
Do While Not EOF(i)
Line Input #i, sData
Winsock1.SendData vbCrLf & sData
Loop
Close #i
Else
Winsock1.SendData vbCrLf & "File not found." & vbCrLf
End If
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
End If
If Len(gsCommand) > 0 Then
Winsock1.SendData vbCrLf & gsCommand & ": Syntax Error." & vbCrLf
Winsock1.SendData vbCrLf & "Type ? or help for help menu." & vbCrLf
End If
Winsock1.SendData vbCrLf & gsPrompt
gsCommand = ""
Exit Sub
End Select
End If
gsCommand = gsCommand & strData
Winsock1.SendData strData
End If
End Sub
Public Sub Winsock1_Close()
lstStatus.AddItem "Telnet Server shut down succesfuly."
lstStatus.AddItem "Restarting...."
lstStatus.Selected(lstStatus.ListCount - 1) = True
Winsock1.Close
Winsock1.LocalPort = 23
Winsock1.Listen
blnLogin = False
blnEnter = False
strLogin = ""
strPassword = ""
End SubPublic 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)
Winsock1.Close
Winsock1.LocalPort = 23
Winsock1.Listen
blnLogin = False
blnEnter = False
strLogin = ""
strPassword = ""
End Sub
Public blnLogin As Boolean
Public blnEnter As Boolean
Public blnStart As Boolean
Public strLogin As String
Public strPassword As String
Public gsLogin As String
Public gsPWD As String
Public strData As String
Public gsPrompt As String
Public gsCommand As StringPrivate Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End TypePrivate Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End TypePrivate Const VER_PLATFORM_WIN32_NT& = 2
Private Const VER_PLATFORM_WIN32_WINDOWS& = 1Private Const PROCESSOR_INTEL_386 = 386
Private Const PROCESSOR_INTEL_486 = 486
Private Const PROCESSOR_INTEL_PENTIUM = 586
Private Const PROCESSOR_MIPS_R4000 = 4000
Private Const PROCESSOR_ALPHA_21064 = 21064Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Main()
blnStart = True
frmMain.Show
End SubPublic Sub ShowWelcomeMenu()
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " --------- Welcome to Leo Huang Telnet Server --------" & vbCrLf
.SendData " --------- --------" & vbCrLf
.SendData " --------- Type ? or help for the help menu --------" & vbCrLf
.SendData " --------- --------" & vbCrLf
.SendData " -----------------------------------------------------" & vbCrLf & vbCrLf & gsPrompt
End With
End Sub
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " ? or help ------------ Help on Help" & vbCrLf
.SendData " cat ------------ Cat File" & vbCrLf
.SendData " date ------------ Server Date" & vbCrLf
.SendData " exit ------------ Exit" & vbCrLf
.SendData " log ------------ View Server Log" & vbCrLf
.SendData " lptest ------------ Print Test Page" & vbCrLf
.SendData " man ------------ On Line Manual" & vbCrLf
.SendData " restart ------------ Restart Telnet Server" & vbCrLf
.SendData " run ------------ Run Server Program" & vbCrLf
.SendData " system ------------ System Information" & vbCrLf
.SendData " time ------------ Server Time" & vbCrLf & vbCrLf & gsPrompt
End With
End SubPublic Sub ShowCatMenu()
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " Syntax: cat <Path\Filename>" & vbCrLf & vbCrLf
.SendData " Example:" & vbCrLf & vbCrLf
.SendData " cat C:\Windows\win.ini" & vbCrLf & vbCrLf & gsPrompt
End With
End SubPublic Sub ShowRunMenu()
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " Syntax: run <Path\Filename>" & vbCrLf & vbCrLf
.SendData " Example:" & vbCrLf & vbCrLf
.SendData " run C:\Windows\Explorer.exe" & vbCrLf & vbCrLf & gsPrompt
End With
End SubPublic Sub ManPage(sCommand As String)
Select Case sCommand
Case "help"
ShowHelpMenu
Case "cat"
ShowCatMenu
Case "run"
ShowRunMenu
Case "date"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " date ----------- Show Server Date" & vbCrLf & vbCrLf & gsPrompt
End With
Case "exit"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " exit ----------- Exit Telnet" & vbCrLf & vbCrLf & gsPrompt
End With
Case "log"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " log ------------ View Server Log" & vbCrLf & vbCrLf & gsPrompt
End With
Case "lptest"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " lptest --------- Print Test Page" & vbCrLf & vbCrLf & gsPrompt
End With
Case "restart"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " restart -------- Restart Telnet Server" & vbCrLf & vbCrLf & gsPrompt
End With
Case "run"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " run ------------ Run Server Program" & vbCrLf & vbCrLf & gsPrompt
End With
Case "system"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " system --------- System Information" & vbCrLf & vbCrLf & gsPrompt
End With
Case "time"
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " time ----------- Server Time" & vbCrLf & vbCrLf & gsPrompt
End With
Case Else
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " Bad Command. Please type help for help." & vbCrLf & vbCrLf & gsPrompt
End With
End Select
End SubPublic Sub RunProgram(sCommand As String)
Dim sProgram As String
Dim lReturn As Long
On Error Resume Next
If sCommand = "run /?" Then
ShowRunMenu
gsCommand = ""
Exit Sub
End If
sProgram = Trim(Mid(sCommand, InStr(1, sCommand, " "), Len(sCommand)))
lReturn = ShellExecute(0, vbNullString, sProgram, "", "", vbNormalFocus)
With frmMain
If lReturn > 32 Then
.lstStatus.AddItem " - " & sProgram & " was run at " & Time
.Winsock1.SendData vbCrLf & vbCrLf & " Program has been run." & vbCrLf
ElseIf lReturn = 2 Then
.lstStatus.AddItem " - File " & sProgram & " not found."
.Winsock1.SendData vbCrLf & vbCrLf & " File not found." & vbCrLf
End If
.lstStatus.Selected(.lstStatus.ListCount - 1) = True
.Winsock1.SendData vbCrLf & gsPrompt
End With
End SubPublic Sub GetSystemInformation()
Dim SysInfo As SYSTEM_INFO
Dim OSVer As String
Dim OSVersion As OSVERSIONINFO OSVersion.dwOSVersionInfoSize = 148
GetVersionEx OSVersion
With OSVersion
If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
If .dwMajorVersion = 4 And .dwMinorVersion > 0 Then
OSVer = "Windows 98 " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&)
ElseIf .dwMajorVersion = 4 And .dwMinorVersion = 0 Then
OSVer = "Windows 95 " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&)
End If
ElseIf .dwPlatformId = VER_PLATFORM_WIN32_NT Then
OSVer = "Windows NT " & .dwMajorVersion & "." & .dwMinorVersion & "." & (.dwBuildNumber And &HFFFF&)
End If
End With
GetSystemInfo SysInfo
With frmMain.Winsock1
.SendData vbCrLf & vbCrLf
.SendData " " & OSVer & vbCrLf & vbCrLf
.SendData " The number of Processors in the server: " & SysInfo.dwNumberOfProcessors & vbCrLf
.SendData " The type of Processor in the server: "
Select Case SysInfo.dwProcessorType
Case PROCESSOR_INTEL_386
.SendData "Intel 386"
Case PROCESSOR_INTEL_486
.SendData "Intel 486"
Case PROCESSOR_INTEL_PENTIUM
.SendData "Intel Pentium"
Case PROCESSOR_MIPS_R4000
.SendData "MIPS R4000"
Case PROCESSOR_ALPHA_21064
.SendData "Alpha 21064"
End Select
.SendData vbCrLf & vbCrLf & gsPrompt
End With
End Sub