发信人: hahahawk(哈哈天使)
整理人: gzwsh(2002-11-05 22:54:06), 站内信件
|
今天下午做了一个从客户端向服务端传送二进制文件包括执行程序的详细例子：
客户端程序：
'客户端程序，by hahahawk
Option Explicit
Dim buffer(8191) As Byte
Dim flen As Long '文件长度
Dim flag As String '标志：要传输的是文件的长度还是文件本身
Dim trans_num As Integer
Dim fileNum As Integer
Private Sub cmdstart_Click()
Winsock1.Connect
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim xFileName As String
xFileName = App.Path & "\..\filecopy\a1.exe"
fileNum = FreeFile
Open xFileName For Binary As #fileNum
flen = LOF(fileNum)
Label1.Caption = Label1.Caption & vbCrLf & "要传输的文件长度为" & Str(flen)
Winsock1.RemoteHost = "wqnotebook"
Winsock1.RemotePort = 2002
flag = "head"
trans_num = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Close #fileNum
End Sub
Private Sub Winsock1_Connect()
cmdstart.Enabled = False
Label1.Caption = Label1.Caption & vbCrLf & "已经连接上,开始发送"
If flag = "head" Then
trans_num = readblock(fileNum)
Winsock1.SendData Str(trans_num)
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim s1 As String
Winsock1.GetData s1, vbString
Debug.Print s1
If s1 = "ok" Then
If flag = "file" Then
If trans_num > 0 Then Winsock1.SendData buffer
Else
If trans_num = 1024 * 8 Then
trans_num = readblock(fileNum)
If trans_num > 0 Then
Winsock1.SendData Str(trans_num)
Else
Label1.Caption = Label1.Caption & vbCrLf & "整个文件传送完毕"
End If
Else
Label1.Caption = Label1.Caption & vbCrLf & "整个文件传送完毕"
End If
End If
Else
If Winsock1.State <> sckClosed Then Winsock1.Close
Label1.Caption = Label1.Caption & vbCrLf & "服务器无法接受"
cmdstart.Enabled = True
End If
End Sub
Private Sub Winsock1_SendComplete()
If flag = "file" Then
Label1.Caption = Label1.Caption & vbCrLf & "发送块完毕"
flag = "head"
Else
Label1.Caption = Label1.Caption & vbCrLf & "交换块大小" & trans_num
flag = "file"
End If
End Sub
Public Function readblock(fileid As Integer)
Dim i As Integer
i = 0
Do While Not EOF(fileid)
If i = 0 Then Debug.Print i
If i = 4095 Then Debug.Print i
If i = 4096 Then Debug.Print i
If i = 4097 Then Debug.Print i
Get #fileid, , buffer(i)
i = i + 1
If i = 1024 * 8 Then Exit Do
Loop
readblock = i
End Function
服务端程序：
'服务端程序,by hahahawk
Option Explicit
Dim flag As String
Dim flen As Long
Dim trans_num As Integer
Dim fileNum As Integer
Private Sub Form_Load()
Winsock1.LocalPort = 2002
Winsock1.Listen
flag = "head"
Dim xFileName As String
fileNum = FreeFile()
xFileName = App.Path & "\..\filecopy\a2.exe"
Open xFileName For Binary Access Write Lock Write As #fileNum
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Winsock1.State <> sckClosed Then Winsock1.Close
Close #fileNum
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim buffer() As Byte, s1 As String
If flag = "head" Then
Winsock1.GetData s1, vbString
Label1.Caption = Label1.Caption & vbCrLf & "客户方准备发送长度为" & s1 & "的块"
trans_num = Val(s1)
flag = "file"
Winsock1.SendData "ok"
Else
ReDim buffer(trans_num)
Winsock1.GetData buffer, vbArray + vbByte
flag = "head"
Label1.Caption = Label1.Caption & vbCrLf & "长度为" & Str(trans_num) & "的块接受完毕"
Dim i As Integer
i = 0
For i = 0 To trans_num - 1
Put #fileNum, , buffer(i)
Next
Winsock1.SendData "ok"
End If
End Sub
Private Sub Winsock1_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)
MsgBox Description
End Sub
这样就可以传送二进制文件包括执行程序。
可以发现，这样传送的副本会比原本大一个字节，但是不影响程序的执行。至于为什么大一个字节，其实是在读取源文件的结尾到缓冲区的时候，会多取一个byte。大家可以思索一下。当然简单的办法可以限制最后一个byte写入副本。
值得注意的是：每次最多只能发送1024*8byte,所以要循环。
----
私章 签名
▇▇▇▇▇▇▇
▇横空出世版▇
▇哈哈天使之▇ 哈哈天使
▇私務專用印▇ 网海琼楼
▇▇▇▇▇▇▇ |
|