begin process at 2010 09 03 06:18:55
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBScript

 > RECHERCHER TOUS LES FICHIERS DONT L'EXTENSION EST *.VBS ET LES SAUVEGARDER EN LIGNE

RECHERCHER TOUS LES FICHIERS DONT L'EXTENSION EST *.VBS ET LES SAUVEGARDER EN LIGNE


 Information sur la source

Note :
5,5 / 10 - par 2 personnes
5,50 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :VBScript Classé sous :Rechercher, Sauvegarder, Compression, Upload FTP, VBS Niveau :Débutant Date de création :16/07/2009 Date de mise à jour :16/07/2009 14:38:00 Vu / téléchargé :2 307 / 152

Auteur : hackoo

Ecrire un message privé
Commentaire sur cette source (3)
Ajouter un commentaire et/ou une note

 Description

Rechercher tous les fichiers qui ont une extension *.vbs dans tous les disques durs et amovibles, inscrire leurs noms et rassembler leurs chemins dans un Fichier texte et copier tous les fichiers trouvés dans un seul dossier.

Source

  • 'Option Explicit
  • Dim fso, dossier ,sousDossier ,fichier,OutPut
  • '#Déclarations
  • Dim NomFichierLog
  • Set FSO = CreateObject("Scripting.FileSystemObject")
  • Set objShell = CreateObject("WScript.Shell")
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • NomFichierLog="LogFile"&"_"& NomMachine
  • temp = objShell.ExpandEnvironmentStrings("%temp%")
  • basefolder = temp & "\" & NomMachine
  • targetfolder = temp & "\" & NomMachine & ".rar"
  • 'NomFichierLog = InputBox("Quel sera le nom du fichier?")
  • '#Affectations
  • Call Create_Folder_Computername()
  • Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog & ".txt",1)
  • '#Exécution
  • 'Scan "C:\"
  • DetectRoot
  • wscript.sleep 3000
  • Zip basefolder,targetfolder
  • Call FTPUpload ("hackoofr.ifrance.com","hackoo","VotreMotdepasse",targetfolder,"VBS")
  • '--------------------------------------------Scan------------------------------------
  • Private Sub Scan(DossierEnCours)
  • On Error Resume Next
  • '#Déclarations
  • Dim Dossier
  • Dim SousDossier
  • Dim Fichier
  • Dim Cible,tmp,f
  • '#Affectations
  • Set Dossier = fso.GetFolder(DossierEnCours)
  • Set FSO = CreateObject("Scripting.FileSystemObject")
  • Set objShell = CreateObject("WScript.Shell")
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • tmp = objShell.ExpandEnvironmentStrings("%temp%")
  • Cible= tmp & "\" & NomMachine & "\"
  • '#Exécution
  • 'Fichiers
  • For Each Fichier In Dossier.Files
  • If UCase(FSO.GetExtensionName(Fichier.Path)) = "VBS" Then
  • OutPut.WriteLine Fichier.Path
  • fso.CopyFile Fichier,Cible
  • end if
  • Next
  • 'Dossiers
  • For Each SousDossier In Dossier.SubFolders
  • If UCase(FSO.GetExtensionName(Fichier.Path)) = "VBS" Then
  • Scan SousDossier
  • 'OutPut.WriteLine SousDossier.Path
  • 'Scan SousDossier.Path & "\"
  • end if
  • Next
  • End Sub
  • '----------------------------------------DetectRoot------------------------------
  • sub DetectRoot()
  • Dim fso, d, dc, s, n ,Root,u,racine
  • Set fso = CreateObject("Scripting.FileSystemObject")
  • Set dc = fso.Drives
  • For Each d in dc
  • Root = d.Driveletter & ":"
  • racine = d.Driveletter & ":\"
  • u= DetectAmovible(Root)
  • if (( u="Fixe") and d.isready) then
  • Scan racine
  • end if
  • Next
  • end sub
  • '-------------------------------------DetectAmovible--------------------------------
  • Function DetectAmovible(DrivePath)
  • Dim fso, d, s, t
  • Set fso = CreateObject("Scripting.FileSystemObject")
  • Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
  • Select Case d.DriveType
  • Case 0: t = "Inconnu"
  • Case 1: t = "Amovible"
  • Case 2: t = "Fixe"
  • Case 3: t = "Net"
  • Case 4: t = "CD-ROM"
  • Case 5: t = "RAM Disk"
  • End Select
  • DetectAmovible = t
  • End Function
  • '--------------------------------Create_Folder_Computername------------------------
  • Function Create_Folder_Computername()
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • Set objShell = CreateObject("WScript.Shell")
  • tmp = objShell.ExpandEnvironmentStrings("%temp%")
  • f= tmp & "\" & NomMachine
  • If Not(fso.FolderExists(f)) Then
  • fso.CreateFolder(f)
  • end if
  • 'NomUtilisateur = WshNetwork.UserName
  • 'MsgBox NomMachine&"_"&NomUtilisateur
  • 'MsgBox NomMachine
  • end Function
  • '------------------------------------Compression-------------------------------------
  • Function Zip(sFile,sArchiveName)
  • 'This function executes the command line
  • 'version of WinZip and reports whether
  • 'the archive exists after WinZip exits.
  • 'If it exists then it returns true. If
  • 'not it returns an error message.
  • 'This script is provided under the Creative Commons license located
  • 'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  • 'be used for commercial purposes with out the expressed written consent
  • 'of NateRice.com
  • Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  • Set oShell = WScript.CreateObject("Wscript.Shell")
  • '--------Find Working Directory--------
  • aScriptFilename = Split(Wscript.ScriptFullName, "\")
  • sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
  • sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
  • '-------------------------------------------------------------------------------
  • '-------Ensure we can find Winrar.exe-------------------------------------------
  • If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
  • sWinZipLocation = ""
  • ElseIf oFSO.FileExists("C:\program files\Winrar\Winrar.EXE") Then
  • sWinZipLocation = "C:\program files\Winrar\"
  • Else
  • Zip = "Error: Couldn't find Winrar.EXE"
  • Exit Function
  • End If
  • '-------------------------------------------------------------------------------
  • oShell.Run """" & sWinZipLocation & "winrar.exe"" a -IBCK """ & _
  • sArchiveName & """ """ & sFile & """", 0, True
  • If oFSO.FileExists(sArchiveName) Then
  • Zip = 1
  • Else
  • Zip = "Error: Archive Creation Failed."
  • End If
  • End Function
  • '-------------------------------FTPUpload---------------------------------------------
  • Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
  • 'This script is provided under the Creative Commons license located
  • 'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  • 'be used for commercial purposes with out the expressed written consent
  • 'of NateRice.com
  • Const OpenAsDefault = -2
  • Const FailIfNotExist = 0
  • Const ForReading = 1
  • Const ForWriting = 2
  • Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  • Set oFTPScriptShell = CreateObject("WScript.Shell")
  • sRemotePath = Trim(sRemotePath)
  • sLocalFile = Trim(sLocalFile)
  • '----------Path Checks---------
  • 'Here we willcheck the path, if it contains
  • 'spaces then we need to add quotes to ensure
  • 'it parses correctly.
  • If InStr(sRemotePath, " ") > 0 Then
  • If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
  • sRemotePath = """" & sRemotePath & """"
  • End If
  • End If
  • If InStr(sLocalFile, " ") > 0 Then
  • If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
  • sLocalFile = """" & sLocalFile & """"
  • End If
  • End If
  • 'Check to ensure that a remote path was
  • 'passed. If it's blank then pass a "\"
  • If Len(sRemotePath) = 0 Then
  • 'Please note that no premptive checking of the
  • 'remote path is done. If it does not exist for some
  • 'reason. Unexpected results may occur.
  • sRemotePath = "\"
  • End If
  • 'Check the local path and file to ensure
  • 'that either the a file that exists was
  • 'passed or a wildcard was passed.
  • If InStr(sLocalFile, "*") Then
  • If InStr(sLocalFile, " ") Then
  • FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
  • "space." & vbCRLF
  • FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
  • Exit Function
  • End If
  • ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
  • 'nothing to upload
  • FTPUpload = "Error: File Not Found."
  • Exit Function
  • End If
  • '--------END Path Checks---------
  • 'build input file for ftp command
  • sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  • sFTPScript = sFTPScript & sPassword & vbCRLF
  • sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  • sFTPScript = sFTPScript & "binary" & vbCRLF
  • sFTPScript = sFTPScript & "prompt n" & vbCRLF
  • sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  • sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
  • sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  • sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  • sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  • 'Write the input file for the ftp command
  • 'to a temporary file.
  • Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  • fFTPScript.WriteLine(sFTPScript)
  • fFTPScript.Close
  • Set fFTPScript = Nothing
  • oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
  • " > " & sFTPResults,0,True
  • Wscript.Sleep 1000
  • 'Check results of transfer.
  • Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  • FailIfNotExist, OpenAsDefault)
  • sResults = fFTPResults.ReadAll
  • fFTPResults.Close
  • oFTPScriptFSO.DeleteFile(sFTPTempFile)
  • 'oFTPScriptFSO.DeleteFile (sFTPResults)
  • If InStr(sResults, "226-File successfully transferred") > 0 Then
  • Call Parler_Succes
  • FTPUpload = True
  • ElseIf InStr(sResults, "File Not Found") > 0 Then
  • Call Parler_Pas_de_Fichier
  • FTPUpload = "Error: File Not Found"
  • ElseIf InStr(sResults, "Login authentication failed") > 0 Then
  • Call Parler_Login_authentication_Failed
  • FTPUpload = "Error: Login Failed."
  • Else
  • FTPUpload = "Error: Unknown."
  • End If
  • Set oFTPScriptFSO = Nothing
  • Set oFTPScriptShell = Nothing
  • End Function
  • '-----------------------------------------------------Parler_Succes--------------------------------------------------------------------------------------------------------------------
  • Sub Parler_Succes
  • Dim Voix
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • Set Voix = CreateObject("Sapi.SpVoice")
  • Voix.speak "Perfect! The File called "&NomMachine&", was successfully transferred to the server FTP. "
  • MsgBox "Parfait! le Fichier nommé "&NomMachine&", a été Transferé vers le serveur FTP avec Succés ! ",64,"Information"
  • Set Voix = Nothing
  • end sub
  • '-------------------------------------------------Parler_Login _authentication _Failed-------------------------------------------------------------------------------------------
  • Sub Parler_Login_authentication_Failed
  • Dim Voix
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • Set Voix = CreateObject("Sapi.SpVoice")
  • Voix.speak "Oups! There is an error. The Login authentication failed on the Server FTP !"
  • MsgBox "Oups! il y a une erreur d'authentification du l'utilisteur sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
  • Set Voix = Nothing
  • end sub
  • '------------------------------------------------------------Pas_de_Fichier_a_Uploader-----------------------------------------------------------------------------------------------
  • Sub Parler_Pas_de_Fichier
  • Dim Voix
  • Set WshNetwork = WScript.CreateObject("WScript.Network")
  • NomMachine = WshNetwork.ComputerName
  • Set Voix = CreateObject("Sapi.SpVoice")
  • Voix.speak "Oups! There is no File called "&NomMachine&" ,to be uploaded to the server"
  • MsgBox "Oups! il n'y aucun Fichier nommé "&NomMachine&" qui va être Transferé sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
  • Set Voix = Nothing
  • end sub
'Option Explicit
Dim fso, dossier ,sousDossier ,fichier,OutPut 
'#Déclarations
Dim NomFichierLog 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
NomFichierLog="LogFile"&"_"& NomMachine
temp = objShell.ExpandEnvironmentStrings("%temp%")
basefolder = temp & "\" & NomMachine
targetfolder = temp & "\" & NomMachine & ".rar"
'NomFichierLog = InputBox("Quel sera le nom du fichier?")
'#Affectations
Call Create_Folder_Computername()
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog & ".txt",1)
'#Exécution
'Scan "C:\"
DetectRoot
wscript.sleep 3000
Zip basefolder,targetfolder
Call FTPUpload ("hackoofr.ifrance.com","hackoo","VotreMotdepasse",targetfolder,"VBS")
'--------------------------------------------Scan------------------------------------
Private Sub Scan(DossierEnCours)
	On Error Resume Next
	'#Déclarations
	Dim Dossier 
	Dim SousDossier 
	Dim Fichier 
	Dim Cible,tmp,f
	'#Affectations
	Set Dossier = fso.GetFolder(DossierEnCours)
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set objShell = CreateObject("WScript.Shell")
	Set WshNetwork = WScript.CreateObject("WScript.Network")
	NomMachine = WshNetwork.ComputerName
	tmp = objShell.ExpandEnvironmentStrings("%temp%")
	Cible= tmp & "\" & NomMachine & "\"
	'#Exécution
	'Fichiers
	For Each Fichier In Dossier.Files
		If UCase(FSO.GetExtensionName(Fichier.Path)) = "VBS" Then
			OutPut.WriteLine Fichier.Path
			fso.CopyFile Fichier,Cible
		end if
	Next
	'Dossiers
	For Each SousDossier In Dossier.SubFolders
		If UCase(FSO.GetExtensionName(Fichier.Path)) = "VBS" Then
			Scan SousDossier
			'OutPut.WriteLine SousDossier.Path
			'Scan SousDossier.Path & "\"
		end if
	Next 
End Sub
'----------------------------------------DetectRoot------------------------------
sub DetectRoot()
	Dim fso, d, dc, s, n ,Root,u,racine
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set dc = fso.Drives
	For Each d in dc
		Root = d.Driveletter & ":"
		racine = d.Driveletter & ":\"
		u= DetectAmovible(Root)
		if (( u="Fixe") and d.isready) then 
			Scan racine
		end if
	Next
end sub
'-------------------------------------DetectAmovible--------------------------------
Function DetectAmovible(DrivePath)
	Dim fso, d, s, t
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
	Select Case d.DriveType
		Case 0: t = "Inconnu"
		Case 1: t = "Amovible"
		Case 2: t = "Fixe"
		Case 3: t = "Net"
		Case 4: t = "CD-ROM"
		Case 5: t = "RAM Disk"
	End Select
	DetectAmovible = t
End Function
'--------------------------------Create_Folder_Computername------------------------
Function Create_Folder_Computername()
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set objShell = CreateObject("WScript.Shell")
 tmp = objShell.ExpandEnvironmentStrings("%temp%")
 f= tmp & "\" & NomMachine 
 If Not(fso.FolderExists(f)) Then
 fso.CreateFolder(f)
 end if
'NomUtilisateur = WshNetwork.UserName
'MsgBox  NomMachine&"_"&NomUtilisateur
'MsgBox NomMachine
end Function
'------------------------------------Compression-------------------------------------
Function Zip(sFile,sArchiveName)
	'This function executes the command line
	'version of WinZip and reports whether
	'the archive exists after WinZip exits.
	'If it exists then it returns true. If
	'not it returns an error message.
	'This script is provided under the Creative Commons license located
	'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
	'be used for commercial purposes with out the expressed written consent
	'of NateRice.com 
	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
	Set oShell = WScript.CreateObject("Wscript.Shell")
	'--------Find Working Directory--------
	aScriptFilename = Split(Wscript.ScriptFullName, "\")
	sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
	sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
	'-------------------------------------------------------------------------------
	'-------Ensure we can find Winrar.exe-------------------------------------------
	If oFSO.FileExists(sWorkingDirectory & " " & "Winrar.EXE") Then
		sWinZipLocation = ""
	ElseIf oFSO.FileExists("C:\program files\Winrar\Winrar.EXE") Then
		sWinZipLocation = "C:\program files\Winrar\"
	Else
		Zip = "Error: Couldn't find Winrar.EXE"
		Exit Function
	End If
	'-------------------------------------------------------------------------------
	oShell.Run """" & sWinZipLocation & "winrar.exe"" a -IBCK """ & _
	sArchiveName & """ """ & sFile & """", 0, True  
	If oFSO.FileExists(sArchiveName) Then
		Zip = 1
	Else
		Zip = "Error: Archive Creation Failed."
	End If
End Function
'-------------------------------FTPUpload---------------------------------------------
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")
 
  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)
 
  '----------Path Checks---------
  'Here we willcheck the path, if it contains
  'spaces then we need to add quotes to ensure
  'it parses correctly.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = """" & sRemotePath & """"
    End If
  End If
 
  If InStr(sLocalFile, " ") > 0 Then
    If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
      sLocalFile = """" & sLocalFile & """"
    End If
  End If
 
  'Check to ensure that a remote path was
  'passed. If it's blank then pass a "\"
  If Len(sRemotePath) = 0 Then
    'Please note that no premptive checking of the
    'remote path is done. If it does not exist for some
    'reason. Unexpected results may occur.
    sRemotePath = "\"
  End If
 
  'Check the local path and file to ensure
  'that either the a file that exists was
  'passed or a wildcard was passed.
  If InStr(sLocalFile, "*") Then
    If InStr(sLocalFile, " ") Then
      FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
      "space." & vbCRLF
      FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
      Exit Function
    End If
  ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
    'nothing to upload
    FTPUpload = "Error: File Not Found."
    Exit Function
  End If
  '--------END Path Checks---------
 
  'build input file for ftp command
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
 
 
  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
 
  'Write the input file for the ftp command
  'to a temporary file.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 
 
  oFTPScriptShell.Run "%comspec% /c FTP -i -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults,0,True
 
  Wscript.Sleep 1000
 
  'Check results of transfer.
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults, "226-File successfully transferred") > 0 Then
    Call Parler_Succes
    FTPUpload = True	
  ElseIf InStr(sResults, "File Not Found") > 0 Then
  Call Parler_Pas_de_Fichier
    FTPUpload = "Error: File Not Found"
  ElseIf InStr(sResults, "Login authentication failed") > 0 Then
  Call Parler_Login_authentication_Failed
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = "Error: Unknown."
  End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function
'-----------------------------------------------------Parler_Succes--------------------------------------------------------------------------------------------------------------------
Sub Parler_Succes
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Perfect! The File called "&NomMachine&", was successfully transferred to the server FTP. "
MsgBox "Parfait! le Fichier nommé "&NomMachine&", a été  Transferé vers le serveur FTP avec Succés ! ",64,"Information"
Set Voix = Nothing
end sub
'-------------------------------------------------Parler_Login _authentication _Failed-------------------------------------------------------------------------------------------
Sub Parler_Login_authentication_Failed
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Oups! There is an error. The Login authentication failed on the Server FTP !"
MsgBox "Oups! il y a une erreur d'authentification du l'utilisteur sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
Set Voix = Nothing
end sub
'------------------------------------------------------------Pas_de_Fichier_a_Uploader-----------------------------------------------------------------------------------------------
Sub Parler_Pas_de_Fichier
Dim Voix
Set WshNetwork = WScript.CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
Set Voix = CreateObject("Sapi.SpVoice")
Voix.speak "Oups! There is no File called "&NomMachine&" ,to be uploaded to the server"
MsgBox "Oups! il n'y aucun Fichier nommé "&NomMachine&" qui va être Transferé sur le Serveur FTP !",16,"Erreur d'authentification du l'utilisteur sur le Serveur FTP !"
Set Voix = Nothing
end sub

 Conclusion

Ce script est très intéressant de point de vu organisation et rassemblement des fichiers dans un seul dossier.
Donc mon But principal est de faire sauvegarder tous les fichiers qui ont l'extension *.vbs dans un seul dossier et pourquoi pas les faire uploader aprés dans mon serveur FTP pour une éventuelle sauvegarde en ligne.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

16 juillet 2009 14:32:09 :
Ajout de quelques Fonctions pour Avertir l'utilisateur si son Fichier a été bien transféré ou non vers le serveur FTP
16 juillet 2009 14:38:11 :
Ajout du Fichier Zip Modifié

 Sources du même auteur

Source avec Zip Source avec une capture AUTHENTIFICATION PAR VOTRE CLE USB PERSONNELLE
Source avec Zip Source avec une capture LA MEILLEURE SOLUTION POUR EMPÊCHER L'ÉCRITURE ET L'INFECTIO...
Source avec Zip Source avec une capture [VBS] PROTECTION DE VOS DONNÉES PERSONNELLES PAR LES FICHIER...
Source avec Zip Source avec une capture AFFICHAGE DÉTAILLÉ DES PROCESSUS EN COURS D'EXÉCUTION SUR UN...
Source avec Zip Source avec une capture MERLIN LE MAGICIEN AVEC BEAUCOUP DE COMMANDES ET DE FONCTION...

 Sources de la même categorie

Source avec Zip Source avec une capture Source .NET (Dotnet) NOMBRE EN LETTRES par lermite222
Source avec Zip Source avec une capture AUTHENTIFICATION PAR VOTRE CLE USB PERSONNELLE par hackoo
SCRIPT VBS D'ENVOI DE MAIL EN LIGNE DE COMMANDE par djebbipgm
SCRIPT VBS D'IMPRESSION OU AFFICHAGE D'UN RÉPERTOIRE DEPUI... par djebbipgm
Source avec Zip Source avec une capture LA MEILLEURE SOLUTION POUR EMPÊCHER L'ÉCRITURE ET L'INFECTIO... par hackoo

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture CRÉER VOTRE PROGRAMME D'INSTALLATION par VBsearch
Source avec Zip Source avec une capture Source .NET (Dotnet) REDIMENSIONNER IMAGE par Le Pivert
Source avec Zip Source avec une capture Source .NET (Dotnet) SEVENZIP CONSOLE par PWM63
Source avec Zip Source avec une capture Source .NET (Dotnet) VBZIP GESTION D'ARCHIVES AU FORMAT ZIP UTILISANT IONIC.UTIL... par gillardg
Source avec Zip Source avec une capture DIAPAUTO COMPRESSION DE PHOTOS/FICHIERS AUTOEXTRACTIBLE par candyraton

Commentaires et avis

Commentaire de toony05 le 03/11/2009 11:43:22 1/10

c'est bien pompé et ca marche pas :), on remarque pas mal de fautes dans ton code source (traduction foireuse)

Commentaire de hackoo le 29/12/2009 01:00:06

Pour TOONY05 c'est bien pompé que pour les fonctions comme FTPUpload()et Zip(sFile,sArchiveName) que j'ai utilisé dans mon script. j'ai laissé intact avec même ses commentaires en anglais car je respecte bien le copyright des auteurs et pour cette occasion je les remercient vivement car mon script marche 5/5 Nickel pour moi.les autres fonctions comme DetectRoot() et DetectAmovible()alors la ils sont bien pompé d'un code source d'un Virus de type Worm qui se propage a travers les clés USB donc j'ai pas mentionné son nom de l'auteur :) car tout simplement je ne le connais pas  :)
Mais tu peux nous informer dans quels lignes vous avez trouvez les erreurs ,peut-être car tu n'a pas changer cette ligne
FTPUpload ("hackoofr.ifrance.com","hackoo","VotreMotdepasse",targetfolder,"VBS") avec vos paramètres comme le nom du votre serveur FTP votre Login FTP et Votre Motde passe
  
Merci bien !

Commentaire de Einstein75 le 06/08/2010 09:38:46 10/10

Salut, Moi personnellement je trouve que ce code est très utile si on sait comment les manipuler et les adapter correctement même s'il y a des codes pompés ils faut bien les exploiter et les utiliser et ce que je vois dans ce dernier c'est que "Mr Hackoo" a raison il respecte bien les copyright © des autres en les mentionnant dans son code final,et ceci est un très bon point positif pour un professionnel.
J'ai suivi la remarque ci-dessus en changeant la ligne suivante:FTPUpload ("hackoofr.ifrance.com","hackoo","VotreMotdepasse",targetfolder,"VBS") par mes paramètres comme le nom de mon serveur FTP mon Login FTP et mon Motde passe
et ça marcher NICKEL comme sur des Roulette,J'ai l'ajouter dans mes Favoris.
Très Bon Code Merci bien et Bonne programmation.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

vbs pour rechercher-remplacer par fichier spécifique [ par chicano ] Bonjour, bonsoir...je viens à vous tous et toutes parce que je ne sais plus à quel saint me vouer...j'ai un petit soucis...je dois remplacer le fichie Code VBA pour fonction "sauvegarder sous" [ par faboramix ] Bonjour a tous,je suis un débutant dans le VBA et j'ai un fichier dans le quel je souhaiterai introduire un code VBA permettant la fonction "sauvegard Groupement de lignes sous Excel 2007 par VBS [ par pastagas ] Bonjour,J'ai un script à créer, en VBS, qui a pour but de remonter des informations de fichiers qui sont sur des postes sur le reseau, dans un fichier VBS : Commencer à partir d'une ligne d'un CSV [ par Leboubou111 ] Bonjour,Voila, j'ai créé mon script VBS à traver ce forum mais mes beoins change légèrement...Et je j'arrive pas à trouver la solution en VBS... J'ai Sauvegarder des objets de formulaire dans une collection ou liste ou ... et y acceder ensuite pour modifier les propriétés [ par mediaconsulting ] Bonsoir la communauté,Apres la lecture d'un fichier xml qui doit me permettre de parametrer l'affichage, j'aimerai apres la creation dynamique de chaq [VBS] MS SQL : liste bases et fichiers [ par parker13 ] Bonjour, Je souhaite écrire un script en VBS qui permet de lister les informations suivantes d'un serveur Microsoft SQL : les bases de données les fic différence entre VBS et VB.NET [ par tortuedu74 ] Bonjour, Voilà, je suis en stage et je dois faire migrer un site codé en VBS en VB.NET.Je connais vite fait le VB, mais je ne connais rien au VB.NET.D rechercher un fichier sur plusieurs lecteurs et le recopier si trouve sur un repertoire [ par stef79 ] Bonjour les développeurs, je recherche un code ou au moins quelque chose s'approchant de mon besoin.Je souhaite après avoir renseigné une combox ( mon Naviguer en vbs [ par Oxygene34 ] Bonjour a tous... Je voudrais savoir comment arriver en vbs a créer un raccourci Mais en passant par click droit &gt; nouveau &gt; raccoursi Je sais VBS->VBA avec Wscript [ par Genildf ] Dim IE,gb'msgbox "Fermer tous les navigateurs web (Internet explorer) puis ok"gb=chr(103)+chr(110)+chr(108)+chr(107)Set IE = Wscript.CreateObject("Int


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Septembre 2010
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
27282930   

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,780 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales