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 Umbenennung von Bild-Dateien in einem Verzeichnisbaum nach dem Einsortieren von neuen Bildern for renaming of image-files in a directory-tree after sorting-in of new images

Beim Einsortieren von Bildern in der richtigen Reihenfolge müssen sie oft händisch mehrmals umbenannt werden. Das macht das Programm mit einem Mausklick in allen Unter-Verzeichnissen. Alle Dateien erhalten das gleiche Prefix, aber die Verbesserung der Funktion bei diesem Programm besteht darin, dass nur Dateien umbenannt werden, die Bilddateien sind und deren neuer Name nicht gleich mit dem alten ist. Dadurch werden Festplatten-Operationen gespart. Um Dateinamen-Konflikte beim Umbenennen zu vermeiden, weiss ich keine andere Lösung als alle in Betracht kommende Dateien zuerst in temporäre Namen umzubenennen, die im Verzeichnis nicht vorkommen und danach alle diese Dateien auf ihren neuen Namen umzubenennen, die in den temporären Namen nicht vorkommen. Wenn unter den ursprünglichen Dateinamen einer vorkommt, der zufällig einem temporären Dateinamen gleicht, dafür ist in diesem Programm nichts vorgesehen. Das ist auf dieser Seite beschrieben, wie man damit die temporären Dateinamen wählen müßte, damit kein alter Name darin vorkommt. Zu all dem ist natürlich eine Prozedur gewählt worden, die selbst auch sparsam arbeitet durch Vermeidung unnötiger Programm-Schritte, obwohl sich nun alles Programmlaufen nur mehr in einem Array abspielt und nur das Notwendigste auf der Festplatte. Dazu werden in die Liste der Dateinamen zuerst die temporären Namen als neue Namen eingetragen und dann an das Ende der Liste diese temporären Namen mit den neuen Namen. Da nun aber die Liste in ihrer Länge nicht mehr konstant ist, wird die übliche Zeigertechnik angewandt. Alle nicht-gleichen Bilddateien, auf die der Zeiger zeigt, werden umbenannt, solange bis der Zeiger am Ende der Liste angelangt ist, wobei aber ab dem Ende der ursprünglichen Liste keine mehr hinzu kommen, sodaß es nicht endlos weiter laufen kann.

Das Programm kann ein paar tausend Dateien in Sekunden-Bruchteilen umbenennen, auch wenn es läuft nicht kompiliert im Quellcode. Durch die automatische Zählung, wieviele umzubenennende Dateien in einem Verzeichnis sind, wird die Anzahl der Dezimalstellen und damit die Anzahl der führenden Nullen ermittelt, wodurch in jedem Fall die ursprüngliche alphabetische Reihenfolge der Dateien beibehalten wird.

In vbScript sind bekannte Instruktionen wie MAX, INC, PUSH oder SWAP nicht vorhanden, man kann sich diese aber als solche Routinen selbst schreiben und dann mit der (fast) gleichen Schreibweise im Programm benutzen, wie im Programm gezeigt wird, wodurch dann in den Hauptprozeduren weniger Code ist und der komplizierte Algorithmus übersichtlicher wird.

For sorting-in of images in the right order they must be often renamed manually. This does the program by a mouse-click in all sub-directories. All files get the same prefix, but the improvement of the function in this program is, that only files are renamed, which are image-files and their new name is not equal the old one. By this hard-disk-operations are saved. To avoid file-name-conflicts by the renaming, I do not know any other solution as all files, comming into consideration, rename first into temporary names, which do not occur in the directory and thereafter all these files rename to their new names, which do not occur among the temporary names. If among the original filenames one occurs, which randomly equals a temporary name, for this is nothing forseen. That is described on this page how the temporary filenames would have to be chosen, that no old filename occurs among them. To all this is, of course, chosen a procedure, which works itsself parsimonious by avoiding unneeded program-steps, although now all program-running plays now in an array and only the most-necessary on hard-disk. For this are first enroled the temporary file-names into the list of file-names as new names and then at the end of the list these temporary names with the new names. Because now the list-lenght is no longer constant, the usual pointer-technique is applied. All unequal image-files, on which the pointer points, are renamed, so long until the pointer is arrived at the end of the list, but whereby at the end of the original list no files come too, so that it cannot run on endlessly.

The program can rename a few thousand files in a fraction of a second, though it runs not compiled in source code. By the automatic counting, how many files to rename are in a directory, the number of digits and with it the number of leading zeros are determinded, whereby in any case the original alphabetic order is kept.

In vbScript are well-known instructions as MAX, INC, PUSH or SWAP not available, but one can write these oneself as such routines and then use them with (nearly) the same writing-style in the program, as it is shown in the program, whereby then in the main-procedures there is less code and the complicated algorithm gets clearer.

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
18. Okt 2013 Oct 18th 2013


Option Explicit ' Checks if all variables are declared

' ----------- Declarations of Variables and Objects ------------

Dim fso, GraficFormats, Path, Prefix
Set fso = CreateObject("Scripting.fileSystemObject")

' ----------- Value Assignments --------------------------------

GraficFormats = "pcx.bmp.tif.tiff.gif.png.jpg.jpeg.jp2.cpt.tga"
Path = "c:\Users\Public\Pictures\MyPictureCollection" ' for example in Windows 7
Prefix = "Img-"

' ------------- Program -------------

RenameFilesInATree Path, Prefix, 1

' ------------- Procedures ----------

Sub RenameFilesInATree(AnyPath, AnyPrefix, NrOfDigits)
    Dim A, SubPath: If Mid(AnyPath,2,2) <> ":\" Then Exit Sub
    A = CreateSubPathList (AnyPath, 1): PUSH A,""
    For Each SubPath In A
        RenameFilesInAFolder fso.BuildPath(AnyPath, SubPath), AnyPrefix, NrOfDigits
    Next
End Sub

Sub RenameFilesInAFolder(AnyPath, AnyPrefix, NrOfDigits)
    ' renames files by a prefix and a current number
    ' renames only img-FileNames, of which the new name unequals the old one
    ' and leaves non-img-Filenames unchanged.
    ' to leave the order of the FileNames unchanged, the max number of digits is determined
    ' this number of digits can be predetermined higher by input of a higher NrOfDigits
    Dim A, BothNames ' Arrays
    Dim nr, Ext, tmpName, fName ' Strings
    Dim NrOfNames, Ubd, Ptr, imgCtr ' Numerics
    If Not fso.FolderExists(AnyPath) Then Exit Sub
    A = ListFiles(AnyPath): Ubd = UBound(A): If Ubd < 0 Then Exit Sub
    NrOfNames = 0: Ptr = -1: imgCtr = 0 ' Variable init
    For Each fName In A ' Determine number of digits
        If IsImg(fName) Then INC NrOfNames
    Next: NrOfDigits = Max(Len(CStr(NrOfNames)), NrOfDigits)
    Do: INC Ptr ' Work off the list
        If Ptr <= Ubd Then
            fName = A(Ptr)
            If IsImg(A(Ptr)) Then
                nr = CStr(INC(imgCtr)): While Len(nr) < NrOfDigits: nr = "0" & nr: Wend
                Ext = "." & fso.GetExtensionName(A(Ptr)): fName = AnyPrefix & nr & Ext
            End If: A(Ptr) = A(Ptr) & vbLf & fName
        End If: BothNames = Split(A(Ptr),vbLf)
        Do: If StrComp(BothNames(0), BothNames(1), 1) = 0 Then Exit Do ' Rename only for unequals
            tmpName = "temp-" & Mid(BothNames(1), Len(AnyPrefix)+1)
            If Ptr > Ubd Then
                If StrComp(BothNames(0), BothNames(1), 1) <> 0 Then fName = BothNames(1)
            ElseIf StrComp(BothNames(0), tmpName, 1) <> 0 Then
                PUSH A, tmpName & vbLf & BothNames(1): fName = tmpName
            End If: fso.MoveFile fso.BuildPath(AnyPath, BothNames(0)), fso.BuildPath(AnyPath, fName)
        Loop Until True ' Only one single pass
    Loop Until Ptr = UBound(A)
End Sub

' ----------- In most programs occuring routines -------------

Function CreateSubPathList (AnyPath, SortDirection) ' SortDirection = -1,0,1
    Dim SD, A, Path, ListPos, FolderGroup, ChosenFolder, f, item
    SD = SortDirection: A = Array(): CreateSubPathList = A: Path = AnyPath
    If SD <> 0 And Abs(SD) <> 1 Then Exit Function
    If Mid(Path,2,2) <> ":\" Then Exit Function
    item = BkSl(Path, -1): ListPos = -2
    Do: INC ListPos
        If ListPos > -1 Then item = fso.BuildPath(Path, A(ListPos))
        Set f = fso.GetFolder(item): Set FolderGroup = f.SubFolders
        For Each ChosenFolder In FolderGroup
            Push A, Mid(ChosenFolder, Len(Path) + 2)
        Next
    Loop Until ListPos >= UBound (A)
    CreateSubPathList = Sort(A, SD)
End Function

Function ListFiles(AnyPath)
    Dim fo, fc, fi, f: ListFiles = Array()
    If  Not fso.FolderExists(AnyPath) Then Exit Function
    Set fo = fso.GetFolder(AnyPath): Set fc = fo.Files
    For Each fi In fc
        Set f = fso.GetFile(fi): Push ListFiles, f.Name
    Next
End Function

Function IsImg(AnyName)
    Dim Ext: IsImg = False: Ext = "." & fso.GetExtensionName(AnyName)
    If InStr("." & LCase(GraficFormats) & ".", LCase(Ext) & ".") <> 0 Then IsImg = True
End Function

Function Max(AnyNr1, AnyNr2)
    Max = AnyNr1: If AnyNr2 > AnyNr1 Then Max = AnyNr2
End Function

Function INC(ByRef AnyNr)
    AnyNr = AnyNr + 1: INC = AnyNr
End Function

Sub PUSH(ByRef AnyArr, ByVal AnyVar) ' AnyVar can be a String, Numeric or a Variant Array
    Dim item: If IsEmpty(AnyArr) Then ReDim AnyArr(-1)
    If Not IsArray(AnyVar) Then AnyVar = Array(AnyVar)
    For Each item In AnyVar
        ReDim Preserve AnyArr(UBound(AnyArr)+1): AnyArr(UBound(AnyArr)) = item
    Next
End Sub