Soyez le premier à donner votre avis sur cette source.
Snippet vu 14 898 fois - Téléchargée 27 fois
'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. ' '
(moi étant sous Linux depuis je ne saurais plus...)
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
Vraiment, c'est étrange pcq normalement il essayerait d'ouvrir le fichier #0. Quelqu'un a une idée?
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.