请问如何使用Winsock控件发送,接送文件?最好给出个例子!谢谢!

miss 2000-07-16 10:19:00
...全文
101 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
yepo 2000-07-25
  • 打赏
  • 举报
回复
'发送文件
Private Sub sendfile(filename As String)
Dim s As String * 8
Dim fn As String * 50
Dim i As Integer
Dim b(4096) As Byte
Dim c() As Byte
Dim filelength As Long
Open filename For Binary Access Read As #1
filelength = LOF(1)
If filelength = 0 Then
Unload Me
End If
s = Trim(Str(filelength))
tcp.SendData s
i = 0
Do While True
If Mid(filename, Len(filename) - i, 1) = "\" Then
fn = Mid(filename, Len(filename) - i + 1, i)
Exit Do
Else
i = i + 1
End If
Loop
fn = read_hz(fn, 50)
tcp.SendData fn
ReDim c(filelength Mod 4096)
' Shape1.Width = 0
For i = 0 To filelength \ 4096
If i = filelength \ 4096 Then
Get 1, , c
tcp.SendData c

Else
Get 1, , b
tcp.SendData b
' Shape1.Width = 2550 * i / (filelength \ 4096)
End If

Next

' tcp.GetData b, vbByte + vbArray, read_length
' Put 1, , b
'Next
' tcp.GetData s1, vbByte
' Put 1, , s1

Close #1
' DoEvents
End Sub

'接收文件 请修改一下即可
Private Sub tcp_DataArrival(ByVal bytesTotal As Long)
Dim buffer As String
Dim a() As Byte


Dim f As New FileSystemObject
If state = 0 Then
tcp.GetData buffer, , 65
ret.length = Left(buffer, 8)
ret.jym = Mid(buffer, 9, 4)
ret.fhz = Mid(buffer, 13, 3)
ret_string = Trim(Mid(buffer, 16, 50))
If ret.fhz <> "000" Then
MsgBox (ret_string)
Unload Me
Exit Sub
End If

filename = App.Path + "\" + Trim(ret_string)
filelength = Val(ret.length)
Open filename For Binary Access Write As #1
state = 1
bytesTotal = bytesTotal - 65
length = 0
Shape2.Width = 0
'Shape1.Width = 2550 * length / filelength
End If
If state = 1 And bytesTotal > 0 Then
ReDim a(bytesTotal)
length = length + bytesTotal
tcp.GetData a, vbArray + vbByte
Put 1, , a
Shape2.Width = 2550 * length / filelength
'Shape1.Refresh

End If
If length >= filelength Then
Close #1
'If Right(filename, 3) = "DOC" Then
' Shell "winword " + filename, vbNormalFocus
'Else
' Shell "kodakimg " + filename, vbNormalFocus
'End If
Shell "start " + filename, vbNormalFocus
tcp.Close
state = 0
Unload Me

End If
' DoEvents
End Sub
coolyangbo 2000-07-25
  • 打赏
  • 举报
回复
用Winsock传递数据时,是一种C/S程序
服务器:
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim Ws_I As Integer
Dim Yb(100) As String

Private Sub Form_Load()
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1
Ws1(0).LocalPort = 1001
Ws_I = 0
Ws1(0).Listen
End Sub

Private Sub Ws1_Close(Index As Integer)
Yb(Index) = ""
End Sub

Private Sub Ws1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Ws_I = Ws_I + 1
Load Ws1(Ws_I)
Ws1(Ws_I).Accept requestID
List1.AddItem Ws_I
End Sub

Private Sub Ws1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Str As String
Ws1(Index).GetData Str, vbString
Ws1(GetId(Str)).SendData GetNeiRong(Str)
List1.AddItem Str
End Sub

客户端:

Option Explicit
Private Sub Cmd_Send_Click()
On Error GoTo out
Ws1.SendData T1.Text & " " & Id
Exit Sub
out:
MsgBox "你要聊的对象已退出!", vbInformation, "警告"
Unload Me
End Sub

Private Sub Form_Load()
Ws1.RemoteHost = "yangbo"
Ws1.RemotePort = 1001
Ws1.Connect
End Sub

Private Sub Ws1_DataArrival(ByVal bytesTotal As Long)
Dim str As String
Ws1.GetData str, vbString
List1.AddItem str
End Sub

Public Sub Yb_Show(Key As Integer)
Id = Key
Me.Show
End Sub
以上事例中便有传递数据的方法,你只需改改IP即可

1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧