client.frm

用VB调用SSH控件

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form Client 
   BackColor       =   &H00E0E0E0&
   BorderStyle     =   0  'None
   Caption         =   "Client"
   ClientHeight    =   90
   ClientLeft      =   4920
   ClientTop       =   4515
   ClientWidth     =   90
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   90
   ScaleWidth      =   90
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Visible         =   0   'False
   Begin MSWinsockLib.Winsock wskClient 
      Left            =   1830
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer2 
      Interval        =   100
      Left            =   4020
      Top             =   480
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   3000
      Left            =   3600
      Top             =   480
   End
   Begin VB.ListBox List1 
      Height          =   600
      Left            =   0
      TabIndex        =   3
      Top             =   360
      Width           =   4665
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   780
      TabIndex        =   1
      Top             =   52
      Width           =   1455
   End
   Begin VB.CheckBox Check1 
      Caption         =   "连接/等待"
      Height          =   225
      Left            =   3510
      TabIndex        =   0
      Top             =   75
      Width           =   1125
   End
   Begin ComctlLib.ProgressBar ProBar 
      Height          =   195
      Left            =   0
      TabIndex        =   4
      Top             =   1020
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   344
      _Version        =   327682
      Appearance      =   0
   End
   Begin VB.Label Label1 
      Caption         =   "IP 地址:"
      Height          =   180
      Left            =   30
      TabIndex        =   2
      Top             =   97
      Width           =   720
   End
End
Attribute VB_Name = "Client"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim itwms As ListItem
Dim FileNumber As Integer
Dim LenFile As Long
Dim OnAccept As Boolean '是否在接收"字节"数据状态
'----------------------
Dim ProBarLen As Long
Dim VarPlus As Long

Private Sub Check1_Click()
    
    If Check1.Value Then
       wskClient.RemoteHost = Text1.Text
       wskClient.RemotePort = 525
       wskClient.Connect
       
       List1.Clear
       List1.AddItem "连接到 : " & FrmPass.Text2.Text & ":" & 525
    Else
       wskClient.Close
       Timer1.Enabled = False
       
       List1.Clear
       List1.AddItem "连接已关闭..."
    End If
    
End Sub

Private Sub Form_Load()
    Me.Hide
    List1.AddItem "就绪"
    OnAccept = False
    Text1.Text = FrmPass.Text2.Text
    Check1.Value = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    wskClient.Close '程序退出时关闭WinSock
    
End Sub

Private Sub Timer1_Timer()
    
    Call Check1_Click
    Timer1.Enabled = False
    
End Sub

Private Sub Timer2_Timer()
    
    If wskClient.State = sckClosing Then
       wskClient.Close
       
       List1.Clear
       List1.AddItem "连接已被对方关闭..."
       List1.AddItem "3 秒后将自动重试连接..."
       Timer1.Enabled = True
    End If
       
End Sub

Private Sub wskClient_Connect()
    
    List1.AddItem "连接成功"
    
End Sub

Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)
    
    Dim WskCommand As String
    Dim CmdArr() As String
    Dim FileByte() As Byte
    Dim i As Long
    
    If OnAccept Then '如果是在接收"字节"数据状态时
       wskClient.GetData FileByte, vbArray + vbByte '接收类型为:字节数组
       
       Put #FileNumber, , FileByte '----------标线:)-------------
       
       '--------------- 进度显示 ----------------
       VarPlus = VarPlus + (UBound(FileByte) + 1)
       ProBar.Value = (VarPlus / ProBarLen) * 100
       FrmMain.StatusBar1.Panels(1).Text = "当前接收：" & ProBar.Value & "/字节"
       '-----------------------------------------
       
       '计算接收状态.如果已经接收完所有的文件.即告诉对方"SaveEnd"
       '否则,告诉对方,这次传送过来的东西我已经保存好了!
       LenFile = LenFile - (UBound(FileByte) + 1) '数组的第一维是0.所以这里+1
       If LenFile = 0 Then
          'wskClient.SendData "SaveEnd"
          
          OnAccept = False
          Close #FileNumber
          
          'MsgBox "接收完了!", vbInformation, "⊙_⌒γ - Client"
          FrmMain.List1.AddItem ("下载了文件" & FrmMain.TextDirectory.Text & FrmMain.ListView2.SelectedItem.Text & "          " & Date & "      " & Time & "")
          
          Set itwms = FrmMain.ListView4.ListItems.Add(, , "下载了文件" & FrmMain.TextDirectory.Text & FrmMain.ListView2.SelectedItem.Text)
     itwms.SubItems(1) = Date
     itwms.SubItems(2) = Time
     itwms.SubItems(3) = "下载文件"
          
          FrmMain.Enabled = True
          FrmMain.Timer3.Enabled = True
          Unload Me
          
       'Else
          'wskClient.SendData "SaveOk"
       End If
       
       '上面包含了一个返回信息的方法[已被注释起来了~]
       '因为发送文件那边改了使用SendComplete事件.不需要报告状态了
       Exit Sub
    End If
    
    '这里有一个分水岭,呵呵!如果OnAccept = True下面的代码不会执行!
    
    wskClient.GetData WskCommand '接收数据
    
    CmdArr = Split(WskCommand, ",") '把数据格式化到数组里
    If CmdArr(0) = "SendFile" Then
    
      ' If MsgBox("对方传送一个名叫 “" & CmdArr(1) & "”的文件给你!" & vbCrLf & _
     '            "长度为:" & CmdArr(2) & " 字节" & vbCrLf & vbCrLf & "你愿意接收吗?", _
     '            vbQuestion + vbYesNo, "Client") = vbYes Then
          
     '     With Comdlg '确定接收,弹出保存对话框
     '          .CancelError = True
     '          On Error GoTo SaveErr
     '          .DialogTitle = "保存到..."
      '         .FileName = CmdArr(1)
      '         .Filter = "所有文件 (*.*)|*.*"
      '         .flags = &H4 Or &H2
      '         .ShowSave
      '    End With
          
          wskClient.SendData "OkSend" '告诉对方,可以开始传送
          LenFile = Val(CmdArr(2)) '保存下文件的长度
          '------------------
          ProBarLen = LenFile
          VarPlus = 0
          '------------------
          OnAccept = True '设置标记,下一次数据到达时,数据类型将会是:字节型
          FileNumber = FreeFile '取得未使用的文件号
          Open FrmMain.cmbDrives.Text & "\" & CmdArr(1) For Binary As #FileNumber  '打开文件
          
       Else
          wskClient.SendData "NoThanks" '拒绝接收文件
          FrmMain.Enabled = True
          Unload Me
       End If
    'End If
    
    Exit Sub
SaveErr:
   wskClient.SendData "NoThanks"
   
End Sub

Private Sub wskClient_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)
   
   List1.Clear
   List1.AddItem "无法连接服务器"
   List1.AddItem "错误代码 :" & Str$(Number)
   List1.AddItem "3 秒后重试..."
   Timer1.Enabled = True
   
   wskClient.Close
   
End Sub