[vbs] folder2ftpupload

Télécharger le projet
Commenter

Description

C'est un Vbscript pour uploader un dossier avec tout son contenu (Tout les fichiers) dans votre serveur FTP.C'est un genre d'upload Multiple.
Le Script est de simple utilisation , il vous suffit juste de l'éditer et de modifier les 3 paramètres:

1- Le Nom de votre Serveur FTP
2- Le Nom d’utilisateur (Login)
3- Le Mot de passe

Source / Exemple : 


Dim FTPServer,Login,Password,NomDossier,CheminDossier
Copyright = "FolderFTPUpload © Hackoo © 2012"

'**********-Trois Paramètres à modifier-*************
FTPServer = "ftp.server.com"
Login = "MyLogin"
Password= "MyPassword"
'****************************************************

Call Parcourir_Dossier()

sub Parcourir_Dossier()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour uploader son contenu"&vbcr&vbTab&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
    Wscript.Quit
End If
NomDossier = objFolder.title
CheminDossier = objFolder.self.path
Question = MsgBox("Vous avez Choisi le Dossier " &qq(NomDossier)& " qui se localise dans ce chemin :" &Vbcr& qq(CheminDossier)&vbcr&VbTab&VbTab&VbTab&" Continuez ?",vbYesNo + vbQuestion,"Le Dossier Choisi est "&qq(NomDossier)&" "&Copyright)
If Question = VbYes Then
FolderFTPUpload FTPServer,Login,Password,CheminDossier,NomDossier
else
wscript.Quit
End If
end sub

Function FolderFTPUpload(sSite, sUsername, sPassword, sLocalFolder, sRemotePath) 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
  Set ws = CreateObject("wscript.Shell")
  sRemotePath = Trim(sRemotePath)
  sLocalFolder = Trim(sLocalFolder)
  
  'Vérifier si le chemin, contient des espaces. 
  'si Oui,alors nous avons besoin d'ajouter des guillemets pour s'assurer qu'il passe correctement.
 
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath =  """"&sRemotePath&""""
    End If
  End If
 
  If InStr(sLocalFolder, " ") > 0 Then
    If Left(sLocalFolder, 1) <> """" And Right(sLocalFolder, 1) <> """" Then
      sLocalFolder = """"&sLocalFolder&""""
    End If
  End If
  
 sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  Call ContenuDossier(CheminDossier)

  Set f = oFTPScriptFSO.OpenTextFile(sFTPTemp &"\ContenuDossier.txt", ForReading, OpenAsDefault)
  LireTout = f.ReadAll
  Fichier = split(LireTout,VbcrLF)
  f.Close
  'construire un fichier de configuration pour passer les commandes ftp
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "mkdir " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  For i=LBound(Fichier) to UBound(Fichier)-1
  sFTPScript = sFTPScript & "put "& Fichier(i) & vbCRLF
  Next
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  
 'Ecrire les commandes ftp à passer dans un fichier temporaire.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing
 
  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0, TRUE
 
  'Vérifier le résultat du Transfert de l'upload
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults, "226") > 0 Then
    FolderFTPUpload = True
    MsgBox "Tout les fichiers contenu dans le Dossier : " &sLocalFolder& vbcr & vbcr & " ont été uploadés avec succés !"&vbcr&  LireTout,64,"Résultat du Transfert d'Upload "&Copyright

  ElseIf InStr(sResults, "File not found") > 0 Then
    FolderFTPUpload = "Error: File Not Found"
    MsgBox "Erreur : Fichier Non Trouvé ?",16,"Erreur : Fichier Non Trouvé ? "&Copyright
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
    FolderFTPUpload = "Error: Login Failed."
    MsgBox "Login authentication a echoué !",16,"Login authentication failed ! "&Copyright
  Else
    FolderFTPUpload = "Error: Unknown."
    MsgBox "Erreur: Inconnu ?",16,"Erreur: Inconnu ? "&Copyright
  End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function

sub ContenuDossier(sLocalFolder)
Set ws = CreateObject("wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
sFTPTemp = ws.ExpandEnvironmentStrings("%TEMP%")
if fso.FileExists(sFTPTemp &"\ContenuDossier.txt") Then
  fso.DeleteFile sFTPTemp &"\ContenuDossier.txt"
End if 
Command ="cmd /c for %I in ("&sLocalFolder&"\*.*) do (echo ""%I"") >> "& sFTPTemp &"\ContenuDossier.txt"""
Resultat = ws.run(command,0,True)
End sub

'c'est une fonction très pratique qui sert à ajouter "les doubles quotes dans une variable" 
Function qq(strIn) 
    qq = Chr(34) & strIn & Chr(34)
End Function

Conclusion :


Vos commentaires et vos remarques sont les Bienvenues !
Télécharger le projet

Codes Sources

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 (cs_hackoo)