📄 client.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Client
BorderStyle = 1 'Fixed Single
Caption = "网络文件传输 Client端 www.play78.com"
ClientHeight = 1635
ClientLeft = 4965
ClientTop = 4845
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1635
ScaleWidth = 4665
Begin MSWinsockLib.Winsock wskClient
Left = 1830
Top = 90
_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 MSComDlg.CommonDialog Comdlg
Left = 2100
Top = 390
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ListBox List1
Height = 600
Left = 0
TabIndex = 5
Top = 390
Width = 4665
End
Begin VB.TextBox Text1
Height = 270
Left = 780
TabIndex = 2
Text = "127.0.0.1"
Top = 52
Width = 1455
End
Begin VB.TextBox Text2
Height = 270
Left = 2790
TabIndex = 1
Text = "5252"
Top = 52
Width = 675
End
Begin VB.CheckBox Check1
Caption = "连接/等待"
Height = 225
Left = 3510
TabIndex = 0
Top = 75
Width = 1125
End
Begin ComctlLib.ProgressBar ProBar
Height = 195
Left = 60
TabIndex = 6
Top = 1380
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
End
Begin VB.Label Label3
Caption = "海阔天空收集整理，http://www.play78.com"
Height = 255
Left = 30
TabIndex = 7
Top = 1050
Width = 4695
End
Begin VB.Label Label1
Caption = "IP 地址:"
Height = 180
Left = 30
TabIndex = 4
Top = 97
Width = 720
End
Begin VB.Label Label2
Caption = "端口:"
Height = 180
Left = 2310
TabIndex = 3
Top = 97
Width = 450
End
End
Attribute VB_Name = "Client"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' **********************************************************************
' 描 述：vb用Winsock传输文件
' Play78.com : 网站导航，源码之家，绝对开源
' 海阔天空收集整理
' 网址：http://www.play78.com/
' QQ：13355575
' e-mail:hglai@eyou.com
' 编写日期：2005年08月10日
' **********************************************************************
Option Explicit
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 = Text2.Text
wskClient.Connect
List1.Clear
List1.AddItem "连接到 : " & Text1.Text & ":" & Text2.Text
Else
wskClient.Close
Timer1.Enabled = False
List1.Clear
List1.AddItem "连接已关闭..."
End If
End Sub
Private Sub Form_Load()
List1.AddItem "就绪"
OnAccept = False
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
'-----------------------------------------
'计算接收状态.如果已经接收完所有的文件.即告诉对方"SaveEnd"
'否则,告诉对方,这次传送过来的东西我已经保存好了!
LenFile = LenFile - (UBound(FileByte) + 1) '数组的第一维是0.所以这里+1
If LenFile = 0 Then
'wskClient.SendData "SaveEnd"
OnAccept = False
Close #FileNumber
MsgBox "接收完了!", vbInformation, "www.play78.com客户端提示"
'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 Comdlg.FileName For Binary As #FileNumber '打开文件
Else
wskClient.SendData "NoThanks" '拒绝接收文件送这个信息
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -