Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
vbScript
zur Löschung von leeren Verzeichnissen in einem Verzeichnisbaum auf mehreren Laufwerken to delete empty folders in a foldertree on several drives

Dieses Programm kann als Zusatz für Langmeier Backup verwendet werden und kann gestartet werden von einem Sicherungsauftrag von Langmeier Backup.

Man geht davon aus, dass Datensicherungen großer Datenmengen mehrfach auf mehrere Laufwerke gemacht werden. Leere Verzeichnisse werden mitkopiert und sie können eine große Anzahl erreichen und sie stören insbesondere bei der Wiederherstellung. Langmeier Backup löscht die leeren Verzeichnisse nicht, das Programm kann aber von einem Langmeier-Backup-Sicherungsauftrag automatisch gestartet werden. Das Programm erkennt, welche Laufwerke angeschlossen sind und löschte alle leeren Verzeichnisse auf allen Laufwerken in dem, in den angegebenen Basis-Verzeichnissen befindlichen, Verzeichnisbaum, wobei der Laufwerksname zur Adressierung der Löschvorgänge verwendet wird. Man kann auch Ausnahmen eingeben, welche leeren Verzeichnisse nicht gelöscht werden sollen. Wenn man die, im Parameter-Settlings-Teil befindliche, Variable Dummy = True setzt, so werden die leeren Verzeichnisse nicht gelöscht, sondern als Verzeichnis-Liste auf die Festplatte geschrieben. Die Laufzeit des Programms beträgt schätzungsweise bei 18.000 Dateien und 1.700 Verzeichnissen (10 GigaByte) 4 Sekunden pro Festplatte

This program can be used as an addition to Langmeier Backup and can get started by a data saving task of Langmeier Backup.

One starts from the principle, that data-saving of big amounts of data is made manifold on several drives. Empty Folders are copied in common and they can get a big number and they disturb especially by the restorage. Langmeier Backup does not delete empty folders, but the program can be started by a Langmeier-Backup-Datasaving-Task automaticly. The program recognises, which drive is connected and deletes all empty folders on all drives in the foldertrees, which are located in the assigned basefolders, whereby the drive-name is used for adressing of the deletion-process. One can also set exceptions, which empty folders are not to delete. If one sets the variable, which is located in the parameter-settling-part, Dummy = True, the empty folders instead of beeing deleted, are written as folderlist on disk. The runtime of the program by 18.000 files and 1.700 folders (10 GigaByte) should be estimated 4 seconds per drive

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The program ist tested before publication, but there can be given no guarantee, that it is free of errors
19. Nov. 2010 Nov 19th 2010

' Delete empty folders on several drives with more parameter editing comfort

' Declaration of Constants, Variables + Objects

Const ForReading=1, ForWriting=2, ForAppending=8, Yes = 0, No = 1
'   TaskList(i,(Drivename,Driveletter,Basefolder,Exception1...Exception8))
Public TaskList(19,9),Task,NrOfTasksLoweredByOne
Public Folderlist(100000), DriveList (26,2) ' DriveList(DriveLetter, VolumeName)
Public NrOfActualDrivesLoweredByOne, NrOfFoldersLoweredByOne, DriveLetter, Dummy
Public DeleteBaseFolder, NrOfAllFolders
' DeleteBaseFolder is the carrier of a logical constant containing the startposition of the folderlist
Dim fso

' Parameter-Settlings

NrOfTasksLoweredByOne = -1
'       Drivename,Basefolder,Exception1,Exception2...Exception8
ReadIn "DriveName1,Baserfolder1,Exception1,Exception2"
ReadIn "DriveName2,Baserfolder2,Exception1,Exception2"
ReadIn "DriveName2,Baserfolder3,Exception1,Exception2"
ReadIn "DriveName3,Baserfolder4,Exception1,Exception2"
ReadIn "DriveName4,Baserfolder5,Exception1,Exception2"
' It can be chosen an arbitrary number of ReadIn-Lines with several lines
' of the same drivename (and different basefolders)

DeleteBaseFolder = No ' DeleteBaseFolder too (Yes or No)
Dummy = True ' in case of Dummy = True deletion of Empty Folders is replaced by output of the folderlist on disk
DestFileName = "FolderList"

' Conditioning of Variables and Objects

Set fso = CreateObject("Scripting.FileSystemObject")
DestFile = DestFileName & ".txt"

' Program

NrOfActualDrivesLoweredByOne = EdifyActualDriveList
AllNeedyParametersPresent = False
If Dummy = True And fso.FileExists (DestFile) Then fso.DeleteFile(DestFile)
NrOfAllFolders = 0
For Task = 0 To NrOfTasksLoweredByOne
        DesiredDrive = Tasklist(Task,0): Basefolder = Tasklist(Task,1)
        DriveLetter = GetDriveLetterFromDriveName(DesiredDrive)
        If DriveLetter <> "" And Basefolder <> "" Then
                AllNeedyParametersPresent = True
                BaseFolderCompletePath = DriveLetter & ":\" & BaseFolder
                EdifySubFolderList BaseFolderCompletePath ' with exceptions erased and sorted
                DeleteExceptionsFromFolderlist
                DeleteNotEmptyFoldersFromFolderlist
                RemoveAllZeroLenghtStringsFromFolderlist
                SortFolderlist
                ' DeleteEmptyFoldersOnDisk can be switched off by setting Dummy to True
                ' in case of Dummy = True it writes lists of empty folders on disk instead of deleting them
                DeleteEmptyFoldersOnDisk ' with preceeding check if folder is really empty
                NrOfAllFolders = NrOfAllFolders + NrOfFoldersLoweredByOne + 1
        End If
Next
If Dummy = True Then
        WriteNrOfAllFoldersToFile DestFile
        MsgText = "Procedure done"
        If AllNeedyParametersPresent = False Then MsgText = "Any Error in the Program"
        MsgBox MsgText
End If

' End of Program

' Procedures

Sub ReadIn (Parameters)
        NrOfTasksLoweredByOne = NrOfTasksLoweredByOne + 1
        AnyArray = Split(Parameters,",",-1,1)
        For i = 0 To UBound(AnyArray)
                TaskList(NrOfTasksLoweredByOne,i)=AnyArray(i)
        Next
        Erase AnyArray
End Sub

Function GetDriveLetterFromDriveName(AnyDriveName)
        GetDriveLetterFromDriveName = ""
        For ActiveDrive = 0 To NrOfActualDrivesLoweredByOne
                If LCase(DriveList(ActiveDrive,2)) = LCase(AnyDriveName) Then
                        GetDriveLetterFromDriveName = DriveList(ActiveDrive,1): Exit For
                End If
        Next
End Function

Function EdifyActualDriveList
        Set dc = fso.Drives
        DriveNumber = -1
        For Each d In dc
                If d.IsReady Then
                        If d.DriveType = 1 Or d.DriveType = 2 Then
                                DriveNumber = DriveNumber + 1
                                DriveList(DriveNumber,1) = d.DriveLetter
                                DriveList(DriveNumber,2) = d.VolumeName
                        End If
                End If
        Next
        EdifyActualDriveList = DriveNumber
End Function

Sub EdifySubFolderList (AnyFolder)
        NrOfFoldersLoweredByOne = 0: ListPos = -1: Folderlist(0) = AnyFolder
        Do
                ListPos = ListPos + 1
                Set f = fso.GetFolder(Folderlist(ListPos))
                Set FolderGroup = f.SubFolders
                For Each ChosenFolder In FolderGroup
                        NrOfFoldersLoweredByOne = NrOfFoldersLoweredByOne + 1
                        Folderlist(NrOfFoldersLoweredByOne) = ChosenFolder
                Next
        Loop Until ListPos >= NrOfFoldersLoweredByOne
End Sub

Sub DeleteExceptionsFromFolderlist
        For Pos = 0 To NrOfFoldersLoweredByOne
                ToDelete = False
                For Exception = 2 To 9
                        If Tasklist(Task,Exception)="" Then Exit For
                        If InStr(Folderlist(Pos),Tasklist(Task,Exception)) Then ToDelete = True
                Next
                If ToDelete = True Then Folderlist(Pos)=""
        Next
End Sub

Sub DeleteNotEmptyFoldersFromFolderlist
        For Pos = 0 To NrOfFoldersLoweredByOne
                If Folderlist(Pos) <> "" Then
                        FolderEmpty = CheckIfFolderEmpty(Folderlist(Pos))
                        If FolderEmpty = False Then Folderlist(Pos)        = ""
                End If
        Next
End Sub

Sub RemoveAllZeroLenghtStringsFromFolderlist
        ' Folderlist(0...NrOfFoldersLoweredByOne)
        Stackpointer = -1
        For PickPointer = 0 To NrOfFoldersLoweredByOne
                If Folderlist(Pickpointer) <> "" Then
                        Stackpointer =         Stackpointer + 1
                        If Stackpointer <> Pickpointer Then
                                Folderlist(Stackpointer) = Folderlist(Pickpointer)
                                Folderlist(Pickpointer) = ""
                        End If
                End If
        Next
        ' Folderlist(0...Stackpointer)
        NrOfFoldersLoweredByOne = Stackpointer
End Sub

Sub SortFolderlist
        For FirstUnsorted = 1 To NrOfFoldersLoweredByOne - 1
                TopPos=FirstUnsorted: TopWord = Folderlist(FirstUnsorted-1)
                For ProbePos = FirstUnsorted To NrOfFoldersLoweredByOne
                        If Folderlist(ProbePos-1)<TopWord Then TopPos=ProbePos: TopWord=Folderlist(TopPos-1)
                Next
                If TopPos <> FirstUnsorted Then
                        Folderlist(TopPos-1) = Folderlist(FirstUnsorted-1)
                        Folderlist(FirstUnsorted-1) = TopWord
                End If
        Next
End Sub

Sub DeleteEmptyFoldersOnDisk
        LowestFolder = DeleteBaseFolder ' DeleteBaseFolder = (Yes or No)
        If Dummy = True Then
                WriteFolderListToDisk DestFile
        Else
                For item = NrOfFoldersLoweredByOne To LowestFolder Step -1
                        If (fso.FolderExists(Folderlist(item))) Then
                                FolderEmpty = CheckIfFolderEmpty(Folderlist(item))
                                If FolderEmpty = True Then fso.DeleteFolder(Folderlist(item))
                        End If
                Next
        End If
End Sub

Function CheckIfFolderEmpty(folderspec)
        Set f = fso.GetFolder(folderspec)
        Set ffo = f.SubFolders
        Set ffi = f.Files
        FolderEmpty = True
        For Each f1 In ffo
                FolderEmpty = False
        Next
        For Each f1 In ffi
                FolderEmpty = False
        Next
        CheckIfFolderEmpty = FolderEmpty
End Function

Sub WriteFolderListToDisk(AnyFileName)
        Set f = fso.OpenTextFile(AnyFileName, ForAppending, True)
        For item = 0 To NrOfFoldersLoweredByOne
                f.WriteLine Folderlist(item)
        Next
        f.Close
End Sub

Sub WriteNrOfAllFoldersToFile(AnyFileName)
        Set f = fso.OpenTextFile(AnyFileName, ForAppending, True)
        f.WriteLine "Number of Empty Folders = " & CStr(NrOfAllFolders)
        f.Close
End Sub

' End of Procedures