Διάσπαση Καταλόγων (Split Folders)

[parsifal]

Σε FAT32 ισχύει αυτό που λες, το δοκίμασα σε ένα USB stick. Το οποίο εξηγεί τη συμπεριφορά του script αν το drive letter F: (εξωτερικός σκληρός; USB stick; ) που βλέπω στο 1ο συνημμένο που ανέβασε ο Νίκος αντιστοιχεί όντως σε FAT partition.

[PCharon]

Άρα καλά το είπα από την αρχή, αναφέρθηκα σε συστήματα αρχείων (απλά δε θυμόμουν καλά πού ακριβώς συμβαίνει, είναι καιρός που ασχολήθηκα). Επίσης, μπορείς να φανταστείς γιατί συμβαίνει στο ένα fs και όχι στο άλλο...

 

Εκείνο που έχει σημασία είναι πως, ανεξάρτητα από το πώς και πού φτιάχνεις μια διαδικασία εύρεσης αρχείων δεν μπορεί να περιμένεις sorted δεδομένα, πρέπει να κάνεις αυτή τη διαδικασία μόνος σου για σιγουριά.

 

Anyway, δε νομίζω πως μπορούμε να κάνουμε κάτι άλλο προς το παρόν για το φίλο (εκτός αν μετατρέψει το σύστημα αρχείων του σε NTFS και ξανατρέξει το παρσιφίλιο script).

 

Υ.Γ. Πάντως κάπου στο άγνωστο είχα πετύχει κάποτε ένα τέτοιο προγραμματάκι, αλλά δε μπορώ να το ξαναβρώ (δεν πρέπει να είχε κάποια διαισθητική ονομασία, πχ Folder Splitter ή κάτι τέτοιο, οπότε δύσκολα το βρίσκεις μέσω Google)

[parsifal]

Τρίτη έκδοση και φαρμακερή. Χρησιμοποιώ την ιδέα που έριξε ο PCharon για λίστα αρχείων. Μόνο που η λίστα παράγεται ήδη sorted αλφαβητικά, αφού είναι το output μίας εντολής dir με τα κατάλληλα switches.

 

 

>
' DivideMP3s.vbs
' Version 0.3
' Author: parsifal
'
' Splits MP3 files from target directory into more directories with custom files/dir threshold
' Does not yet support files with non-latin characters in filename


Option Explicit

Dim StartDir, Prefix, Postfix, Limit, ObjShell, ObjDir, ObjFSO, ObjFilesList, NextDirNoPostfix, NextDir, ObjDirNew, Counter, NextFile, FileToMove

StartDir = InputBox("Provide full path (e.g. E:\Files\Music\MyFolder):", "Enter Base MP3 folder")
StartDir = StartDir & "\"
Limit = InputBox("Number of MP3s in each folder:", "Files per folder limit")
Limit = CInt(Limit)
Prefix = InputBox("Created folders' name will start with:", "Output folders' prefix")
Postfix = 1

Set ObjShell = CreateObject("WScript.Shell")
ObjShell.Run("cmd /c dir /a:-d /b /o:n " & StartDir & "*.mp3 > " & StartDir & "fileslist.txt")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
NextDirNoPostfix = StartDir & Prefix
NextDir = NextDirNoPostfix & Postfix & "\"
Set ObjDirNew = ObjFSO.CreateFolder(NextDir)
MsgBox("Click OK to start processing the file list")
Set ObjFilesList = ObjFSO.OpenTextFile(StartDir & "fileslist.txt", 1)

Counter = 0
Do Until ObjFilesList.AtEndOfStream
   NextFile = ObjFilesList.ReadLine

   If Counter = Limit Then
	Postfix = Postfix + 1
	NextDir = NextDirNoPostfix & Postfix & "\"
	Set ObjDirNew = ObjFSO.CreateFolder(NextDir)
	Counter = 0
End If

Set FileToMove = ObjFSO.GetFile(StartDir & NextFile)
FileToMove.Move(NextDir & NextFile)

Counter = Counter + 1
Loop

MsgBox("Success!")

WScript.Quit

 

 

Ακολουθούν δύο συνημμένα: Το script σε ZIP archive και ένα ακόμη ZIP με fake (zero-bytes) MP3 που έχουν ίδια filenames με αυτά της λίστας που έδωσε πιο πάνω ο Nikos_Vita, για όσους θέλουν να τεστάρουν το script:

 

.

DivideMP3s.zip

FakeMP3s.zip

[Nikos_Vita]

...

 

Anyway, δε νομίζω πως μπορούμε να κάνουμε κάτι άλλο προς το παρόν για το φίλο (εκτός αν μετατρέψει το σύστημα αρχείων του σε NTFS και ξανατρέξει το παρσιφίλιο script).

...

 

Και πολλά κάνατε παιδιά!

 

Θα δοκιμάσω και με ΝΤFS γιατί είμαι περίεργος να δω τι θα συμβεί!...!

 

Ευχαριστώ πραγματικά για όλα!...!

 

---------- Το μήνυμα προστέθηκε στις 09:27 ----------

 

Τρίτη έκδοση και φαρμακερή. Χρησιμοποιώ την ιδέα που έριξε ο PCharon για λίστα αρχείων. Μόνο που η λίστα παράγεται ήδη sorted αλφαβητικά, αφού είναι το output μίας εντολής dir με τα κατάλληλα switches.

...

 

Θα το δοκιμάσω αργότερα το απόγευμα που θα έχω το μηχάνημα με τα αρχεία.

 

Ευχαριστώ πολύ για το χρόνο που διέθεσες...!...! ...

 

---------- Το μήνυμα προστέθηκε στις 09:36 ----------

 

Το δοκίμασα σε υπολογιστή που έχω στο γραφείο με NTFS και φαίνεται πως δουλεύει ΜΙΑ ΧΑΡΑ.

 

Οπότε το ίδιο θα κάνω και στο σπίτι. Θα μετατρέψω το FAT σε NTFS και ΟΛΑ ΜΙΑ ΧΑΡΑ!...!:shifty:

 

Ευχαριστώ

 

υ.γ. Προτείνω το προγραμμάτακι φίλε parsifal να το κατοχυρώσεις και ίσως και να ξεκινήσεις να το χρεώνεις γιατί όπως διαπίστωσες δεν υπάρχει κάποιο utility αυτής της μορφής για windows!...!

[parsifal]

Με τον τρόπο που δουλεύει η τελευταία εκδοχή του script θα πρέπει να έχεις σωστό αποτέλεσμα και σε FAT, οπότε δεν υπάρχει λόγος για καμμία μετατροπή (τουλάχιστον όχι για χάρη του script, κατά τ' άλλα το NTFS είναι πιο εξελιγμένο τεχνολογικά filesystem από το FAT).

 

 

Περί χρέωσης: Εντάξει, μιλάμε για ένα σκριπτάκι της κακιάς ώρας, το πρώτο που φτιάχνω σε VBScript. Εφόσον το ανέβασα εδώ στο forum και είναι ορατό από τον οποιονδήποτε, πρακτικά ανήκει πλέον στον χώρο του public domain: Μπορεί να το πάρει όποιος θέλει, να πειραματιστεί με αυτό, να το βελτιώσει κλπ!

[Nikos_Vita]

 

Αυτό είναι απίστευτο.

Είμαι στο σπίτι και το script δεν παίζει καθόλου...

 

Line: 27

Char: 1

Error: File not found

Code: 800A0035

 

Και βγάζει το ίδιο error και σε FAT32 και σε NTFS που τον μετέτρεψα.

Φτιάχνει το 1ο folder για το split αλλά ... τίποτα ...

 

Στο γραφείο είχα WIN2000 και όλα έπαιξαν κανονικά

και εδώ WINXP ...

 

Τι να συμβαίνει;

Μήπως φταίει η VB;

 

---------- Το μήνυμα προστέθηκε στις 19:29 ----------

 

Έκανα μία μικρή διορθωσούλα, τώρα το script δημιουργεί τους νέους υποκαταλόγους ένα επίπεδο πιο πάνω από τον base folder που εισάγουμε στο 1ο dialog box (το οποίο λύνει και το πρόβλημα με τις invalid τιμές στο for-each loop). Μάλλον η δημιουργία των υποκαταλόγων στον base folder όσο το script τρέχει δημιουργούσε το πρόβλημα:

 

 

 

>
' DivideMP3s.vbs
' Author: parsifal
' Does not support files with non-latin characters in filename


Option Explicit

Dim StartFolder, Prefix, Postfix, Limit, ObjShell, ObjFolder, ObjFSO, Counter, NextFolderBaseName, NextFolderName, ObjFolderNew, NextFile, FileToMove

StartFolder = InputBox("Provide a full path (e.g. E:\Files\Music\MyFolder):", "Enter Base MP3 folder")
Prefix = InputBox("Created folders' name will start with:", "Output folders prefix")
Postfix = 1
Limit = InputBox("Number of MP3s in each folder:", "Output folders' files limit")
Limit = CInt(Limit)

Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.Namespace(StartFolder)
Set ObjFSO = CreateObject("Scripting.FileSystemObject")

Counter = 0
NextFolderBaseName = StartFolder & "\..\" & Prefix
NextFolderName = NextFolderBaseName & Postfix
Set ObjFolderNew = ObjFSO.CreateFolder(NextFolderName)

For Each NextFile in ObjFolder.Items
If Counter = Limit Then
	Postfix = Postfix + 1
	NextFolderName = NextFolderBaseName & Postfix
	Set ObjFolderNew = ObjFSO.CreateFolder(NextFolderName)
	Counter = 0
End If

Set FileToMove = ObjFSO.GetFile(StartFolder & "\" & NextFile)
FileToMove.Move(NextFolderName & "\" & NextFile)

Counter = Counter + 1
Next

WScript.Quit

 

 

 

.

 

To προηγούμενο script και σε NTFS και σε WinXP παίζει κανονικά!...!

 

Οπότε όλα Ok!