Une alternative ftp sans api et sans ocx

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 835 fois - Téléchargée 27 fois

Contenu du snippet

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.

Source / Exemple :


'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.
'
'

A voir également

Ajouter un commentaire

Commentaires

Messages postés
337
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 avril 2006

Oui étrange... essaie de déboguer. Mais bon au pire c'est vite corrigé ^^

(moi étant sous Linux depuis je ne saurais plus...)
Messages postés
2
Date d'inscription
jeudi 25 mai 2006
Statut
Membre
Dernière intervention
27 mai 2006

Je ne comprend pas comment ca ne te donne pas d'erreur quand tu écris:

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?
Messages postés
14
Date d'inscription
lundi 24 février 2003
Statut
Membre
Dernière intervention
20 juillet 2005

Oki oki probleme resolu, je ne suis pas sur de la raison mais je pense que lors de l'execution par Shell VB je ne mettais pas les -n -i pour les options de ftp et cela posait apparemment probleme enfin merci de ta reponse man.
Messages postés
14
Date d'inscription
lundi 24 février 2003
Statut
Membre
Dernière intervention
20 juillet 2005

C'est ce que je pensais aussi ; un espace je veux bien mais je vois pas ou du tout puisque comme je l'ai dit precedemment le script lance est le meme... Je vais encore jete un coup d 'oeil si je ne vois pas d'erreurs. Merci quand meme de ton aide peut etre est ce la solution
Messages postés
113
Date d'inscription
vendredi 5 mars 2004
Statut
Membre
Dernière intervention
11 février 2008

je vois pas le probleme... honnettement tu dois avoir un espace ou qqch comme ca, non?
Afficher les 19 commentaires

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.