Public Sub UploadFile(ByVal sFile 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 = 8192
 
  ' Datei im Binary-Mode öffnen
  F = FreeFile
  Open sFile For Binary As #F
 
  ' Dateigröße
  nFileSize = LOF(F)
 
    ' 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
      frm_main.Transfer.senddata sBuffer
 
      ' Fortschritt aktualisieren
      nFilePos = nFilePos + nBytestoRead
      frm_main.lbl_upload_uploaded.Caption = Format(nFilePos, "#,####")
 
      ' Wichtig!
      DoEvents
    Loop
 
  ' Datei schließen (Sendevorgang beendet)
  Close #F
  senddata "DLF"
  MsgBox "DLF" & nFilePos
End Sub

Private Sub Transfer_DataArrival(ByVal bytesTotal As Long)
  Dim sData As String
  Dim sTemp As String
  Static sFile As String
 
  Transfer.GetData sData, vbString
  AddMsg "Daten bekommen: " & Len(sData)
 
  'If Len(sData) > 0 And nFile > 0 Then
    nBytesRead = nBytesRead + Len(sData)
 
    nFile = FreeFile
    Open AppPath(pDownloadFile) For Binary As #nFile
 
    Put #nFile, , sData
    AddMsg "Daten geschrieben: " & Len(sData)
 
    lbl_download_downloaded.Caption = CStr(nBytesRead)
 
    If nBytesRead = pDownloadFilesize Then
      Close #nFile
      'nFile = 0
    End If
  'End If
End Sub

www.digitalartcreation.com