title image


Smiley hab was im Archiv gefunden
das folgende hab ich getestet und funktioniert, jetzt brauch ich aber trotzdem noch die features: "mkdir" "rmdir" ...





Option Compare Database



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

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (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 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 lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Private Const ERR_CONNECT_ERROR As String = "Cannot Connect to the specified Server using User and Password Parameters"

Private Const ERR_NO_FTP_CONNECTION As String = "Not Connected to FTP Site"

Private Const ERR_FTP_UPLOAD As String = "Couldn't send File to Server"

Private Const ERR_FATAL_ERROR As String = "Cannot get Connection to WinInet.dll !"

Private Const SESSION As String = "FTP Module"

Private INET_HANDLE As Long

Private FTP_CONNECTION As Long

Private FTP_SERVER As String

Private FTP_USER As String

Private FTP_PASSWORD As String

Private FTP_Directory As String



Public Sub Disconnect()

If FTP_CONNECTION 0 Then

InternetCloseHandle FTP_CONNECTION

FTP_CONNECTION = 0

Else 'No FTP Connection!

Beep

MsgBox "Error: " & ERR_NO_FTP_CONNECTION, vbCritical, "Error"

Exit Sub

End If

FTP_SERVER = ""

FTP_USER = ""

FTP_PASSWORD = ""

FTP_Directory = ""

If INET_HANDLE 0 Then

InternetCloseHandle INET_HANDLE

End If

FTP_CONNECTION = 0

INET_HANDLE = 0

End Sub



Public Function Connect(strHost As String, strUser As String, strPassword As String) As Boolean

On Error GoTo ErrorHandler

Dim strError As String



INET_HANDLE = InternetOpen(SESSION, 1, vbNullString, vbNullString, 0)

If INET_HANDLE = 0 Then

FTP_CONNECTION = 0

Beep

MsgBox "Error: " & ERR_FATAL_ERROR, vbCritical, "Error"

Exit Function

End If



If FTP_CONNECTION 0 Then

Beep

MsgBox "Error: You are already connected to FTP Server " & FTP_SERVER, vbCritical, "Error"

Exit Function

End If

FTP_SERVER = strHost

FTP_USER = strUser

FTP_PASSWORD = strPassword

'Connect Now!

If Len(FTP_SERVER) = 0 Then

Beep

MsgBox "Error: No Host Address Specified!", vbCritical, "Error"

Exit Function

End If

FTP_CONNECTION = InternetConnect(INET_HANDLE, FTP_SERVER, 0, FTP_USER, FTP_PASSWORD, 1, 0, 0)

'Check for connection errors

If FTP_CONNECTION = 0 Then

strError = ERR_CONNECT_ERROR

strError = strError & vbCrLf & GetErrorMessage(Err.LastDllError)

Beep

MsgBox "Error: " & strError, vbCritical, "Error"

Exit Function

End If

Connect = True

Exit Function

ErrorHandler:

Beep

MsgBox "Error: " & Err.Description, vbCritical, "Error"

Exit Function

End Function



Public Function PutFile(ByVal strLocalFileAndPath As String, ByVal strRemoteFileAndPath As String) As Boolean

On Error GoTo ErrorHandler

Dim bRet As Boolean

Dim strRemoteFile As String

Dim strRemoteDirectory As String

Dim strLocalFile As String

Dim strTemp As String

Dim lngPos As Long

Dim strError As String



If FTP_CONNECTION = 0 Then

Beep

MsgBox "Error: " & ERR_NO_FTP_CONNECTION, vbCritical, "Error"

Exit Function

End If



bRet = FtpPutFile(FTP_CONNECTION, strLocalFileAndPath, strRemoteFileAndPath, &H1, 0)

If bRet = False Then

strError = ERR_FTP_UPLOAD

strError = strError & vbCrLf & GetErrorMessage(Err.LastDllError)

PutFile = False

Beep

MsgBox "Error: " & strError, vbCritical, "Error"

Exit Function

End If



PutFile = True

Exit Function

ErrorHandler:

Beep

MsgBox "Error: " & Err.Description, vbCritical, "Error"

Exit Function

End Function



Private Function GetErrorMessage(ByVal lngErrorNummer As Long) As String 'For internal use only!

Dim lngError As Long

Dim lngLen As Long

Dim strBuffer As String



If lngErrorNummer = 12003 Then

'Get Message Size and Number

InternetGetLastResponseInfo lngError, vbNullString, lngLen

strBuffer = String$(lngLen + 1, vbNullChar)

'Get Message

InternetGetLastResponseInfo lngError, strBuffer, lngLen

GetErrorMessage = vbCrLf & strBuffer

End If

End Function







geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: