UNE ALTERNATIVE FTP SANS API ET SANS OCX

'Une alternative FTP sans API et sans OCX
'Ce petit bout de code est un exemple de ce qu'il est possible
'de faire en VB afin de générer rapidement un transfert FTP
'Certes il existe des méthodes plus complètes et plus élaborées
'mais cette méthode à l'avantage d'être simple et fiable.
'Le but de ce code n'est pas de gérer les transferts, mais de
'donner une solution rapide, simple et efficace à qui veut effectuer
'ponctuellement un transfert de fichier via FTP.
'
'--------------------------------------------------------------
Sub CreerScriptFtp()
'
Dim Canal As Integer
Dim ScriptFTP As String
Dim Compteur As String
Dim ResultatCommande As Byte
Dim NomServeur As String
Dim NomUtilisateur As String
Dim MotDePasse As String
'
On Error Resume Next
    NomServeur = "ftpperso.free.fr"
    NomUtilisateur = "mon nom utilisateur"
    MotDePasse = "mon mot de passe utilisateur"
    
    ScriptFTP = ""
    '
    '1)NomServeur est soit le nom du serveur soit son adresse IP
    ScriptFTP = "Open" & NomServeur & vbCrLf
    '2)NomUtilisateur est le Nom de connection reconnu par le serveur FTP
    '  MotDePasse est le mot de passe associé au Nom de connection
    ScriptFTP = ScriptFTP & NomUtilisateur & " " & MotDePasse & vbCrLf
    '3)On indique au serveur que le transfert se fera en mode binaire
    '  Toujours utiliser le mode binaire, c'est le seul qui garantisse l'intégrité des donnéees transférées
    ScriptFTP = ScriptFTP & "Binary" & vbCrLf
    '4)On indique le répertoire local ou se trouvent les fichiers devant etres transférés
    ScriptFTP = ScriptFTP & "lcd c:\RepertoireLocal" & vbCrLf
    '5)On indique le répertoire de destination sur le serveur
    ScriptFTP = ScriptFTP & "cd /usr/RepServeur/" & vbCrLf
    '6)Si le serveur est sous unix, cette commande permet d'octroyer des attributs
    '  en lecture/écriture/exécution pour les fichiers transférés sinon il seront
    '  en lecture seule par défaut. Si le serveur n'est pas sous Unix, cette commande est ignorée.
    ScriptFTP = ScriptFTP & "literal SITE umask 000" & vbCrLf
    '7)Commande de hachage, des dièses de progression s'afficheront dans la fenêtre MsDos
    '  indiquant l'état d'avancement du transfert.(commande optionnelle pour infos)
    ScriptFTP = ScriptFTP & "hash" & vbCrLf
    '8)Envoi tous les fichiers d'extention exe contenus dans le répertoire local
    '  Si un seul fichier est envoyé la commande est: put + nom du fichier complet exe: put toto.exe
    '  Attention aux majuscules/minuscules lors du transfert (émission ou réception) sur serveur Unix
    '  Le serveur FtpPerso.free.fr de Free par exemple, fait la différence entre majusc/minisc
    ScriptFTP = ScriptFTP & "mput " & "* .exe" & vbCrLf
    '9)Reçoit tous les fichiers d'extention exe contenus dans le répertoire
    '  défini par défaut sur le serveur FTP (Voir ligne de script 5)
    '  Si un seul fichier est envoyé la commande est: get + nom du fichier complet exe: get toto.exe
    ScriptFTP = ScriptFTP & "mget " & "*.exe" & vbCrLf
    '10)Met fin à la connection FTP
    ScriptFTP = ScriptFTP & "bye" & vbCrLf
    '11)Ferme la fenêtre MsDos Ouverte
    ScriptFTP = ScriptFTP & "exit" & vbCrLf
    '
    'Fin du script
    '
    'Enregistrement du script dans le fichier ScriptFTP.scr .
    'Ici le fichier est enregistré dans le répertoire de l'application
    'mais rien n'empêche de l'enregister dans un autre répertoire.
    'on attribu un canal libre poour lecture/écriture sur disque
    Canal = FreeFile(1)
    'ouverture du fichier en écriture s'il n'existe pas il est créé
    Open App.Path & "\ScriptFtp.scr" For Output As #Canal
         Print #canal2, ScriptFTP
    'fermeture du fichier
    Close canal2
    '
    'Exécution du Script Ftp qui ici est lancé à la suite de la création
    'mais qui peu bien sûr être exécuté dans une autre procédure.
    'on fixe le lecteur par défaut
    ChDrive Mid(App.Path, 1, 1)
    'on fixe le répertoire de lecture par défaut
    ChDir (App.Path)
    'on exécute le script de transfert ftp
    'Exécution et affichage du transfert dans une fenêtre MsDos
    ResultatCommande = Shell("command.com /c ftp -n -i -s:" & "ScriptFtp.scr", vbNormalFocus)
    'ici l'affichage ne se fait pas dans la fenêtre MsDos mais il est redirigé dans un fichier sur le répertoire courant
    ResultatCommande = Shell("command.com /c ftp -n -i -s:" & "ScriptFtp.scr" & " > " & "TransFtp.Log", vbHide)
    'on affiche un message si la commande a échouée
    'ResultatCommande renvoi l'identificateur de tâche si la commande a été exécutée normalement
    'Sinon une erreur est générée
    If Err.Number <> 0 Then MsgBox "La commande FTP a Echouée !", vbyesonly + vbCritical + vbApplicationModal
    Err.Clear
End Sub

'NB: La commande Shell gère la fenêtre d'affichage MsDos suivant le paramètre WindowStyle
'vbHide             0  La fenêtre est masquée et activée.
'vbNormalFocus      1   La fenêtre est activée et rétablie à sa taille et à sa position d'origine.
'vbMinimizedFocus   2  La fenêtre est affichée sous forme d'icône et activée.
'vbMaximizedFocus   3  La fenêtre est agrandie et activée
'vbNormalNoFocus    4  La fenêtre est rétablie à sa taille et à sa position les plus récentes.
'                     la fenêtre active reste active.
'vbMinimizedNoFocus 6 La fenêtre est affichée sous forme d'icône. La fenêtre active reste active.
'
'