if FtpPutFile(hconnection, chemin_du_fichier_à_envoyer, chemin_où_envoyer, False, 1, 0) = False Then
msgbox "le fichier " & chemin_du_fichier_à_envoyer & " a été envoyé avec succès"
else
msgbox "aïe aïe aïe ! " & err.description
exit sub
end If
sub mon_erreur()
dim denoncee as long, un_buffer as string, taille_buffer as long
InternetGetLastResponseInfo denoncee, un_buffer, taille_buffer
un_buffer= string(taille_buffer, 0)
InternetGetLastResponseInfo denoncee, un_buffer, taille_buffer
msgBox "Ouille ! une erreur ===>> " + cstr(denoncee) & ": " & un_buffer
end sub
else
msgbox "aïe aïe aïe ! " & err.description
exit sub
end If
else
mon_erreur
exit sub
end If
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const MAX_PATH = 260
Private Type WIN32_FIND_DATA
cFileName As String * MAX_PATH
End Type
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 lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
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 FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Const PassiveConnection As Boolean = True
Private Sub cmd_exit_Click()
End
End Sub
Private Sub cmd_send_Click()
Dim hConnection As Long, hOpen As Long, sOrgPath As String
'open an internet connection
hOpen = InternetOpen("API-Guide sample program", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
'connect to the FTP server
hConnection = InternetConnect(hOpen, txt_ftp.Text, INTERNET_DEFAULT_FTP_PORT, txt_login.Text, txt_pw.Text, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
'create a buffer to store the original directory
sOrgPath = String(MAX_PATH, 0)
'get the directory
FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
'upload the file 'test.htm'
FtpPutFile hConnection, "" & App.Path & "\Mon.txt", "", FTP_TRANSFER_TYPE_UNKNOWN, 0
'close the internet connection
InternetCloseHandle hOpen
MsgBox ("Sucesful")
End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPublic Const ERROR_IO_PENDING = 997
Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Function ErrorOut(dError As Long) As String
Dim dwIntError As Long, dwLength As Long
Dim strBuffer As String
If dError = ERROR_INTERNET_EXTENDED_ERROR Then
InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
strBuffer = String(dwLength + 1, 0)
InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
ErrorOut = " FTP Err: " & dwIntError & " " & strBuffer
Else
ErrorOut = "Error " & dError & vbLF & InetErrMsg(dError)
End If
End Function
Function InetErrMsg$(ByVal ecode&)
Dim emsg$
If ecode = ERROR_IO_PENDING Then
InetErrMsg = "ERROR_IO_PENDING "
Exit Function
End If
If ecode < 12000 Then
Err.Number = ecode
InetErrMsg = Err.Description
Exit Function
End If
Select Case (ecode - 12000)
Case 0: emsg = "(NO FTP HANDLE)"
Case 1: emsg = "ERROR_INTERNET_OUT_OF_HANDLES"
Case 2: emsg = "ERROR_INTERNET_TIMEOUT"
Case 3: emsg = "ERROR_INTERNET_EXTENDED_ERROR"
Case 4: emsg = "ERROR_INTERNET_INTERNAL_ERROR"
Case 5: emsg = "ERROR_INTERNET_INVALID_URL"
Case 6: emsg = "ERROR_INTERNET_UNRECOGNIZED_SCHEME"
Case 7: emsg = "ERROR_INTERNET_NAME_NOT_RESOLVED"
Case 8: emsg = "ERROR_INTERNET_PROTOCOL_NOT_FOUND"
Case 9: emsg = "ERROR_INTERNET_INVALID_OPTION"
Case 10: emsg = "ERROR_INTERNET_BAD_OPTION_LENGTH"
Case 11: emsg = "ERROR_INTERNET_OPTION_NOT_SETTABLE"
Case 12: emsg = "ERROR_INTERNET_SHUTDOWN"
Case 13: emsg = "The Username provided is invalid" ' ERROR_INTERNET_INCORRECT_USER_NAME
Case 14: emsg = "Invalid Usercode or Password" ' ERROR_INTERNET_INCORRECT_PASSWORD
Case 15: emsg = "ERROR_INTERNET_LOGIN_FAILURE"
Case 16: emsg = "ERROR_INTERNET_INVALID_OPERATION"
Case 17: emsg = "ERROR_INTERNET_OPERATION_CANCELLED"
Case 18: emsg = "ERROR_INTERNET_INCORRECT_HANDLE_TYPE"
Case 19: emsg = "ERROR_INTERNET_INCORRECT_HANDLE_STATE"
Case 20: emsg = "ERROR_INTERNET_NOT_PROXY_REQUEST"
Case 21: emsg = "ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND"
Case 22: emsg = "ERROR_INTERNET_BAD_REGISTRY_PARAMETER"
Case 23: emsg = "ERROR_INTERNET_NO_DIRECT_ACCESS"
Case 24: emsg = "ERROR_INTERNET_NO_CONTEXT"
Case 25: emsg = "ERROR_INTERNET_NO_CALLBACK"
Case 26: emsg = "ERROR_INTERNET_REQUEST_PENDING"
Case 27: emsg = "ERROR_INTERNET_INCORRECT_FORMAT"
Case 28: emsg = "ERROR_INTERNET_ITEM_NOT_FOUND"
Case 29: emsg = "ERROR_INTERNET_CANNOT_CONNECT"
Case 30: emsg = "ERROR_INTERNET_CONNECTION_ABORTED"
Case 31: emsg = "ERROR_INTERNET_CONNECTION_RESET"
Case 32: emsg = "ERROR_INTERNET_FORCE_RETRY"
Case 33: emsg = "ERROR_INTERNET_INVALID_PROXY_REQUEST"
Case 34: emsg = "ERROR_INTERNET_NEED_UI"
Case 36: emsg = "ERROR_INTERNET_HANDLE_EXISTS"
Case 37: emsg = "ERROR_INTERNET_SEC_CERT_DATE_INVALID"
Case 38: emsg = "ERROR_INTERNET_SEC_CERT_CN_INVALID"
Case 39: emsg = "ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR"
Case 40: emsg = "ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR"
Case 41: emsg = "ERROR_INTERNET_MIXED_SECURITY"
Case 42: emsg = "ERROR_INTERNET_CHG_POST_IS_NON_SECURE"
Case 43: emsg = "ERROR_INTERNET_POST_IS_NON_SECURE"
Case 44: emsg = "ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED"
Case 45: emsg = "ERROR_INTERNET_INVALID_CA"
Case 46: emsg = "ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP"
Case 47: emsg = "ERROR_INTERNET_ASYNC_THREAD_FAILED"
Case 48: emsg = "ERROR_INTERNET_REDIRECT_SCHEME_CHANGE"
Case 49: emsg = "ERROR_INTERNET_DIALOG_PENDING"
Case 50: emsg = "ERROR_INTERNET_RETRY_DIALOG"
Case 52: emsg = "ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR"
Case 53: emsg = "ERROR_INTERNET_INSERT_CDROM"
Case 110: emsg = "ERROR_FTP_TRANSFER_IN_PROGRESS"
Case 111: emsg = "ERROR_FTP_DROPPED"
Case 112: emsg = "ERROR_FTP_NO_PASSIVE_MODE"
' gopher API errors
Case 130: emsg = "ERROR_GOPHER_PROTOCOL_ERROR"
Case 131: emsg = "ERROR_GOPHER_NOT_FILE"
Case 132: emsg = "ERROR_GOPHER_DATA_ERROR"
Case 133: emsg = "ERROR_GOPHER_END_OF_DATA"
Case 134: emsg = "ERROR_GOPHER_INVALID_LOCATOR"
Case 135: emsg = "ERROR_GOPHER_INCORRECT_LOCATOR_TYPE"
Case 136: emsg = "ERROR_GOPHER_NOT_GOPHER_PLUS"
Case 137: emsg = "ERROR_GOPHER_ATTRIBUTE_NOT_FOUND"
Case 138: emsg = "ERROR_GOPHER_UNKNOWN_LOCATOR"
' HTTP API errors
Case 150: emsg = "ERROR_HTTP_HEADER_NOT_FOUND"
Case 151: emsg = "ERROR_HTTP_DOWNLEVEL_SERVER"
Case 152: emsg = "ERROR_HTTP_INVALID_SERVER_RESPONSE"
Case 153: emsg = "ERROR_HTTP_INVALID_HEADER"
Case 154: emsg = "ERROR_HTTP_INVALID_QUERY_REQUEST"
Case 155: emsg = "ERROR_HTTP_HEADER_ALREADY_EXISTS"
Case 156: emsg = "ERROR_HTTP_REDIRECT_FAILED"
Case 160: emsg = "ERROR_HTTP_NOT_REDIRECTED"
Case 161: emsg = "ERROR_HTTP_COOKIE_NEEDS_CONFIRMATION"
Case 162: emsg = "ERROR_HTTP_COOKIE_DECLINED"
Case 168: emsg = "ERROR_HTTP_REDIRECT_NEEDS_CONFIRMATION"
' additional Internet API error codes
Case 157: emsg = "ERROR_INTERNET_SECURITY_CHANNEL_ERROR"
Case 158: emsg = "ERROR_INTERNET_UNABLE_TO_CACHE_FILE"
Case 159: emsg = "ERROR_INTERNET_TCPIP_NOT_INSTALLED"
Case 163: emsg = "ERROR_INTERNET_DISCONNECTED"
Case 164: emsg = "ERROR_INTERNET_SERVER_UNREACHABLE"
Case 165: emsg = "ERROR_INTERNET_PROXY_SERVER_UNREACHABLE"
Case 166: emsg = "ERROR_INTERNET_BAD_AUTO_PROXY_SCRIPT"
Case 167: emsg = "ERROR_INTERNET_UNABLE_TO_DOWNLOAD_SCRIPT"
Case 169: emsg = "ERROR_INTERNET_SEC_INVALID_CERT"
Case 170: emsg = "ERROR_INTERNET_SEC_CERT_REVOKED"
Case Else: emsg = "(not a recognised error code)"
End Select
InetErrMsg = emsg
End Function