Transfert ftp unix vers windows en ascii ou binaire

Commenter

Contenu du snippet

mettre ce code dans un module, au debut de la fonction il y a un exemple d'utilisation.

Il y a peut etre mieux, faite m'en part.
En tout cas celui marche tres bien.

Source / Exemple : 


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

A voir également

S'inscrire maintenant

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.

Du même auteur (thierrydelepine)