[AIDE] Simple client FTP & PUT fichier texte. [Résolu]

Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
- - Dernière réponse : NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
- 22 mai 2015 à 17:41
Bonjour à tous,

Pourriez-vous me donner votre avis sur le code suivant ?

Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
'Const INTERNET_DEFAULT_FTP_PORT = 21 ' default for FTP servers
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000 ' used for FTP connections
Const INTERNET_OPEN_TYPE_PRECONFIG = 0 ' use registry configuration
Const INTERNET_OPEN_TYPE_DIRECT = 1 ' direct to net
Const INTERNET_OPEN_TYPE_PROXY = 3 ' via named proxy
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 ' prevent using java/script/INS
Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
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 FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
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 FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
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
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
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 & "\Onin42.txt", "Onin42.txt", FTP_TRANSFER_TYPE_UNKNOWN, 0
FtpPutFile hConnection, "" & App.Path & "\Onin42.txt", "", FTP_TRANSFER_TYPE_UNKNOWN, 0

'close the internet connection
InternetCloseHandle hOpen
MsgBox ("Sucesful")

End Sub


Vous semble-t-il "stable" et "adapté" pour un Put ftp d'un fichier texte ?
Si oui, auriez-vous une idée de comment recueillir les informations transmissent entre ce client et le serveur ?
Je m'explique :
Je compte utiliser ce client pour envoyer un fichier texte de "configuration" à une imprimante.
Si j'envoie ce fameux fichier texte via une connexion ftp par une invite de commande MsDos "CMD" j'obtiens les informations suivantes :

ftp "Adresse IP"
Connecté à "Adresse IP"
220 FS_3920DN FTP server
Utilisateur (IP :(none)) : "utilisateur"
331 User ok
230 User logged in successively
ftp> put
Fichier local c:\margesFS3920.txt
Fichier distant
200 Command Okay
150 Opening ASCII mode data connection
226 Transfer Compete
ftp: 4O octets envoyés en 0,08 secondes à 0,49 Ko/s.

J'aimerais afficher ces informations dans un TextBox ou autre.
Pouvez-vous m'aider?
Afficher la suite 

Votre réponse

6 réponses

Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
0
Merci
Bonjour,
On s'éloigne là des connaissances de VB6, car le code que tu montres ne fait appel à ces connaissances de VB6 que pour déclarer et utiliser des fonctions de l'API de Windows. Et ce sont donc CES fonctions, qu'il te faut maîtriser (et non vraiment VB6).
Lorsque tu fais appel à une fonction de l'API de Windows :
1) tu es en principe censé savoir ce qu'elle devrait faire, non ? ===>> un message en la lançant pour dire ce qu'elle va en principe faire
2) chaque fonction de l'API de Windows réussit ou échoue. Lorsqu'elle échoue, elle retourne une erreur, que tu peux détailler à l'aide de la fonction GetLastError de la librairie Kernel 32 de l'API de Windows ===>>> et donc :
-----si réussite ===>>> un petit message de réussite
---- Si elle échoue ===>>> un message d'échec puis abandon
et ainsi pour chaque fonction appelée.
Tous ces messages (ce que cela devrait faire, puis si réussite ou échec, ...) peuvent plus astucieusement faire l'objet d'articles ajoutés dans une Listbox (bien plus pratique que dans une textbox).
Voilà. Yapluka.
Commenter la réponse de ucfoutu
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
0
Merci
Bonjour ucfoutu,

Oui là, on joue dans la cour des grands:)

Ce code est loin d'être de mon niveau, je programme un peu en VB Script, Métier oblige "informatique système et réseau", mais suis très loin d'être un programmeur contrairement a beaucoup ici dons c'est la vocation.

J'ai fait quelques tests avec ce code qui ne semble pas fonctionner pour mon cas.

Ca marche si j'envoie un fichier texte sur un serveur ftp comme Free par exemple.

Mais pas sur le ftp de mon imprimante.

Connaissez-vous un moyen pour envoyer les commandes Msdos "CMD.exe" depuis VB6 ?

Cordialement
Commenter la réponse de NeriXs
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
0
Merci
Essaye au moins la gestion d'erreur VB6, avant de "fuir"

Exemple pour la fonction FtpPutFile ===>>

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

Idem pour chaque fonction, à chaque étape.

Mais si l'on veut rester puriste, on se sert (comme dit plus haut) d'une fonction de l'Api de Windows.
Rien n'empêche, par exemple, de se créer une petite procédure genre :
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


et bien sur ===>> transformer :
else
msgbox "aïe aïe aïe ! " & err.description
exit sub
end If


en :
else
mon_erreur
exit sub
end If



J'observe d'ailleurs que tu as (ton premier message) déclaré cette fonction InternetGetLastResponseInfo. Sans l'utiliser ...
Elle était là pourquoi, alors ? (code copié/collé ? sans le comprendre ?)


________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
Commenter la réponse de ucfoutu
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
0
Merci
Bonjour ucfoutu,

c'est vrai que je n'ai pas nettoyé le code de base comme il se doit et d'ajouter les fonctions a la demande :(

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
Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
0
Merci
Bonjour,

Toutes les erreurs ne sont pas interprétées avec InternetGetLastResponseInfo !
Notamment les erreurs de code 12003.
Il semble nécessaire d'utiliser ERROR_INTERNET_EXTENDED_ERROR

Je ne parviens pas à adapter le code ci dessous, pouvez vous m'aider ?

    Public 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
Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
0
Merci
Bonjour,
Un petit call sur sur la fonction, suppression de quelques scories qui traînaient et c'est OK.
Commenter la réponse de NeriXs

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.