WsockErr: 'Falsches Sendeformat
    bAlreadyRunning = False
    nGesamtlaengePaket = 0
    sWsockZwischenspeicher = ""
End Sub
 
Private Sub Winsock1DatenEmpf(Daten As String)
'... Datenpaket empfangen
If MidB(Daten, 1, 1) = ChrB(1) Then 'Datei empfangen
    Dim TempArr() As Byte
    TempArr() = MidB(Daten, 2) 'String in Byte-Array kopieren, damit VB den 
    ' String nicht als Unicodestring ansieht und zurückkonvertiert
    Open "C:\TimeOfDownloaded\temp.bmp" For Binary As 1
    Put 1, , TempArr
    Close 1
End If
End Sub
Private Sub Command1_Click()
        WSockSendenB "/DOWNDESK/"
End Sub

Option Explicit
 
Public Function StringB(Number As Long, Character As String)
Dim CharInt As String
CharInt = MidB$(Character, 1, 1)
StringB = String(Int(Number / 2), CharInt & CharInt)
If Number Mod 2 = 1 Then StringB = StringB & CharInt
End Function
 
Public Sub LongNachByte(Zahl As Long, ByteArr() As Byte)
ReDim ByteArr(3) As Byte
ByteArr(0) = Int(Zahl / 256 ^ 3)
ByteArr(1) = Int((Zahl Mod 256& * 256& * 256&) / 256 ^ 2)
ByteArr(2) = Int((Zahl Mod 256& * 256&) / 256)
ByteArr(3) = Zahl Mod 256
End Sub
 
Public Sub WSockSendenB(TextB As String)
On Error Resume Next
Dim TextLaenge As String
Dim TextLaengeArr() As Byte
LongNachByte LenB(TextB), TextLaengeArr
TextLaenge = TextLaengeArr
Dim asdaArr() As Byte
asdaArr = TextLaenge & TextB
Winsock1.SendData asdaArr
If Not Err.Number = 0 Then
    Winsock1.Close
    Winsock1_Close
End If
End Sub
 
Private Sub Winsock1_Close()
Winsock1_DataArrival 0
End Sub
 
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strTemp As String, arrTemp() As Byte, lngTemp As Long, bAlreadyRunning As _
  Boolean
On Error GoTo WsockErr
Static sWsockZwischenspeicher As String
Static sPaketZwischenspeicher As String
Static nGesamtlaengePaket As Long
Static nBereitsuebertragenPaket As Long
 
If bytesTotal = 0 Then
    sWsockZwischenspeicher = ""
    sPaketZwischenspeicher = ""
    nGesamtlaengePaket = 0
    Exit Sub
End If
 
Winsock1.GetData arrTemp, vbArray + vbByte
strTemp = arrTemp
sWsockZwischenspeicher = sWsockZwischenspeicher & strTemp
 
If bAlreadyRunning Then Exit Sub
 
bAlreadyRunning = True
 
If nGesamtlaengePaket > 0 Then
    MidB$(sPaketZwischenspeicher, nBereitsuebertragenPaket + 1) = _
      MidB$(sWsockZwischenspeicher, 1, nGesamtlaengePaket - _
      nBereitsuebertragenPaket)
    lngTemp = LenB(MidB$(sWsockZwischenspeicher, 1, nGesamtlaengePaket - _
    nBereitsuebertragenPaket))
    nBereitsuebertragenPaket = nBereitsuebertragenPaket + lngTemp
    sWsockZwischenspeicher = MidB(sWsockZwischenspeicher, 1 + lngTemp)
    If nGesamtlaengePaket = nBereitsuebertragenPaket Then
        nGesamtlaengePaket = 0
        If Not sPaketZwischenspeicher = "" Then Winsock1DatenEmpf _
          sPaketZwischenspeicher
    End If
End If
 
Do While LenB(sWsockZwischenspeicher) >= 4 And nGesamtlaengePaket = 0
    nGesamtlaengePaket = CLng(AscB(MidB(sWsockZwischenspeicher, 1, 1))) * 256& _
      * 256& * 256& + CLng(AscB(MidB(sWsockZwischenspeicher, 2, 1))) * 256& * _
      256& + CLng(AscB(MidB(sWsockZwischenspeicher, 3, 1))) * 256& + CLng(AscB( _
      MidB(sWsockZwischenspeicher, 4, 1)))
    If Not nGesamtlaengePaket = 0 Then
        nBereitsuebertragenPaket = LenB(MidB$(sWsockZwischenspeicher, 5, _
          nGesamtlaengePaket))
        sPaketZwischenspeicher = StringB(nGesamtlaengePaket, ChrB(0))
        MidB$(sPaketZwischenspeicher, 1) = MidB$(sWsockZwischenspeicher, _
          5, nGesamtlaengePaket)
    End If
    sWsockZwischenspeicher = MidB$(sWsockZwischenspeicher, 5 + _
      nBereitsuebertragenPaket)
    If nGesamtlaengePaket = nBereitsuebertragenPaket Then
        nGesamtlaengePaket = 0
        If Not sPaketZwischenspeicher = "" Then Winsock1DatenEmpf _
          sPaketZwischenspeicher
    End If
Loop
 
bAlreadyRunning = False
Exit Sub
 
WsockErr: 'Falsches Sendeformat
    bAlreadyRunning = False
    nGesamtlaengePaket = 0
    sWsockZwischenspeicher = ""
End Sub
 
Private Sub Winsock1DatenEmpf(Daten As String)
'... Datenpaket empfangen
If Daten = "/DOWNDESK/" Then 'Datei senden
    Open "C:\temp.bmp" For Binary As 1
    Dim TempStrDatei As String, TempArrDatei() As Byte
    ReDim TempArrDatei(LOF(1) - 1) as Byte
    Get 1, , TempArrDatei
    Close 1
    TempStrDatei = TempArrDatei
    WSockSendenB ChrB(1) & TempStrDatei
End If
End Sub