Soyez le premier à donner votre avis sur cette source.
Snippet vu 7 206 fois - Téléchargée 32 fois
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'declaration pour la fonction GetFTP 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 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 FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Const FTP_TRANSFER_TYPE_UNKNOWN = &H0 Const FTP_TRANSFER_TYPE_ASCII = &H1 Const FTP_TRANSFER_TYPE_BINARY = &H2 'Create a new project and add this code to Form1 Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Const LANG_NEUTRAL = &H0 Const SUBLANG_DEFAULT = &H1 Const ERROR_BAD_USERNAME = 2202& Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long) Private Declare Function GetLastError Lib "kernel32" () As Long 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 InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean Public Function GetFTP(Host As String, User As String, Password As String, CheminForGetFTP As String, SourceFile As String, DestinationFile As String) As String 'exemple d'utilisation 'MyResult = GetFTP("NomDNSMAchineUNIX","User","MyPassword","CheminSurLeServeurUNIXduFichier","NomDuFichierSource","CheminCompletEtNomDuFichierDestination") 'if MyResult <> "OK" then ' MsgBox MyResult, vbOKOnly + vbCritical ' end 'endif Dim MyResult As Boolean Dim hConnection As Long, hOpen As Long, sOrgPath As String 'ouvre une connection internet hOpen = InternetOpen("API-Guide sample program", 0, vbNullString, vbNullString, 0) 'connexion au serveur FTP hConnection = InternetConnect(hOpen, Host, 21, User, Password, 1, IIf(0, &H8000000, 0), 0) If hConnection <> 0 Then 'change le repertoire du serveur FTP MyResult = FtpSetCurrentDirectory(hConnection, "/" & Host & "/" & CheminForGetFTP) If MyResult = False Then GetFTP = "Impossible de se positionner dans le répertoire : /" & Host & "/" & CheminForGetFTP 'ferme la connexion FTP InternetCloseHandle hConnection 'ferme la connexion internet InternetCloseHandle hOpen Exit Function End If End If MyResult = False 'recupere le fichier demandé du serveur FTP MyResult = FtpGetFile(hConnection, SourceFile, DestinationFile, False, 0, FTP_TRANSFER_TYPE_ASCII, 0) If MyResult Then GetFTP = "OK" 'ferme la connexion FTP InternetCloseHandle hConnection 'ferme la connexion internet InternetCloseHandle hOpen Exit Function Else Dim lErr As Long, sErr As String, lenBuf As Long 'recupere la longueur du message pour creer un buffer InternetGetLastResponseInfo lErr, sErr, lenBuf 'creer un buffer sErr = String(lenBuf, 0) 'recupere l'information ou le message d'erreur InternetGetLastResponseInfo lErr, sErr, lenBuf 'show the last response info GetFTP = "Error " + CStr(lErr) + ": " + sErr End If 'ferme la connexion FTP InternetCloseHandle hConnection 'ferme la connexion internet InternetCloseHandle hOpen End Function
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.