cs_angelot
Messages postés13Date d'inscriptionmercredi 1 octobre 2003StatutMembreDernière intervention 4 juin 2007
-
29 nov. 2005 à 11:23
cs_angelot
Messages postés13Date d'inscriptionmercredi 1 octobre 2003StatutMembreDernière intervention 4 juin 2007
-
6 déc. 2005 à 11:13
Bonjour,
J'utilise Wininet pour effectuer des commandes FTP. Tout se passe bien jusqu'à la commande FTP FtpCreateDirectory qui me renvoie le code réponse 6. Trois questions :
- pourquoi j'ai ce numéro d'erreur alors que je pensais que wininet renvoie des erreurs supérieures à 12000 ?
- quelqu'un sait-il à quoi correspond cette erreur ?
- je ne comprend pas pourquoi ma fonction GetWinInetErrDesc (voir programme ci-dessous) ne me renvoie pas un libellé (pas de libellé non plus pour une erreur 2 que j'avais ultérieurement) ?
Merci
Option Explicit
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 InternetGetLastResponseInfo _
Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength 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 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
Public Declare Function FtpCommand _
Lib "wininet.dll" Alias "FtpCommandA" ( _
ByVal hConnect As Long, _
ByVal fExpectResponse As Boolean, _
ByVal dwFlags As Long, _
ByVal lpszCommand As String, _
ByVal lContext As Long, _
phFtpCommand As Long) As Boolean
Declare Sub FtpCreateDirectory _
Lib "wininet.dll" Alias "FtpCreateDirectoryA" ( _
ByRef hConnect As Long, _
ByVal lpszDirectory As String)
Declare Function FtpGetCurrentDirectory _
Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" ( _
ByVal hFtpSession As Long, _
ByVal lpszDirectory As String, _
ByRef lpdwCurrentDirectory As Long) As Boolean
Private Declare Function FormatMessage _
Lib "kernel32" Alias "FormatMessageA" ( _
ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
Arguments As Long) As Long
Private Declare Function GetModuleHandle _
Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary _
Lib "kernel32" Alias "LoadLibraryA" ( _
ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long) As Long
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
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 PassiveConnection As Boolean = True
Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Const MAX_PATH = 260
Public Sub EnvoiFichierFTP(strRepertoireSource As String, _
strUserFolder As String)
Dim lngHwndConnect As Long
Dim lngHwndOpen As Long
Dim lngHCommand As Long
Dim strNomFichier As String
Dim strCommand As String
Dim sOrgPath As String
' Création d'une connexion internet
lngHwndOpen = InternetOpen("Mail Router Documentum Transfert", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)
If FindInternetError("InternetOpen") Then
Exit Sub
End If
' Connexion au site FTP
lngHwndConnect = InternetConnect(lngHwndOpen, _
strHost, _
strPort, _
strUser, _
strPassword, _
INTERNET_SERVICE_FTP, _
IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), _
0)
If FindInternetError("[InternetConnect]") Then
InternetCloseHandle lngHwndOpen 'Ferme internet
Exit Sub
End If
' On arrive par défaut dans le répertoire Host/root/
' Se connecter au répertoire mail
FtpSetCurrentDirectory lngHwndConnect, strRemoteSite
If FindInternetError("[FtpSetCurrentDirectory " & _
lngHwndConnect & "," & _
strRemoteSite & "]") Then
InternetCloseHandle lngHwndConnect 'Ferme la connection
InternetCloseHandle lngHwndOpen 'Ferme internet
Exit Sub
End If
' Dans quel répertoire se trouve-t-on ?
'create a buffer to store the original directory
sOrgPath = String(MAX_PATH, 0)
'get the directory
FtpGetCurrentDirectory lngHwndConnect, sOrgPath, Len(sOrgPath)
MsgBox "sOrgPath : " & sOrgPath
' strCommand = "CWD " & strUserFolder
' If Not FtpCommand(lngHwndConnect, _
' False, _
' FTP_TRANSFER_TYPE_BINARY, _
' strCommand, _
' 0, _
' lngHCommand) Then
' Créer le répertoire utilisateur s'il n'existe pas
FtpCreateDirectory lngHwndConnect, strUserFolder
If FindInternetError("[FtpCreateDirectory " & _
lngHwndConnect & "," & _
strUserFolder & "]") Then
InternetCloseHandle lngHwndConnect 'Ferme la connection
InternetCloseHandle lngHwndOpen 'Ferme internet
Exit Sub
End If
'End If
' Se logger dans le répertoire utilisateur
FtpSetCurrentDirectory lngHwndConnect, strUserFolder
If FindInternetError("[FtpSetCurrentDirectory " & _
lngHwndConnect & "," & _
strUserFolder & "]") Then
InternetCloseHandle lngHwndConnect 'Ferme la connection
InternetCloseHandle lngHwndOpen 'Ferme internet
Exit Sub
End If
'Les fichiers sont envoyés ici
strNomFichier = Dir(AjoutAntislash(strRepertoireSource))
Do While strNomFichier <> ""
FtpPutFile lngHwndConnect, AjoutAntislash(strRepertoireSource) & strNomFichier, strNomFichier, FTP_TRANSFER_TYPE_UNKNOWN, 0
If FindInternetError("[FtpPutFile " & _
lngHwndConnect & "," & _
AjoutAntislash(strRepertoireSource) & strNomFichier & "]") Then
InternetCloseHandle lngHwndConnect 'Ferme la connection
InternetCloseHandle lngHwndOpen 'Ferme internet
Exit Sub
End If
strNomFichier = Dir
Loop
InternetCloseHandle lngHwndConnect 'Ferme la connection
InternetCloseHandle lngHwndOpen 'Ferme internet
End Sub
Public Function FindInternetError(strCommande As String) As Boolean
Dim lngErrorNumber As Long
Dim strErrorDescription As String
Dim lngBufferLength As Long
Dim lngLastDllError As Long
lngLastDllError = Err.LastDllError
If lngLastDllError <> 0 Then
FindInternetError = True
If lngLastDllError = 12003 Then
' something server side, use InternetGetLastResponseInfo to find out
' get the required buffer size
InternetGetLastResponseInfo lngErrorNumber, strErrorDescription, lngBufferLength
' retrieve the last respons info
strErrorDescription = String(lngBufferLength, 0)
' retrieve the last respons info
InternetGetLastResponseInfo lngErrorNumber, strErrorDescription, lngBufferLength
strErrorDescription = " server error : " & lngErrorNumber & " - " & strErrorDescription
Else
' known error, get description from DLL
strErrorDescription = " Wininet error : " & lngLastDllError & " - " & GetWinInetErrDesc(lngLastDllError)
End If
MsgBox strCommande & strErrorDescription
FindInternetError = True
Else
FindInternetError = False
End If
End Function
Public Function GetWinInetErrDesc(dError As Long) As String
Dim dwLength As Long
Dim strBuffer As String * 257
Dim hModule As Long
Dim bLoadLib As Boolean
hModule = GetModuleHandle("wininet.dll")
If hModule = 0 Then
hModule = LoadLibrary("wininet.dll")
bLoadLib = True
End If
