form1.frm

用VB调用SSH控件

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next

Select Case Button.Key ''
Case "key1"
'
FrmConnection.Show
Me.Enabled = False
Case "key2"
'
Case "key4"
FrmPass.Show
Me.Enabled = False

Case "key5"
'
Value& = MsgBox("是否要断开与服务器的连接？", vbCritical + vbYesNo, "连接提示")
If Value& = vbYes Then
Client.Close
txtOutput.text = "Wind wolf SSH [Version 5.00.2195]" & vbCrLf & "(C) 版权所有 20006-2007 Wolf."
txtOutput2.text = "Wind wolf SSH [Version 5.00.2195]" & vbCrLf & "(C) 版权所有 20006-2007 Wolf."

End If
Case "key6"
Shell App.Path & "/Win SSH.exe", vbNormalFocus
End Select
End Sub

Private Sub txtCMD_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
'清除界面
If txtCMD.text = "clear" Or txtCMD.text = "CLEAR" Then
  txtOutput.text = ""
  txtOutput2.text = ""
  txtCMD.text = ""
  txtCMD.SetFocus
End If
'帮助说明
If txtCMD.text = "\help" Or txtCMD.text = "\HELP" Then
  txtOutput.text = txtOutput.text & vbCrLf & vbCrLf & "CONNECT IP/Host[:Port] (Connect to CMDServer on Port, Default = 512)" & vbCrLf & _
                   "EXIT (Exit SSH)" & vbCrLf & _
                   "REXIT (Close down CMDServer )" & vbCrLf & _
                   "CMDHELP (Show this help)" & vbCrLf & _
                   "REXEC [FullPath/]Filename.ext [parameters] (Execute remote app)" & vbCrLf & _
                   "RTERM HWND (Close running app)" & vbCrLf & _
                   "CLEAR (Clear Screen)" & vbCrLf & vbCrLf & _
                   "OBSERVE that if you remotly start an application via the command interpreter the server will not return until the application is terminated." & vbCrLf & _
                   "Use REXEC instead" & vbCrLf & vbCrLf & _
                   "When you connect to the server you will be prompt for username and password" & vbCrLf & _
                   "note that the user most have administrator rights on the remote server."
  txtOutput2.text = txtOutput2.text & vbCrLf & vbCrLf & "CONNECT IP/Host[:Port] (Connect to CMDServer on Port, Default = 512)" & vbCrLf & _
                   "EXIT (Exit SSH)" & vbCrLf & _
                   "REXIT (Close down CMDServer )" & vbCrLf & _
                   "CMDHELP (Show this help)" & vbCrLf & _
                   "REXEC [FullPath/]Filename.ext [parameters] (Execute remote app)" & vbCrLf & _
                   "RTERM HWND (Close running app)" & vbCrLf & _
                   "CLEAR (Clear Screen)" & vbCrLf & vbCrLf & _
                   "OBSERVE that if you remotly start an application via the command interpreter the server will not return until the application is terminated." & vbCrLf & _
                   "Use REXEC instead" & vbCrLf & vbCrLf & _
                   "When you connect to the server you will be prompt for username and password" & vbCrLf & _
                   "note that the user most have administrator rights on the remote server."
              
                   
  txtCMD.text = ""
  txtCMD.SetFocus
End If


If txtCMD.text = "exit" Or txtCMD.text = "EXIT" Then
Client.Close
txtCMD.text = ""
txtCMD.SetFocus
End
End If

If Left(txtCMD.text, 13) = "setbackcolor " Or Left(txtCMD.text, 13) = "SETBACKCOLOR " Then   '设置屏幕颜色颜色

If Right(txtCMD.text, Len(txtCMD.text) - 12) = "black" Then
txtOutput.BackColor = &H0&
txtOutput2.BackColor = &H0&

txtCMD.BackColor = &H0&
txtCMD.ForeColor = &HFFFF80
txtCMD.text = ""
ElseIf Right(txtCMD.text, Len(txtCMD.text) - 12) = "blue" Then
txtOutput.BackColor = vbBlue
txtOutput.ForeColor = &HFFFFFF
txtOutput2.BackColor = &H0&
txtOutput2.ForeColor = &HFFFFFF
txtCMD.BackColor = vbBlue
txtCMD.ForeColor = &HFFFFFF
txtCMD.text = ""
End If
End If

If LCase(Mid(txtCMD.text, 1, 7)) = "connect" Or LCase(Mid(txtCMD.text, 1, 7)) = "CONNECT" Then
Connect txtCMD.text
txtCMD.SetFocus
End If

If txtCMD.text = "showgetlog" Or txtCMD.text = "SHOWGETLOG" Then
der = True
txtCMD.text = ""
txtCMD.SetFocus
txtOutput.text = vbCrLf & "Open getRemoteLog type=true" & vbCrLf
txtOutput2.text = vbCrLf & "Open getRemoteLog type=true" & vbCrLf
End If

If txtCMD.text = "unloadgetlog" Or txtCMD.text = "UNLOADGETLOG" Then
der = False
txtCMD.text = ""
txtCMD.SetFocus
txtOutput.text = vbCrLf & "Close getRemoteLog   type=false" & vbCrLf
txtOutput2.text = vbCrLf & "Close getRemoteLog   type=true" & vbCrLf
End If

If Left(txtCMD.text, 4) = "dir " Or Left(txtCMD.text, 4) = "DIR " Then
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 4)
txtOutput.text = txtOutput.text & vbCrLf & vbCrLf & "[GetDrive: " & Right(txtCMD.text, Len(txtCMD.text) - 4) & "]"
txtOutput.Visible = True
txtOutput2.Visible = False
txtCMD.text = ""
txtCMD.SetFocus
Command1_Click
'txtOutput.Text = txtOutput.Text & vbCrLf & vbCrLf

End If

If Left(txtCMD.text, 3) = "cd " Or Left(txtCMD.text, 3) = "CD " Then '
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 3)
txtOutput.text = txtOutput.text & vbCrLf & vbCrLf & "[GetFolder: " & Right(txtCMD.text, Len(txtCMD.text) - 3) & "]"
txtOutput.Visible = True
txtOutput2.Visible = False
txtCMD.text = ""
txtCMD.SetFocus
Command1_Click
End If

If Left(txtCMD.text, 3) = "ls " Or Left(txtCMD.text, 3) = "LS " Then  '显示当前文件
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 3)
txtOutput.Visible = False
txtOutput2.Visible = True
txtCMD.text = ""
txtCMD.SetFocus
Command1_Click
End If

If txtCMD.text = "q-s" Or txtCMD.text = "Q-S" Then '退出文本编辑状态
txtOutput3.Visible = False
txtOutput3.text = ""
txtCMD.text = ""
txtCMD.SetFocus
End If

If Left(txtCMD.text, 4) = "cat " Or Left(txtCMD.text, 4) = "CAT " Then  '读取当前文本文件
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 4)

Client.SendData "110" & TextDirectory.text

txtOutput.Visible = False
txtOutput2.Visible = True

txtCMD.text = ""
txtCMD.SetFocus

End If

If Left(txtCMD.text, 2) = "vi" Or Left(txtCMD.text, 2) = "VI" Then  '写入编辑变量
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 2)
text = txtOutput3.text
txtOutput3.text = ""
txtOutput.Visible = False
txtOutput2.Visible = True
txtOutput3.Visible = False
txtOutput2.text = vbCrLf & "Out Over" & vbCrLf
Client.SendData "111" & text
txtCMD.text = ""
txtCMD.SetFocus

End If

If Left(txtCMD.text, 4) = "out " Or Left(txtCMD.text, 4) = "OUT " Then  '写入当前指定的文本文件
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 4)
Client.SendData "112" & TextDirectory.text
txtCMD.text = ""
txtCMD.SetFocus

End If



If Left(txtCMD.text, 6) = "rexec " Or Left(txtCMD.text, 6) = "REXEC " Then  '执行当前命令
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 6)
txtOutput.Visible = False
txtOutput2.Visible = True
 If Right(TextDirectory.text, 1) <> "\" And Right(TextDirectory.text, 1) <> "/" Then TextDirectory.text = TextDirectory.text
Client.SendData "083" & TextDirectory.text
txtOutput2.text = txtOutput2.text & "REXEC " & TextDirectory.text & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
End If

If Left(txtCMD.text, 8) = "rexec-t " Or Left(txtCMD.text, 8) = "REXEC-T " Then  '执行当前预定命令
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 8)
txtOutput.Visible = False
txtOutput2.Visible = True
 If Right(TextDirectory.text, 1) <> "\" And Right(TextDirectory.text, 1) <> "/" Then TextDirectory.text = TextDirectory.text
Client.SendData "108" & TextDirectory.text
txtOutput.text = ""
txtOutput2.text = vbCrLf & "rexec-t " & TextDirectory.text & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
End If

If Left(txtCMD.text, 6) = "set-t " Or Left(txtCMD.text, 6) = "SET-T " Then  '执行当前预定命令

txtOutput.Visible = False
txtOutput2.Visible = True
 If Right(TextDirectory.text, 1) <> "\" And Right(TextDirectory.text, 1) <> "/" Then TextDirectory.text = TextDirectory.text
Client.SendData "109" & Right(txtCMD.text, Len(txtCMD.text) - 6)
txtOutput.text = ""
txtOutput2.text = vbCrLf & "set-t " & Right(txtCMD.text, Len(txtCMD.text) - 6) & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
End If

If Left(txtCMD.text, 6) = "set-d " Or Left(txtCMD.text, 6) = "SET-D " Then  '设置当前下载文件保存目录
txtOutput.Visible = False
txtOutput2.Visible = True
Text1.text = Right(txtCMD.text, Len(txtCMD.text) - 6)
txtOutput2.text = "Set Save Url :" & Text1.text
txtCMD.text = ""
txtCMD.SetFocus
End If

If Left(txtCMD.text, 6) = "set-u " Or Left(txtCMD.text, 6) = "SET-U " Then  '设置当前要上传到的目录
txtOutput.Visible = False
txtOutput2.Visible = True
Client.SendData "120" & Right(txtCMD.text, Len(txtCMD.text) - 6)
txtOutput2.text = "Set Upload Url :" & Right(txtCMD.text, Len(txtCMD.text) - 6)
txtCMD.text = ""
txtCMD.SetFocus
End If

'download
If Left(txtCMD.text, 9) = "download " Or Left(txtCMD.text, 9) = "DOWNLOAD " Then  '下载文件

txtOutput.Visible = False
txtOutput2.Visible = True
If Text1.text <> Empty Then
 If Right(TextDirectory.text, 1) <> "\" And Right(TextDirectory.text, 1) <> "/" Then
 TextDirectory.text = TextDirectory.text
 End If
Client.SendData "120" & Right(txtCMD.text, Len(txtCMD.text) - 9)
txtOutput.text = ""
txtOutput2.text = vbCrLf & "Download " & Right(txtCMD.text, Len(txtCMD.text) - 9) & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
Timer1.Enabled = True
Else
txtOutput2.text = vbCrLf & "Download Error" & Right(txtCMD.text, Len(txtCMD.text) - 9) & vbCrLf
Exit Sub
End If
End If

'upload
If Left(txtCMD.text, 7) = "upload " Or Left(txtCMD.text, 7) = "UPLOAD " Then  '上传文件

txtOutput.Visible = False
txtOutput2.Visible = True

Text1.text = Right(txtCMD.text, Len(txtCMD.text) - 7)
If Text1.text <> Empty Then
txtOutput.text = ""
txtOutput2.text = vbCrLf & "Upload " & Right(txtCMD.text, Len(txtCMD.text) - 7) & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
Setver.Show
Else
txtOutput2.text = vbCrLf & "Upload Error"
Exit Sub
End If
End If

If Left(txtCMD.text, 4) = "del " Or Left(txtCMD.text, 4) = "DEL " Then  '删除当前文件
TextDirectory.text = ""
TextDirectory.text = Right(txtCMD.text, Len(txtCMD.text) - 4)
txtOutput.Visible = False
txtOutput2.Visible = True
 If Right(TextDirectory.text, 1) <> "\" And Right(TextDirectory.text, 1) <> "/" Then TextDirectory.text = TextDirectory.text
Client.SendData "078" & TextDirectory.text
txtOutput2.text = txtOutput2.text & vbCrLf & "DEL " & TextDirectory.text & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
End If

If txtCMD.text = "closeserver" Or txtCMD.text = "CLOSESERVER" Then '断开连接

txtOutput2.Visible = True
txtOutput.Visible = False
Client.Close
txtOutput.text = "Wind wolf SSH [Version 5.00.2195]" & vbCrLf & "(C) 版权所有 20006-2007 Wolf."
txtOutput2.text = "Wind wolf SSH [Version 5.00.2195]" & vbCrLf & "(C) 版权所有 20006-2007 Wolf."

txtCMD.text = ""
txtCMD.SetFocus
End If

If txtCMD.text = "closesystem" Or txtCMD.text = "CLOSESYSTEM" Then  '远程关机

Client.SendData "107"
txtOutput.text = txtOutput.text & vbCrLf & "[Close Remote Server]" & vbCrLf
txtOutput2.text = txtOutput2.text & vbCrLf & "[Close Remote Server]" & vbCrLf
txtCMD.text = ""
txtCMD.SetFocus
End If



End If
End Sub

'Initate the connection
Private Sub Connect(strConnect As String)
Dim varSplit As Variant, IP As String, Port As String
On Error GoTo Errhandler
If Not blnConnected Then
    varSplit = Split(Trim(strConnect))
    If UBound(varSplit) > 0 Then
        If InStr(1, varSplit(1), ":") Then
            IP = Trim(Mid(varSplit(1), 1, InStr(1, varSplit(1), ":") - 1))
            Port = Trim(Mid(varSplit(1), InStr(1, varSplit(1), ":") + 1))
        Else
            IP = Trim(varSplit(1))
            Port = Trim("512")
        End If
    End If
    
    Client.RemoteHost = IP
    Client.RemotePort = Port
    
    txtOutput.text = txtOutput.text & vbCrLf & vbCrLf & "Connecting to " & IP & ":" & Port
    txtOutput.SelStart = Len(txtOutput.text)
    txtCMD.text = ""
    txtCMD.SetFocus

    Client.Connect
End If
Exit Sub
Errhandler:
txtOutput.text = Err.Source & vbCrLf & Err.Description
txtOutput.SelStart = Len(txtOutput.text)
txtCMD.text = ""
txtCMD.SetFocus
Client.Close
End Sub