Dim bSending As Boolean
Dim bData() As Byte
Dim bComplete As Boolean
Dim iSize As Long
Dim iSent As Long
Dim xSize As Long
Dim sTemp As String
Dim vData As Variant
 
Private Sub Command1_Click()
 
Winsock1.Connect "127.0.0.1", 124
Do
DoEvents
Loop Until Winsock1.State = 7 Or Winsock1.State = 9
If Winsock1.State = 7 Then
    MsgBox "Übertragung Starten"
    SendPicture Picture1, Winsock1
Else: MsgBox "error"
End If
 
End Sub
 
Private Sub Form_Load()
 
    bSending = False
    ReDim bTemp(0)
 
    With oSocket
        .Close
        .LocalPort = 124
        .Listen
    End With
 
End Sub
 
Sub SendPicture(Picture As PictureBox, Socket As Winsock)
 
    'On Error GoTo Error
 
    Dim vPicture() As Byte
    Dim pSize, pPosition As Long
 
 
    With New PropertyBag
        .WriteProperty "Picture", Picture.Image
        vPicture = .Contents
    End With
 
    pSize = UBound(vPicture)
    xSize = pSize
 
    Socket.SendData pSize & Chr(0)
    DoEvents
 
    For pPosition = 1 To pSize - 128 Step 128
        Socket.SendData Mid(vPicture, pPosition, 512)
 
        bComplete = False
        Me.Caption = pPosition
        Do
        DoEvents
        Loop Until bComplete
 
    Next pPosition
 
    MsgBox "Fertig"
    Exit Sub
Error:
End Sub
 
Private Sub oSocket_ConnectionRequest(ByVal requestID As Long)
    With oSocket
        .Close
        .Accept requestID
    End With
End Sub
 
Private Sub oSocket_DataArrival(ByVal bytesTotal As Long)
    For x& = 1 To bytesTotal
 
        If bSending Then
            oSocket.GetData bData(iSent), vbByte, 1
 
            If iSent = iSize Then
                bSending = False
 
                MsgBox "Alles Da"
 
                vData = bData
                With New PropertyBag
                    .Contents = vData
                    Image1.Picture = .ReadProperty("Picture")
                End With
 
            End If
 
            iSent = iSent + 1
 
        Else
            oSocket.GetData sTemp, vbString, 1
 
            If sTemp = Chr(0) Then
 
                iSize = sData
                MsgBox iSize
                ReDim bData(iSize)
                sData = ""
                iSent = 0
                bSending = True
            Else
                sData = sData & sTemp
            End If
        End If
    Next
End Sub
 
Private Sub Winsock1_SendComplete()
    bComplete = True
End Sub