Winsock 接收发送文件的源码,文件任意大小-- 不存在任何错误~
2006-06-09 09:55
477 查看
代码是我收集的在哪里发现的也不记得了,今天有人问我才意识到,应该贴出来....
作者:CSDN 许仙
'Homepage : jjweb.126.com
'MSN :Coderxu#hotmail.com
'QQ:19030300
'转载请保持文章完整,保存以上作者信息 请珍惜他人劳动成果
新建文件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"
ClientHeight = 1230
ClientLeft = 4965
ClientTop = 4845
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1230
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 = 0
TabIndex = 6
Top = 1020
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
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
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, "⊙_⌒γ - Client"
'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
新建文件Setver.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 Setver
BorderStyle = 1 'Fixed Single
Caption = "Server"
ClientHeight = 1935
ClientLeft = 3045
ClientTop = 2535
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1935
ScaleWidth = 4665
Begin MSWinsockLib.Winsock wskServer
Index = 0
Left = 1830
Top = 90
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin ComctlLib.ProgressBar ProBar
Height = 195
Left = 780
TabIndex = 11
Top = 953
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
End
Begin VB.Timer Timer1
Interval = 100
Left = 1560
Top = 480
End
Begin VB.ListBox List1
Height = 600
Left = 0
TabIndex = 10
Top = 1320
Width = 4665
End
Begin MSComDlg.CommonDialog Comdlg
Left = 2100
Top = 390
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command2
Caption = "传送"
Enabled = 0 'False
Height = 285
Left = 3870
TabIndex = 8
Top = 908
Width = 765
End
Begin VB.CommandButton Command1
Caption = "浏览"
Height = 285
Left = 3870
TabIndex = 7
Top = 495
Width = 765
End
Begin VB.TextBox Text3
Height = 270
Left = 780
TabIndex = 6
Top = 495
Width = 3015
End
Begin VB.CheckBox Check1
Caption = "连接/等待"
Height = 225
Left = 3510
TabIndex = 4
Top = 75
Width = 1125
End
Begin VB.TextBox Text2
Height = 270
Left = 2790
TabIndex = 3
Text = "5252"
Top = 52
Width = 675
End
Begin VB.TextBox Text1
BackColor = &H8000000F&
Enabled = 0 'False
Height = 270
Left = 780
TabIndex = 1
Text = "127.0.0.1"
Top = 52
Width = 1455
End
Begin VB.Label Label4
Caption = "进度:"
Height = 180
Index = 1
Left = 30
TabIndex = 9
Top = 960
Width = 450
End
Begin VB.Label Label4
Caption = "文件:"
Height = 180
Index = 0
Left = 30
TabIndex = 5
Top = 540
Width = 450
End
Begin VB.Label Label2
Caption = "端口:"
Height = 180
Left = 2310
TabIndex = 2
Top = 97
Width = 450
End
Begin VB.Label Label1
Caption = "IP 地址:"
Height = 180
Left = 30
TabIndex = 0
Top = 97
Width = 720
End
End
Attribute VB_Name = "Setver"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim GetFileNum As Integer
Dim LenFile As Long
Dim OnSend As Boolean
'--------------------
Dim ProBarLen As Long
Dim VarPlus As Long
Private Sub Check1_Click()
If Check1.Value Then
wskServer(0).LocalPort = Text2.Text
wskServer(0).Listen
List1.Clear
List1.AddItem "开始监听端口 : " & Text2.Text
Else
wskServer(0).Close
List1.Clear
List1.AddItem "停止端口监听."
Command2.Enabled = False '传送按钮不可用
End If
End Sub
Private Sub Command1_Click()
With Comdlg
.CancelError = True
On Error GoTo OpenErr
.DialogTitle = "打开一个测试文件..."
.Filter = "所有文件 (*.*)|*.*"
.Flags = &H4
.ShowOpen
Text3.Text = .FileName
End With
OpenErr:
End Sub
'传送文件按钮
Private Sub Command2_Click()
If Dir(Text3.Text) = "" Or Text3.Text = "" Then
MsgBox "没有可以传送的文件~", vbCritical, "Server"
Else
wskServer(0).SendData "SendFile," & Dir(Text3.Text) & "," & FileLen(Text3.Text)
End If
End Sub
Private Sub Form_Load()
Client.Show
List1.AddItem "就绪"
OnSend = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
wskServer(0).Close
End Sub
Private Sub Timer1_Timer()
If wskServer(0).State = sckClosing Then
List1.Clear
List1.AddItem "对方的连接已关闭..."
wskServer(0).Close
wskServer(0).LocalPort = Text2.Text
wskServer(0).Listen
List1.AddItem "重新开始监听端口 : " & Text2.Text
Command2.Enabled = False '传送按钮不可用
End If
End Sub
Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If wskServer(0).State <> sckClosed Then wskServer(0).Close
'接受具有 requestID 参数的连接。
wskServer(0).Accept requestID
List1.AddItem "接受了 :" & Str$(requestID) & " 的连接"
Command2.Enabled = True '传送按钮可用
End Sub
Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim WskChat As String
wskServer(0).GetData WskChat
If WskChat = "NoThanks" Then
MsgBox "对方拒收你发送的文件.", vbExclamation, "Server"
ElseIf WskChat = "OkSend" Then
MsgBox "对方接受了你的文件." & vbCrLf & vbCrLf & "单击“确定”开始传送...", vbInformation, "Server"
GetFileNum = FreeFile '取得未使用的文件号
LenFile = FileLen(Text3.Text) '获得需传送的文件的长度
'------------------
ProBarLen = LenFile '用于进度显示
VarPlus = 0
'------------------
Open Text3.Text For Binary As #GetFileNum '打开需传送的文件
OnSend = True
Command2.Enabled = False
Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
'ElseIf WskChat = "SaveOk" Then
'Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
'ElseIf WskChat = "SaveEnd" Then
'Close #GetFileNum
'Command2.Enabled = True
'MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
End If
End Sub
'上面[被注释的是]通过接收对方的返回信息判断是否可开始下次的传送动作!
'下面是通过SendComplete来完成~!在一次数据发送完毕后,WinSock会触发它!
Private Sub wskServer_SendComplete(Index As Integer)
If OnSend Then
If 0 = LenFile Then
Close #GetFileNum
OnSend = False
Command2.Enabled = True
MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
Else
Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
End If
End If
End Sub
'为了清晰,下面分别用两个子过程来完成计算这次还可以传多少个字节的数据和传送数据
Private Function SplitFile() As Long
Dim GetCount As Long
'计算出这次可发送的字节数
If LenFile >= 8192 Then
GetCount = 8192
LenFile = LenFile - GetCount
Else
GetCount = LenFile
LenFile = LenFile - GetCount
End If
'-----------------------------------------
VarPlus = VarPlus + GetCount
ProBar.Value = (VarPlus / ProBarLen) * 100
'-----------------------------------------
SplitFile = GetCount
End Function
Private Sub TCPSendFile(objWinSock As Winsock, FileNumber As Integer, SendLen As Long)
Dim FileByte() As Byte, i As Long
ReDim FileByte(SendLen - 1) '按照需传送的大小分配数组
Get #FileNumber, , FileByte
objWinSock.SendData FileByte
End Sub
新建文件WSF_TCP.vbp
------------------------
Type=Exe
Form=Setver.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#../../../../WINDOWS/System32/stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; mswinsck.ocx
Form=Client.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; Comdlg32.ocx
Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX
IconForm="Setver"
Startup="Setver"
HelpFile=""
Title="WSF_TCP"
ExeName32="WSF_TCP.exe"
Command32=""
Name="WSF_TCP"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="maple"
VersionLegalTrademarks="qyii"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
-----------------------------------------OK了, :) 谢谢作者共享他的经典代码,辛苦了!
作者:CSDN 许仙
'Homepage : jjweb.126.com
'MSN :Coderxu#hotmail.com
'QQ:19030300
'转载请保持文章完整,保存以上作者信息 请珍惜他人劳动成果
新建文件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"
ClientHeight = 1230
ClientLeft = 4965
ClientTop = 4845
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1230
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 = 0
TabIndex = 6
Top = 1020
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
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
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, "⊙_⌒γ - Client"
'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
新建文件Setver.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 Setver
BorderStyle = 1 'Fixed Single
Caption = "Server"
ClientHeight = 1935
ClientLeft = 3045
ClientTop = 2535
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1935
ScaleWidth = 4665
Begin MSWinsockLib.Winsock wskServer
Index = 0
Left = 1830
Top = 90
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin ComctlLib.ProgressBar ProBar
Height = 195
Left = 780
TabIndex = 11
Top = 953
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
End
Begin VB.Timer Timer1
Interval = 100
Left = 1560
Top = 480
End
Begin VB.ListBox List1
Height = 600
Left = 0
TabIndex = 10
Top = 1320
Width = 4665
End
Begin MSComDlg.CommonDialog Comdlg
Left = 2100
Top = 390
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command2
Caption = "传送"
Enabled = 0 'False
Height = 285
Left = 3870
TabIndex = 8
Top = 908
Width = 765
End
Begin VB.CommandButton Command1
Caption = "浏览"
Height = 285
Left = 3870
TabIndex = 7
Top = 495
Width = 765
End
Begin VB.TextBox Text3
Height = 270
Left = 780
TabIndex = 6
Top = 495
Width = 3015
End
Begin VB.CheckBox Check1
Caption = "连接/等待"
Height = 225
Left = 3510
TabIndex = 4
Top = 75
Width = 1125
End
Begin VB.TextBox Text2
Height = 270
Left = 2790
TabIndex = 3
Text = "5252"
Top = 52
Width = 675
End
Begin VB.TextBox Text1
BackColor = &H8000000F&
Enabled = 0 'False
Height = 270
Left = 780
TabIndex = 1
Text = "127.0.0.1"
Top = 52
Width = 1455
End
Begin VB.Label Label4
Caption = "进度:"
Height = 180
Index = 1
Left = 30
TabIndex = 9
Top = 960
Width = 450
End
Begin VB.Label Label4
Caption = "文件:"
Height = 180
Index = 0
Left = 30
TabIndex = 5
Top = 540
Width = 450
End
Begin VB.Label Label2
Caption = "端口:"
Height = 180
Left = 2310
TabIndex = 2
Top = 97
Width = 450
End
Begin VB.Label Label1
Caption = "IP 地址:"
Height = 180
Left = 30
TabIndex = 0
Top = 97
Width = 720
End
End
Attribute VB_Name = "Setver"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim GetFileNum As Integer
Dim LenFile As Long
Dim OnSend As Boolean
'--------------------
Dim ProBarLen As Long
Dim VarPlus As Long
Private Sub Check1_Click()
If Check1.Value Then
wskServer(0).LocalPort = Text2.Text
wskServer(0).Listen
List1.Clear
List1.AddItem "开始监听端口 : " & Text2.Text
Else
wskServer(0).Close
List1.Clear
List1.AddItem "停止端口监听."
Command2.Enabled = False '传送按钮不可用
End If
End Sub
Private Sub Command1_Click()
With Comdlg
.CancelError = True
On Error GoTo OpenErr
.DialogTitle = "打开一个测试文件..."
.Filter = "所有文件 (*.*)|*.*"
.Flags = &H4
.ShowOpen
Text3.Text = .FileName
End With
OpenErr:
End Sub
'传送文件按钮
Private Sub Command2_Click()
If Dir(Text3.Text) = "" Or Text3.Text = "" Then
MsgBox "没有可以传送的文件~", vbCritical, "Server"
Else
wskServer(0).SendData "SendFile," & Dir(Text3.Text) & "," & FileLen(Text3.Text)
End If
End Sub
Private Sub Form_Load()
Client.Show
List1.AddItem "就绪"
OnSend = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
wskServer(0).Close
End Sub
Private Sub Timer1_Timer()
If wskServer(0).State = sckClosing Then
List1.Clear
List1.AddItem "对方的连接已关闭..."
wskServer(0).Close
wskServer(0).LocalPort = Text2.Text
wskServer(0).Listen
List1.AddItem "重新开始监听端口 : " & Text2.Text
Command2.Enabled = False '传送按钮不可用
End If
End Sub
Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If wskServer(0).State <> sckClosed Then wskServer(0).Close
'接受具有 requestID 参数的连接。
wskServer(0).Accept requestID
List1.AddItem "接受了 :" & Str$(requestID) & " 的连接"
Command2.Enabled = True '传送按钮可用
End Sub
Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim WskChat As String
wskServer(0).GetData WskChat
If WskChat = "NoThanks" Then
MsgBox "对方拒收你发送的文件.", vbExclamation, "Server"
ElseIf WskChat = "OkSend" Then
MsgBox "对方接受了你的文件." & vbCrLf & vbCrLf & "单击“确定”开始传送...", vbInformation, "Server"
GetFileNum = FreeFile '取得未使用的文件号
LenFile = FileLen(Text3.Text) '获得需传送的文件的长度
'------------------
ProBarLen = LenFile '用于进度显示
VarPlus = 0
'------------------
Open Text3.Text For Binary As #GetFileNum '打开需传送的文件
OnSend = True
Command2.Enabled = False
Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
'ElseIf WskChat = "SaveOk" Then
'Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
'ElseIf WskChat = "SaveEnd" Then
'Close #GetFileNum
'Command2.Enabled = True
'MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
End If
End Sub
'上面[被注释的是]通过接收对方的返回信息判断是否可开始下次的传送动作!
'下面是通过SendComplete来完成~!在一次数据发送完毕后,WinSock会触发它!
Private Sub wskServer_SendComplete(Index As Integer)
If OnSend Then
If 0 = LenFile Then
Close #GetFileNum
OnSend = False
Command2.Enabled = True
MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
Else
Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
End If
End If
End Sub
'为了清晰,下面分别用两个子过程来完成计算这次还可以传多少个字节的数据和传送数据
Private Function SplitFile() As Long
Dim GetCount As Long
'计算出这次可发送的字节数
If LenFile >= 8192 Then
GetCount = 8192
LenFile = LenFile - GetCount
Else
GetCount = LenFile
LenFile = LenFile - GetCount
End If
'-----------------------------------------
VarPlus = VarPlus + GetCount
ProBar.Value = (VarPlus / ProBarLen) * 100
'-----------------------------------------
SplitFile = GetCount
End Function
Private Sub TCPSendFile(objWinSock As Winsock, FileNumber As Integer, SendLen As Long)
Dim FileByte() As Byte, i As Long
ReDim FileByte(SendLen - 1) '按照需传送的大小分配数组
Get #FileNumber, , FileByte
objWinSock.SendData FileByte
End Sub
新建文件WSF_TCP.vbp
------------------------
Type=Exe
Form=Setver.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#../../../../WINDOWS/System32/stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; mswinsck.ocx
Form=Client.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; Comdlg32.ocx
Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX
IconForm="Setver"
Startup="Setver"
HelpFile=""
Title="WSF_TCP"
ExeName32="WSF_TCP.exe"
Command32=""
Name="WSF_TCP"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="maple"
VersionLegalTrademarks="qyii"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
-----------------------------------------OK了, :) 谢谢作者共享他的经典代码,辛苦了!
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- C#源码 任意语言任意大小任意字体任意排列 字符汉字取模及显示 可以自由编辑点阵 通过串口发送 pc端和手机端
- Linux下父进程通过管道发送文件名给子进程，子进程获取文件名后首先判断文件是否存在，不存在，通过管道返回错误信息，存在，将文件内容返回给父进程
- 通用权限管理系统组件 (GPM - General Permissions Manager) 中实现文件发送接收功能，附源码
- 网站错误处理、运行时间、文件大小、接受和发送编码设定
- 通用权限管理系统组件 (GPM - General Permissions Manager) 中实现文件发送接收功能，附源码
- 通用权限管理系统组件 (GPM - General Permissions Manager) 中实现文件发送接收功能，附源码
- Java实现Socket发送和接收文件的代码(java 粘包个人联系)
- openfire 发送文件错误 error 403
- C# websocket与html js实现文件发送与接收处理
- Socket 发送或接收文件
- split命令_Linux split 命令用法详解：分割任意大小的文件
- PHP:显示文件上传进度及上传任意大小的文件
- php发送与接收流文件的方法
- boa源码解析（1）-接收请求，发送html的流程
- 使用setsockopt（）接口，设置TCP的接收与发送超时,Invalid argument错误问题
- 关于导入新项目的问题——项目文件有错，但是子文件没任何错误的解决办法
- C#实现文件的发送和接收
- php模拟post向WebService发送内容及接收文件
- Webservice的wsdl文件解析与Soap消息的发送、接收(不生成java客户端代码)
- IIS7源码泄露及文件类型解析错误——最新解决方案