Private Sub Command1_Click()
Dim s As String
s = OpenURL("http://ypsilondownloads.de/Projekt1.exe")
WriteFile "C:\Projekt1.exe", s
End Sub
 
Public Function OpenURL( _
    ByVal URL As String, _
    Optional ByVal OpenType As InternetOpenType = IOTPreconfig _
  ) As String
  Const INET_RELOAD = &H80000000
  Dim hInet As Long
  Dim hURL As Long
  Dim Buffer As String * 2048
  Dim Bytes As Long
 
  hInet = InternetOpenA( _
      "DownManager", OpenType, _
      vbNullString, vbNullString, 0)
  hURL = InternetOpenUrlA( _
      hInet, URL, vbNullString, 0, INET_RELOAD, 0)
 
  Do
    InternetReadFile hURL, Buffer, Len(Buffer), Bytes
 
    If Bytes = 0 Then Exit Do
 
    OpenURL = OpenURL & Left$(Buffer, Bytes)
 
    txtBytesRead = Len(OpenURL)
 
    DoEvents
  Loop
 
 
  InternetCloseHandle hURL
  InternetCloseHandle hInet
End Function

Private Declare Sub InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInet As Long)
Private Declare Function InternetOpenA Lib "wininet.dll" ( _
    ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrlA Lib "wininet.dll" ( _
    ByVal hOpen As Long, ByVal sUrl As String, _
    ByVal sHeaders As String, ByVal lLength As Long, _
    ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Sub InternetReadFile Lib "wininet.dll" ( _
    ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)
 
Public Enum InternetOpenType
  IOTPreconfig = 0
  IOTDirect = 1
  IOTProxy = 3
End Enum

Public Function FileExists(Path As String) As Boolean
  Const NotFile = vbDirectory Or vbVolume
 
  On Error Resume Next
    FileExists = (GetAttr(Path) And NotFile) = 0
  On Error GoTo 0
End Function
 
Function ReadFile(ByRef Path As String) As String
  Dim FileNr As Long
 
  On Error Resume Next
  If FileLen(Path) = 0 Then Exit Function
  On Error GoTo 0
 
  FileNr = FreeFile
  Open Path For Binary As #FileNr
    ReadFile = Space$(LOF(FileNr))
    Get #FileNr, , ReadFile
  Close #FileNr
End Function
 
Sub WriteFile(ByRef Path As String, ByRef Text As String)
  Dim FileNr As Long
 
  If FileExists(Path) Then _
      If FileLen(Path) = Len(Text) Then _
          If ReadFile(Path) = Text Then Exit Sub
 
  FileNr = FreeFile
  Open Path For Output As #FileNr
  Print #FileNr, Text;
  Close #FileNr
End Sub