📄 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 = "网络文件传输 服务器端 www.play78.com"
ClientHeight = 2565
ClientLeft = 3045
ClientTop = 2535
ClientWidth = 4665
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2565
ScaleWidth = 4665
Begin MSWinsockLib.Winsock wskServer
Index = 0
Left = 3120
Top = 1560
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin ComctlLib.ProgressBar ProBar
Height = 195
Left = 780
TabIndex = 11
Top = 840
Width = 3015
_ExtentX = 5318
_ExtentY = 344
_Version = 327682
Appearance = 0
End
Begin VB.Timer Timer1
Interval = 100
Left = 1260
Top = 1620
End
Begin VB.ListBox List1
Height = 780
Left = 0
TabIndex = 10
Top = 1200
Width = 4665
End
Begin MSComDlg.CommonDialog Comdlg
Left = 2370
Top = 1320
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command2
Caption = "传送"
Enabled = 0 'False
Height = 285
Left = 3870
TabIndex = 8
Top = 795
Width = 765
End
Begin VB.CommandButton Command1
Caption = "浏览"
Height = 285
Left = 3870
TabIndex = 7
Top = 435
Width = 765
End
Begin VB.TextBox Text3
Height = 270
Left = 780
TabIndex = 6
Top = 435
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 Label3
Caption = "海阔天空收集整理 http://www.play78.com"
Height = 315
Left = 30
TabIndex = 12
Top = 2100
Width = 4575
End
Begin VB.Label Label4
Caption = "进度:"
Height = 180
Index = 1
Left = 30
TabIndex = 9
Top = 840
Width = 450
End
Begin VB.Label Label4
Caption = "文件:"
Height = 180
Index = 0
Left = 30
TabIndex = 5
Top = 480
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
' **********************************************************************
' 描 述：vb用Winsock传输文件
' Play78.com : 网站导航，源码之家，绝对开源
' 海阔天空收集整理
' 网址：http://www.play78.com/
' QQ：13355575
' e-mail:hglai@eyou.com
' 编写日期：2005年08月10日
' **********************************************************************
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)
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, "www.play78.com服务器断提示"
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -