Option Explicit
Dim WithEvents FileDownload As clsDownload
 
Private bFinished As Boolean
Private bAbort As Boolean
 
' Fortschritsanzeige
Private Sub ShowProgress(picProgress As PictureBox, _
  ByVal Value As Long, _
  ByVal Min As Long, _
  ByVal Max As Long, _
  Optional ByVal bShowProzent As Boolean = True)
 
  Dim pWidth As Long
  Dim intProz As Integer
  Dim strProz As String
 
  ' Farben
  Const progBackColor = &HC00000
  Const progForeColor = vbBlack
  Const progForeColorHighlight = vbWhite
 
  ' Plausibilitätsprüfungen
  If Value < Min Then Value = Min
  If Value > Max Then Value = Max
 
  ' Prozentwert ausrechnen
  If Max > 0 Then
    intProz = Int(Value / Max * 100 + 0.5)
  Else
    intProz = 100
  End If
 
  With picProgress
    ' Prüfen, ob AutoReadraw=True
    If .AutoRedraw = False Then .AutoRedraw = True
 
    ' Inhalt löschen
    picProgress.Cls
 
    If Value > 0 Then
 
      ' Balkenbreite
      pWidth = .ScaleWidth / 100 * intProz
 
      ' Balken anzeigen
      picProgress.Line (0, 0)-(pWidth, .ScaleHeight), _
        progBackColor, BF
 
      ' Prozentanzeige
      If bShowProzent Then
        strProz = CStr(intProz) & " %"
        .CurrentX = (.ScaleWidth - .TextWidth(strProz)) / 2
        .CurrentY = (.ScaleHeight - .TextHeight(strProz)) / 2
 
        ' Vordergrundfarbe
        If pWidth >= .CurrentX Then
          .ForeColor = progForeColorHighlight
        Else
          .ForeColor = progForeColor
        End If
 
        picProgress.Print strProz
      End If
    End If
  End With
End Sub
 
Private Sub cmdAbort_Click()
  ' Abbrechen
  If MsgBox("Download wirklich abbrechen?", 292, "Download") = vbYes Then
    FileDownload.AbortDownload
    lblStatus.Caption = "Download abgebrochen."
    bAbort = True
  End If
End Sub
 
Private Sub cmdStart_Click()
  ReDim strURL(2) As String
  ReDim strLocal(2) As String
  Dim i As Integer
 
  ' Download-Dateien
  strURL(0) = "http://www.tools4vb.de/download/sevtray.exe"
  strURL(1) = "http://www.tools4vb.de/download/sevcmd32.exe"
  strURL(2) = "http://www.tools4vb.de/download/sevoutbar.exe"
 
  ' Lokale Dateien
  strLocal(0) = App.Path & "\sevtray.exe"
  strLocal(1) = App.Path & "\sevcmd.exe"
  strLocal(2) = App.Path & "\sevoutbar.exe"
 
  cmdStart.Enabled = False
  cmdAbort.Enabled = True
 
  bAbort = False
  For i = 0 To UBound(strURL)
    ' Download beginnen
    bFinished = False
    Set FileDownload = New clsDownload
    FileDownload.DoDownload strURL(i), strLocal(i)
    lblStatus.Caption = strURL(i)
    Do
      DoEvents
    Loop Until bFinished Or bAbort
    Set FileDownload = Nothing
    If bAbort Then Exit For
  Next i
 
  cmdStart.Enabled = True
  cmdAbort.Enabled = False
  lblStatus.Visible = False
 
  MsgBox "Fertig!"
End Sub
 
Private Sub FileDownload_Finished()
  bFinished = True
End Sub
 
Private Sub FileDownload_NotFound()
  MsgBox "Datei nicht vorhanden!"
  bAbort = True
End Sub
 
Private Sub FileDownload_Progress(ByVal BytesLoaded As Long, ByVal FileSize As _
  Long)
  lblStatus.Caption = CStr(BytesLoaded) & " von " & _
    CStr(FileSize) & " Bytes"
  ShowProgress picProgress, BytesLoaded, 0, FileSize
  DoEvents
End Sub
 
Private Sub FileDownload_Start()
  lblStatus.Visible = True
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de