Question

VB中的Winsock1发送图片，还原时出错

发送端，控件Winsock1属性index=0，Command1，Picture1
Private Sub Command1_Click()
Dim PBag As New PropertyBag '得到图片信息
Dim PictureByt() As Byte '保存图像
PBag.WriteProperty "Picture", Picture1.Picture
PictureByt = PBag.Contents '获取容器Byte到PictureByt()数组中
Winsock1(Winsock1.Count - 1).SendData PictureByt '发送数据
End Sub
Private Sub Form_Load()
Winsock1(0).Close
Winsock1(0).RemoteHost = "192.168.1.10" '这里填写你的静态IP或者是动态域名
Winsock1(0).RemotePort = 8002 '这里填写连接的端口
Winsock1(0).Connect
End Sub
接收端,控件Winsock1，Picture1
Private Sub Form_Load()
Winsock1.Close
Winsock1.LocalPort = 8002 '这里填写你要监听的端口
Winsock1.Listen '开始监听
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim bytData() As Byte '接收图片
Dim PBag As New PropertyBag '图片信息
ReDim bytData(1 To Winsock1.BytesReceived) '接收图片大小
Winsock1.GetData bytData '读取缓冲区数据
PBag.Contents = bytData
Set Picture1.Picture = PBag.ReadProperty("Picture") '设置图片
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
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)
Winsock1.Close '如果出错则关闭连接
End Sub

接收端这句代码出错，PBag.Contents = bytData，无效的过程调用或参数

Answer 1

这里有个例子，你看看有没有什么启发。

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) As Boolean
Dim bytData() As Byte
Private Sub Command1_Click()
    Winsock1.RemoteHost = Text1.Text
    Dim arr() As Byte
    Dim i As New PropertyBag
    i.WriteProperty "image", Picture1.Picture
    ReDim arr(1 To LenB(i.Contents))
    arr = i.Contents
    If UBound(arr) <= 8192 Then '如果要发送的文件小于数据块大小，直接发送
        Winsock1.SendData arr '发送数据
        Exit Sub
    End If
End Sub

Private Sub Form_Load()
    With Winsock1    '信息发送与接收
        .Protocol = sckUDPProtocol '使用UDP协议
        .RemotePort = 9001 '要连接的端口
        .LocalPort = 9001
        .Bind  '绑定到本地的端口上
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Erase bytData
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim arr() As Byte
    ReDim arr(1 To bytesTotal)
    Winsock1.GetData arr
    ReDim Preserve bytData(1 To bytesTotal)
    CopyMemory bytData(1), arr(0), bytesTotal
    Dim i As New PropertyBag
    i.Contents = bytData
    Picture2.Picture = i.ReadProperty("image")
End Sub

追问

ReDim Preserve bytData(1 To bytesTotal)
这句有问题，能帮看下吗？提示变量未定义！

追答

怎么会呢？我运行的完全没问题！