Copie aléatoire de musique pour clé usb mp3

Soyez le premier à donner votre avis sur cette source.

Vue 15 895 fois - Téléchargée 571 fois

Description

Un premier script génère une bibliothèque des fichiers MP3 présent dans un dossier. Un second permet de sélectionner aléatoirement des fichiers de la bibliothèque et les copies sur un support amovible de type clé USB MP3. Le script vérifie, si le fichier n'à pas déjà été copié grâce à un fichier d'historique qui stock tous les fichiers envoyés sur le support de destination. Le nombre de fichier copié varie en fonction de la taille disponible sur le support de destination.
Il est possible de modifier ce script comme bon vous semble pour l'adapter à vos besoins.

Source / Exemple :


'##########################################################
'#              Script crée par Splite                    #
'#                splite@ifrance.com                      #
'##########################################################

Option Explicit

Dim ptObj, ptDossier, Tab1, Tab2, Tab3, Fichier, Dossier, TabMaMusique(),ptDossierMusique
Dim ContenueF, txtF, i, CheminLib, CheminMusique, DossierNomLib,Musique,ptDossierMus, MaMusique,MaLibrairie

'Dossier contenant les fichiers de musique à scanner
MaMusique = "C:\Data\Ma Musique\"

'Dossier où la librairie doit être crée
MaLibrairie = "C:\Data\Ma Musique\Librairie\"

Set ptObj = CreateObject("Scripting.FileSystemObject")
Set ptDossierMusique = ptObj.GetFolder(MaMusique)
Set Musique = ptDossierMusique.SubFolders

i = 1
'On boucle on fonction du nombre de fichier trouvé dans le chemin "MaMusique"
For Each DossierNomLib in Musique
	If DossierNomLib.name <> "Librairie" Then	
	
		CheminLib = MaLibrairie & "Librairie_" & DossierNomLib.name &".txt"
		CheminMusique = MaMusique & DossierNomLib.name
		
		'Création et ouverture d'un fichier librairie suivant le genre trouvé dans le chemin "MaMusique"
		Set txtF = ptObj.OpenTextFile(CheminLib,2,1)
		'J'obtient un objet qui me permettra de scanné les dossiers et fichiers du dossier actuelle 
		Set ptDossierMus = ptObj.GetFolder(CheminMusique)
		Set Fichier = ptDossierMus.Files
		Set Dossier = ptDossierMus.SubFolders
		
		'Appel de la fonction récursive de scan des dossiers
		SauveFichier()
	End If
Next			

MsgBox "La bibliothèque à correctement été crée, " & i & " fichiers trouvés",64,"Bibliothèque crée"

'Fermeture du fichier
txtF.Close
'Destruction de l'object
Set ptObj = Nothing 

'Définition de la fonction récursive 
Function SauveFichier()
	For Each Tab2 in Dossier
		Set ptDossier = ptObj.GetFolder(Tab2)
		Set Dossier = ptDossier.SubFolders
		Set Fichier = ptDossier.Files
		
		For Each Tab1 in Fichier
			If Right(Tab1.name,3) = "mp3" Then
				ContenueF = ptDossier.Path & "\" & Tab1.name
				txtF.WriteLine ContenueF
				i = i+1
			End If
		Next
		
		If Dossier.count <> 0 Then
			For Each Tab3 in Dossier
				SauveFichier()
			Next
		End If
	Next
End Function

'##########################################################
'#              Script crée par Splite                    #
'#                splite@ifrance.com                      #
'##########################################################

Option Explicit

Dim nbAlea, Fichier, Stream, FichSauve, CheminLib, CheminSauve, Drive,TailleFree, remplire,TabFich
Dim Free, FichierSelect, Taille, NbLigne, ptObj, Tab(), NbLigneHist, Exist,lettreSupport,FichLib
Dim jour, mois, annee, Date, i, TabHist(), Selection, TailleMax, CheminDest, nbFichCopie,NomFichLib
Dim MaMusique, j, message, ListeDossier,StreamHist,FichierHist,x

'##########################################################
'#   Informations à modifier avant éxecution du script    #
'##########################################################

'Chemin du fichier d'historique des fichiers copiés
CheminSauve = "C:\Data\Ma musique\Librairie\Historique.txt"

'Dossier contenant les fichiers de musique à scanner
MaMusique = "C:\Data\Ma Musique\"

'Chemin du support de destination
CheminDest = "C:\Data\dest\"

'Chemin du dossier contenant les librairies
CheminLib = "C:\Data\Ma Musique\Librairie\"

'Taille maximum des fichiers à copier
TailleMax = 5

'Mettez 1 pour remplir completement le support de destination et 0 dans le cas contraire 
remplire = 0
'Si vous venez de mettre 0, choisissez la taille max en Mo
TailleFree = 50

'##########################################################
'#                 Fin des modifications                  #
'##########################################################

Sub Copie

	Jour = WeekdayName(Weekday(Day(Now)))
	Mois = MonthName(Month(Now))
	Annee = Year(Now)
	
	Date = jour&" "&Day(Now)&" "&mois&" "&annee
	
	Set ptObj = CreateObject("Scripting.FileSystemObject")
	Set FichLib = ptObj.GetFolder(MaMusique)
	Set NomFichLib = FichLib.SubFolders
	
	ReDim ListeDossier(NomFichLib.count)
	
	message = "Quels genre de musique voulez-vous copier" & VbCrLf & VbCrLf
	j = 1
	For Each TabFich in NomFichLib
		If TabFich.name <> "Librairie" Then
			message = message & j & " " & TabFich.Name & VbCrLf
			ListeDossier(j) = TabFich.Name 
			j = j + 1
		End If
	Next
	
	Selection = InputBox(message,"Fichiers à copier","1")
	
	'Si on Annulation, on quitte le programme 
	If Selection = "" Then
		Exit Sub
	End If
		
	CheminLib = "C:\Data\Ma musique\Librairie\Librairie_" & ListeDossier(Selection) & ".txt"
	
	Taille = 0
	
	Randomize
	'Ouverture en lecture de la librairie
	Set Fichier = ptObj.GetFile(CheminLib)
	Set Stream = Fichier.OpenAsTextStream(1)
	'Ouverture en lecture du fichier Historique.txt
	Set StreamHist = ptObj.OpenTextFile(CheminSauve,1,True)  
	'Connexion sur le support amovible
	Set Drive = ptObj.Drives("C")
	If ptObj.FolderExists(CheminDest) = False Then
		'Création du dossier "Ma Musique" sur le support
		ptObj.CreateFolder(CheminDest)
	End If
	
	'Calcul du nombre de lignes présent dans lib.txt
	NbLigne = 0
	Do While Stream.AtEndOfStream <> True
		NbLigne = NbLigne + 1
		Stream.SkipLine
	Loop
	
	'Calcul du nombre de lignes présent dans Historique.txt
	NbLigneHist = 0
	Do While StreamHist.AtEndOfStream <> True
		NbLigneHist = NbLigneHist + 1
		StreamHist.SkipLine
	Loop
	
	StreamHist.Close
	Set FichierHist = ptObj.GetFile(CheminSauve)
	Set StreamHist = FichierHist.OpenAsTextStream(1)
	
	'Dimensionnement du tableau du fichier d'historique
	ReDim TabHist(NbLigneHist)
	NbLigneHist = NbLigneHist - 1
	
	'Je stock le contenue du fichier Historique.txt dans un tableau
	For i = 0 To NbLigneHist
		TabHist(i)= StreamHist.ReadLine
	Next
	
	'Fermeture du fichier lib.txt afin que le pointeur de ligne remonte en haut du fichier
	Stream.Close
	
	'Ouverture en lecture du lib.txt
	Set Stream = Fichier.OpenAsTextStream(1)
	'Ouverture en écriture du Historique.txt
	Set FichSauve = ptObj.OpenTextFile(CheminSauve,8,1) 
	
	'J'insère la date du jour dans le fichier d'historique
	FichSauve.WriteLine Date
	FichSauve.WriteBlankLines(1)
	
	If remplire = 1 Then 
		'Calcul l'espace restant sur le support
		Free = Drive.FreeSpace * 0.000001
		Free = Round(Free, 0)
	Else
		Free = TailleFree
	End If
	
	'Si l'espace est inférieur à 5 Mo on stope le processus
	If Free < 5 Then
		MsgBox "Pas assez d'espace libre sur le support",16,"Manque d'espace disque"
	Else	
		NbLigne = NbLigne - 1
		ReDim Tab(NbLigne)
		'Je stock le contenue du fichier lib.txt dans un tableau
		For i = 0 To NbLigne
			Tab(i)= Stream.ReadLine
		Next
		
		nbFichCopie = 0
		Do While Taille < Free
			'Génération d'un nombre aléatoire
			nbAlea = Int((NbLigne - 0 + 1) * Rnd + 0)
					
			'J'accède aux propriétés du fichier
			Set FichierSelect = ptObj.GetFile(Tab(nbAlea))
				
			'Je vérifie que le fichié a copier ne la pas été déjà, grace au fichier d'historique
			Exist = 0
			For x=0 To NbLigneHist
				'Comparaison du fichier dans l'historique et celui à copier
				If StrComp(FichierSelect.Path,TabHist(x),vbTextCompare) = 0 Then 
					Exist = 1
				End If 
			Next
			
			If Exist = 0 Then 
				'Si le fichier dépasse 5 Mo on le jette
				If (FichierSelect.Size * 0.000001) <= TailleMax Then
					'Je stock dans le fichier d'historique les fichiers copié sur le support
					FichSauve.WriteLine Tab(nbAlea)
					
					'Additionne la taille des fichiers
					Taille = Taille + Round(FichierSelect.Size * 0.000001)
					'Copie du fichier selectionné aléatoirement sur le support
					ptObj.CopyFile Tab(nbAlea), CheminDest
				End If 
			End If
		'Information sur le nombre total de fichier copié 
		nbFichCopie = nbFichCopie + 1
		Loop
		MsgBox "Copie des fichiers terminée "& nbFichCopie &" fichiers copiés, soit : "& Taille &" Mo",64,"Copie terminée"
	End If
	
	FichSauve.WriteBlankLines(2)
	
	'Fermeture des fichiers
	Stream.Close
	StreamHist.Close
	FichSauve.Close

End Sub

'On appel la fonction de copie aléatoire 
Copie

Conclusion :


Etant donné que c'est mon premier script en VBS, il se peut que vous trouviez quelques bugs, malgré les soins que j'y est apporté...je vous laisse les découvrir

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_tcharafi
Messages postés
1
Date d'inscription
jeudi 11 novembre 2004
Statut
Membre
Dernière intervention
21 avril 2008
-
Ce topic est lié au mien, c'est pour cela que je poste ce commentaire:

http://forums.futura-sciences.com/ [...] ost1664355

ET voilà, ma femme a enfin bossé. !
=> faut bien que les femmes bossent un peu pour la communauté ;o)
je plaisante... mesdames

voici SON soft de sa conception, développé en C#.
On l'a baptisé RFC - Random File Copy
c'est joli comme nom, je trouve... ;o)

téléchargeable ici
http://www.paillassou.com/RFC/RFCv1.0.rar

1ère version BRUT de décoffrage
alors ayez de l'indulgence...

A vos remarques et comentaires...
=> de prochaines versions améliorées arriveront bientôt...
(Merci à ma puce)
Philippe734
Messages postés
309
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
15 juin 2015
-
après presque 4 ans je l'ai amélioré et si vous voulez le tester alors c'est ici :
http://membres.lycos.fr/christall/download/SetupMP3autofit.exe
permet de choisir soit un ensemble de répertoire, soit un ensemble de mp3. peut copier ou déplacer cet ensemble vers le répertoire de son choix. perso je m'en sers très souvent pour remplir mon baladeur mp3.
CYM13
Messages postés
19
Date d'inscription
mercredi 24 mai 2006
Statut
Membre
Dernière intervention
16 octobre 2006
-
a mon avis, tu ferais bien de rajouter un moyen de permetre a l'utilisateur de choisir entre une copie aléatoire et une copie avec seulement les morceaux souhaités. Mais c'est juste une idée comme ça...
Philippe734
Messages postés
309
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
15 juin 2015
-
ton script ne laisse pas bcp le choix l'utilisateur : soit ca ou soit ca pas autre chose mdrr

comme je l'avais dit plus haut je m'en suis inspiré, mais avec une interface. c toi qui m'a donné l'idee de mon soft dont voici le lien www.telecharger.yacapa.com/telechargement/Gravure/MP3+CD+Optimiser-32491.html je t'en parle pas juste pour me faire de la pub, mais pour dire que g réussi à faire ce que je cherchai grace à ton idée, merci :)
cs_Splite
Messages postés
5
Date d'inscription
dimanche 5 octobre 2003
Statut
Membre
Dernière intervention
25 août 2004
-
Je viens de faire quelques mises à jour. Pour en citez une, la librairie ce créer dynamiquement en indiquant seulement le chemin d'un dossier contenant tout les fichiers MP3 répertorier par genre musicale. De son côté le script de copie aléatoire génère lui aussi dynamiquement une InputBox listant tout les genres musicaux du dossier "Ma Musique" par exemple. Il est possible également d'indiquer une taille maximum en Mo des fichiers à envoyer sur le support de destination et non plus de le remplir complètement. Voilà voilà si vous avez des commentaires, ils sont les bienvenues !

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.