Option Explicit
 
Dim nBytesTotal As Long
Dim nBytesRead As Long
Dim nFile As Integer
 
 
 
Public Sub WinsockSendBinaryFile(ByVal sFile As String, Optional Sinn As String)
  Dim F As Integer
  Dim sBuffer As String
  Dim nFileSize As Long
  Dim nFilePos As Long
  Dim nBytesToRead As Long
 
  ' Größe der einzelnen Datenpakete
  Const BlockSize = 8100
 
  ' Datei im Binary-Mode öffnen
  F = FreeFile
  Open sFile For Binary As #F
 
  ' Dateiname extrahieren
  If InStr(sFile, "\") > 0 Then
    sFile = Mid$(sFile, InStrRev(sFile, "\") + 1)
  End If
 
  ' Dateigröße
  nFileSize = LOF(F)
 
  ' Sendevorgang starten
  With wsData
    ' Empfänger mitteln, welche Datei und wieviele
    ' Daten gesendet werden
    .SendData "<begin " & CStr(nFileSize) & ";" & sFile & ";" & Sinn & ">"
 
    ' Datei blockweise senden
    Do While nFilePos < nFileSize
      nBytesToRead = BlockSize
      If nFilePos + nBytesToRead > nFileSize Then
        nBytesToRead = nFileSize - nFilePos
      End If
 
      ' Datenblock lesen
      sBuffer = Space$(nBytesToRead)
      Get #F, , sBuffer
 
      ' Datenblock senden
      .SendData sBuffer
 
      ' Fortschritt aktualisieren
      nFilePos = nFilePos + nBytesToRead
      'txtStatusSend.Text = CStr(nFilePos) + " von " + CStr(nFileSize) + "" & _
        "Bytes versandt"
 
      ' Wichtig!
      DoEvents
    Loop
  End With
 
  ' Datei schließen (Sendevorgang beendet)
  Close #F
End Sub
 
' Wenn Daten ankommen...
Private Sub wsData_DataArrival(ByVal bytesTotal As Long)
  Dim sData As String
  Dim sTemp As String
  Static sFile As String
 
  ' Daten holen
  wsData.GetData sData, vbString
 
  If Left$(sData, 12) = "<begin " Then
    ' Aha... eine neue Datei wird gesendet
    sData = Mid$(sData, 13)
    sTemp = Left$(sData, InStr(sData, ">") - 1)
    sData = Mid$(sData, InStr(sData, ">") + 1)
 
    ' Dateigröße und Dateiname ermitteln
    If InStr(sTemp, ";") > 0 Then
      Stop
      nBytesTotal = Val(Left$(sTemp, InStr(sTemp, ";") - 1))
      sFile = Mid$(sTemp, InStr(sTemp, ";") + 1)
    Else
      nBytesTotal = Val(sTemp)
    End If
 
    ' Falls kein Dateiname angegeben wurde,
    ' Daten unter "temp.dat" speichern
    If Len(sFile) = 0 Then sFile = "temp.dat"
 
    ' ggf. Datei löschen, falls bereits existiert
    On Error Resume Next
    Kill App.Path & "\" & sFile
    On Error GoTo 0
 
    ' Datei im Binary-Mode öffnen
    nFile = FreeFile
    Open App.Path & "\" & sFile For Binary As #nFile
 
    ' bisher gelesene Bytes zurücksetzen
    nBytesRead = 0
  End If
 
  If Len(sData) > 0 And nFile > 0 Then
    ' bisher empfangene Daten...
    nBytesRead = nBytesRead + Len(sData)
 
    ' Daten in Datei speichern
    Put #nFile, , sData
 
    ' evtl. Fortschritt anzeigen
    'txtStatusRecieve.Text = CStr(nBytesRead) & " von " & CStr(nBytesTotal) & "" & _
      "Bytes empfangen"
 
    ' Wenn alle Bytes empfangen wurden, Datei schließen
    If nBytesRead = nBytesTotal Then
      Close #nFile
      nFile = 0
 
      ' Bild anzeigen
      'Image1.Picture = LoadPicture(App.Path & "\" & sFile)
   End If
  End If
End Sub
 
 
 
Private Sub Form_Load()
  ' UDP-Protokoll
  With wsData
    .Protocol = sckUDPProtocol
    .Bind 12344, .LocalIP
  End With
End Sub
 
 
Function SendFile(Pfad As String, Optional Sinn As String, Optional Hidden As _
  Boolean)
   WinsockSendBinaryFile Pfad, Sinn
End Function

   frmDateitransfer.wsData.RemotePort = Connection.RemotePort
   frmDateitransfer.wsData.RemoteHost = Connection.RemoteHost

____________________________________