Option Explicit
 
' zunächst alle benötigten API-Deklarationen
Private Declare Function InternetOpen Lib "wininet.dll" _
 Alias "InternetOpenA" ( _
 ByVal sAgent As String, _
 ByVal nAccessType As Long, _
 ByVal sProxyName As String, _
 ByVal sProxyBypass As String, _
 ByVal nFlags As Long) As Long
 
Private Declare Function InternetCloseHandle _
 Lib "wininet.dll" ( _
 ByVal hInet As Long) As Integer
 
Private Declare Function InternetConnect _
 Lib "wininet.dll" Alias "InternetConnectA" ( _
 ByVal hInternetSession As Long, _
 ByVal sServerName As String, _
 ByVal nServerPort As Integer, _
 ByVal sUsername As String, _
 ByVal sPassword As String, _
 ByVal nService As Long, _
 ByVal nFlags As Long, _
 ByVal nContext As Long) As Long
 
Private Declare Function FtpPutFile _
 Lib "wininet.dll" Alias "FtpPutFileA" ( _
 ByVal hFtpSession As Long, _
 ByVal lpszLocalFile As String, _
 ByVal lpszRemoteFile As String, _
 ByVal dwFlags As Long, _
 ByVal dwContext As Long) As Boolean
 
' Kostanten
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_SERVICE_FTP = 1
 
' Übertragungsmodus
Public Enum eTransferType
  FTP_TRANSFER_TYPE_BINARY = &H2
  FTP_TRANSFER_TYPE_ASCII = &H1
End Enum
 
' Handles
Private hOpen As Long
Private hConnection As Long

' Verbindung zum Server herstellen
Public Function Connect(ByVal sRemoteHost As String, _
  Optional ByVal sUsername As String = "anonymous", _
  Optional ByVal sPassword As String = "guest")
 
  ' Ist noch eine Verbindung vorhanden?
  ' Wenn ja, muss diese zunächst beendet werden!
  If hOpen <> 0 Or hConnection <> 0 Then
    Disconnect
  End If
 
  ' Neue Verbindung starten
  hOpen = InternetOpen("FTP", _
    INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, _
    vbNullString, 0)
 
  If hOpen Then
    hConnection = InternetConnect(hOpen, _
      sRemoteHost, INTERNET_INVALID_PORT_NUMBER, _
      sUsername, sPassword, INTERNET_SERVICE_FTP, 0, 0)
  End If
 
  Connect = (hConnection <> 0)
End Function

' Verbindung zum Server beenden
Public Sub Disconnect()
  If hConnection <> 0 Then
    InternetCloseHandle hConnection
    hConnection = 0
  End If
 
  If hOpen <> 0 Then
    InternetCloseHandle hOpen
    hOpen = 0
  End If
End Sub

' Datei auf den Server hochladen
Public Function FileUpload( _
  ByVal sLocalFilename As String, _
  ByVal sRemoteFilename As String, _
  Optional ByVal nTransferType As eTransferType = _
  FTP_TRANSFER_TYPE_BINARY) As Boolean
 
  FileUpload = FtpPutFile(hConnection, _
    sLocalFilename, sRemoteFilename, nTransferType, 0)
End Function

  Dim sRemoteHost As String
  Dim sUsername As String
  Dim sPassword As String
  Dim bResult As Boolean
 
  sRemoteHost = "hostname"
  sUsername = "username"
  sPassword = "password"
 
  If Connect(sRemoteHost, sUsername, sPassword) Then
    bResult = FileUpload("localfile", "remotefile")
    Disconnect
  End If

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de