' Datei "uploaden"
Friend Function UploadFile(ByVal LocalFile As String, _
  ByVal ServerFile As String, _
  Optional ByVal StartUploadAt As Long = 0)
 
  Dim TmpPort As Long
  Dim TmpPortStr As String
  Dim SendBuff As String
 
  ' Servermodus auf Binär stellen
  If SendCommand(OvermitBinary, CommandOk, CommandOk, _
    CommandFail) = False Then Exit Function
 
NewUniquePort:
  ' Port öffnen (für das Senden der Daten)
   TmpPort = 0
 
  ' Neuen Port ermitteln
  Call GetNewPort(TmpPort, TmpPortStr)
 
  ' Neuen Port öffnen
  With DownSock
    .Close
    .LocalPort = TmpPort
    .Listen
  End With
 
  ' neu geöffneten Port dem Server mitteilen
  If SendCommand(SetPort & TmpPortStr, CommandOk, CommandOk, _
    CommandFail, 0&, "Neuer Port geöffnet") = False Then
    Exit Function
  End If
 
  ' Upload-Startposition setzen
  SendCommand ResumeTransfere & StartUploadAt, _
    ResumingSupportet, CommandOk, CommandNotImplemented
 
  ' Progressbar einstellen
  ' siehe Workshop-Projekt
 
  ' lokale Datei öffnen
  FFile = FreeFile
  Open LocalFile For Binary As FFile
  Seek #FFile, StartUploadAt + 1
 
  ' Anfrage an Server senden
  TAbort = False
  TotalBytes = LOF(FFile)
  OvermittedBytes = StartUploadAt
  If SendCommand(Upload & ServerFile, TransferStart, _
    TransferStart, PermissionDenied) = False Then
 
    ' Zugriff verweigert (auf der Server-Seite)
 
    Exit Function
  End If
 
    ' Warten bis die Datenleitung verbunden ist
  Dim TimeOut As Long
  TimeOut = GetTickCount + 1000 * ConnectTimeOut
  Do
    DoEvents
  Loop Until DownSock.State = sckConnected Or _
    TimeOut < GetTickCount / 1000
 
  ' TimeOut überschritten!
  If DownSock.State <> sckConnected Then Exit Function
 
 
  ' Alle Daten senden und warten bis die Daten den
  ' Server erreichen
  PacketSend = True
  Do
    DoEvents
 
    ' Wenn vorheriges Päckchen beim Server ist,
    ' neues Daten-Päckchen senden
    If PacketSend = True And _
      OvermittedBytes <> TotalBytes Then
 
      ' Puffergröße festlegen
      If TotalBytes - OvermittedBytes < SendBufferLenght Then
        SendBuff = Space(TotalBytes - OvermittedBytes)
      Else
        SendBuff = Space(SendBufferLenght)
      End If
 
      ' Übertragene Bytes aufaddieren
      OvermittedBytes = OvermittedBytes + Len(SendBuff)
 
 
 
      ' Daten aus der Datei lesen
      Get #FFile, , SendBuff
 
      ' Daten an den Server schicken
      If TAbort = True Then Exit Do
      PacketSend = False
      DownSock.SendData SendBuff
    End If
  Loop Until TotalBytes = OvermittedBytes And PacketSend = True
   MsgBox ("Daten gesendet")
  ' Socket schließen
  DownSock.Close
  SendCommand "", TransferComplete, TransferComplete, -1&
 
  ' Für den nächsten Down-/Upload zurücksetzen
  OvermittedBytes = 0
  TotalBytes = 0
 
  ' Datei schließen
  If FFile <> -1 Then
    Close FFile
    FFile = -1
  End If
 
  ' Falls abgebrochen wurde
  If TAbort = True Then
 
  End If
 
  ' Falls die Verbindung zur Datenleitung nicht
  ' aufgebaut werden konnte, nochmals versuchen
  If LastServerCmd = DataConnectionError Then GoTo NewUniquePort
End Function