VBS rekursive Verzeichnissuche bricht ab

SUK

Grünschnabel
Hallo,

bei uns wurden vor ca. einem Monat durch einen Virus Dateien verschlüsselt und umbenannt. Die Ursache ist bereits bereinigt. Da aber auf einem System, auf dem Daten ausgelagert sind, erst diese Woche entdeckt wurde, dass auch hier ca. 1700 Dateien betroffen sind, haben wir dort natürlich die verschlüsselten Dateien mit gesichert. Eine Rücksicherung ist zwar möglich, allerdings nicht ganz so einfach. Auf dem Backup werden die ursprünglichen Dateien, welche umbenannt wurden, nicht automatisch gelöscht, so dass diese zumindest aus dem Backup wiederhergestellt werden konnten. Allerdings sind in den Verzeichnissen jetzt jeweils die Originaldatei und die verschüsselte Kopie vorhanden. Der betroffene Verzeichnisbaum umfasst ca. 40 GB an Daten. Die Kopien wollen wir nun mit einem Script verschieben und dann nach Prüfung löschen.
Nun das Problem im Script. Es sollen im Script rekursiv alle Verzeichnisse durchsucht werden. Leider läuft es nur 4 Ordner im Basefolder durch (die Unterverzeichnisse werden dabei alle anscheinend durchgelaufen).
Hat jemand eine Idee, woran dies liegen könnte?
Hinweis: Ich bin kein Programmierer und baue Scripte idR. aus Codeschnippseln zusammen. Somit bitte Verständnis, dass das Progrämmchen nicht "professionell" ist. Besser geht sicher immer.
Der Anspruch ist ... Es muss halt funktionieren und ich will es verstehen.

Visual Basic:
Basefolder = "X:\TechDoku\Standort1\"

Basefolder1 = left(Basefolder, len(Basefolder) - 1)
Basefolder1 = right(Basefolder1, len(Basefolder1) - inStrRev(Basefolder1,"\"))
Savefolder = "X:\Save\"
Logfile = "C:\Temp\DMS_Script\Logfile_" & Basefolder1 & ".txt"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set MyLogfile = oFSO.CreateTextFile(Logfile, true)
MyLogfile.Close

Set MyLogfile = oFSO.OpenTextFile(Logfile, 8)

sub ExecuteFolder (Foldername)
    Dim oFolder1
    Dim oFile, oFile2, oFile2_Path
    Dim SubFolder

    set oFolder1 = oFSO.GetFolder (Foldername)
    MyLogfile.WriteLine (oFolder1)
    For Each oFile In oFolder1.Files
'        Msgbox "Orig: " & oFile.name
        oFile2 = left(oFile, inStrRev(oFile,".")-1)
        if oFile2 <> ""    then
            If (oFSO.FileExists(oFile2)) Then
                MyLogfile.WriteLine (oFile)
                oFile2_Path = left(oFile, inStrRev(oFile,"\"))
                oFile2_Path = Savefolder & right(oFile2_Path, len(oFile2_Path) - inStr(oFile2_Path,"\"))
                oFile2_Fullname = oFile2_Path & oFile.name
'                msgbox "Orig: " & oFile.name & " - " & "Kopie: " & oFile2 & " - " & oFile2_Fullname
                Set objShell = CreateObject("WScript.Shell")
                if oFSO.Folderexists(oFile2_Path) = false then
'                    msgbox "Erstelle """ & oFile2_Path & """"
                    objShell.run "cmd.exe /C mkdir """ & oFile2_Path & """",,true
                    if oFSO.Folderexists(oFile2_Path) = true then
                        MyLogfile.WriteLine (" Sicherungsordner erstellt")
                    else
                        MyLogfile.WriteLine (" Fehler beim Erstellen von " & oFile2_Path)
                    end if
                end if
                Befehl = "cmd.exe /C move """ & oFile & """ """ & oFile2_Fullname & """"
'                msgbox Befehl
                objShell.run Befehl,,true
                If (oFSO.FileExists(oFile2_Fullname)) Then
                    MyLogfile.WriteLine (" verschoben")
                else
                    MyLogfile.WriteLine (" Fehler beim Verschieben nach " & oFile2_Fullname)
                end if
                Set objShell = nothing
            end if
        end if
    Next
    For Each SubFolder in oFolder1.SubFolders
        ExecuteFolder SubFolder.Path
    Next
    set oFolder1 = nothing
end sub

ExecuteFolder (Basefolder)

MyLogfile.Close
Set oFSO = nothing
msgbox "Fertig"
 
Sieht grundsätzlich nicht schlecht aus. Rekursiv sollte das schon sein
Den Fehler sehe ich noch nicht. Aber ein par Anmerkungen

- oFile2 ist ein Text, kein File. Mit dem Prefix o denkt man aber, dass es ein Objekt (File) sei. Das führt zu Verwirrungen

- Mir fällt auf. Hoffentlich hast du keine Ordner oder Dateien mit einem Punkt im Namen
Besser du schreibst diese Zeile so um:
Visual Basic:
sFile2 =oFso.BuildPath(oFile.ParentFolder, oFso.GetBaseName(oFile))

- Weiter. Shell brauchst du nicht, FSO liefert dir alle Befehle

- Anstelle vom Move ist ein Copy & Delete besser. Im Fehlerfall ist die Datei sicher noch da.

- Sehe ich das richtig. Es gibt jeweils eine Datei, die keine Endung hat. Nur dann soll das das Original verschoben werden.
Visual Basic:
       oFile2 = left(oFile, inStrRev(oFile,".")-1)
        if oFile2 <> ""    then
            If (oFSO.FileExists(oFile2)) Then


Ich habe hier mal dein Code ein wenig angepasst und diverse Stringbasteleien durch FSO ersetzt
Visual Basic:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Basefolder = "X:\TechDoku\Standort1\"
Savefolder = "X:\Save\"

Basefolder1 = oFSO.GetBaseName(Basefolder)
Logfile = "C:\Temp\DMS_Script\Logfile_" & Basefolder1 & ".txt"
Set MyLogfile = oFSO.CreateTextFile(Logfile, true)
MyLogfile.Close
Set MyLogfile = oFSO.OpenTextFile(Logfile, 8)
sub ExecuteFolder (Foldername)
    Dim oFolder1 oFile, oSubFolder
    Dim sFile2, sFile2_Path, sFile2_Fullname
    set oFolder1 = oFSO.GetFolder (Foldername)
    MyLogfile.WriteLine (oFolder1)
    For Each oFile In oFolder1.Files
        'Dateipfad ohne Endung
        sFile2 = oFSO.BuildPath(oFile.ParentFolder, oFSO.GetBaseName(oFile))
        If (oFSO.FileExists(sFile2)) Then
            MyLogfile.WriteLine (oFile)
            'Unterordner am Ziel mit demselben Namen & Struktur
            sFile2_Path = oFso.BuildPath(Savefolder, Mid(oFile.ParentFolder, Len(oFile.Drive) + 1))
            'Neuer Filepfad
            sFile2_Fullname = oFSO.BuildPath(sFile2_Path, oFile.name)
            if not oFSO.Folderexists(sFile2_Path) then
                oFSO.CreateFolder sFile2_Path
                if oFSO.Folderexists(sFile2_Path) then
                    MyLogfile.WriteLine (" Sicherungsordner erstellt")
                else
                    MyLogfile.WriteLine (" Fehler beim Erstellen von " & sFile2_Path)
                end if
            end if
            oFile.copy sFile2_Fullname, true
            If oFSO.FileExists(sFile2_Fullname) Then
                MyLogfile.WriteLine (" verschoben")
                oFile.delete true
            else
                MyLogfile.WriteLine (" Fehler beim Verschieben nach " & sFile2_Fullname)
            end if
        end if
    Next
    For Each oSubFolder in oFolder1.SubFolders
        ExecuteFolder oSubFolder.Path
    Next
    set oFolder1 = nothing
end sub
ExecuteFolder (Basefolder)
MyLogfile.Close
Set oFSO = nothing
msgbox "Fertig"
 
Danke schon mal für die schnelle Antwort ...
Die Dateien haben noch Ihre richtigen Endungen. Der Schadcode hat diese verschlüsselt und dann zusätzlich noch eine zufällige Endung mit angehängt.
Ich schaue somit, ob es zu der aktuellen Datei noch eine gleiche Datei gibt. nur halt ohne die zusätzliche Endung.
Betroffen sind alle möglichen Dateiformate. Das verschieben funktioniert auch soweit. Nur bin ich nicht sicher, ob alle Verzeichnisse abgearbeitet werden. Beim Hauptverzeichnis waren es nur 4 von ca. 50 Verzeichnissen. War so im Logfile zu erkennen. Abbruch ohne irgendeine Meldung. Aber rekursiv funktioniert grundsätzlich, nur halt nicht vollständig.
Habe deshalb angefangen, Hauptverzeichnisse einzeln per Script durchsuchen zu lassen.

Allerdings erhalte ich aktuell mit dem alten Script in einem Verzeichnis noch einen Laufzeitfehler bei einer left-Anweisung, die ich mir nicht erklären kann. Sollte eigentlich nur die letzte Endung liefern. Würde jedoch mit Deiner Variante hoffentlich wegfallen.
Code:
    For Each oFile In oFolder1.Files
'        Msgbox "Orig: " & oFile.name
        oFile2 = left(oFile, inStrRev(oFile,".")-1)

Verzeichnis- oder Dateinamen mit Punkt gibt es allerdings garantiert (Dateien siehe u.a. zusätzliche Endungen durch Virus) . An welcher Stelle würden diese Probleme machen? Schon bei Deiner Ermittlung Basefolder1 (wenn ggf. als Datei interpretiert)?
 
Zuletzt bearbeitet von einem Moderator:
noch eine Frage zum Ordner erstellen ...
Ich hatte den Shell-Befehl genutzt, weil mir oFSO.CreateFolder m.E. nur das jeweilige Unterverzeichnis, jedoch keinen kompletten Pfad erstellt hatte. Ging so halt am schnellsten.
Oder sollte oFSO.CreateFolder auch ganze Verzeichnisbäume erstellen?
Hinweis: Es ist nicht jedes Verzeichnis betroffen, so dass es durchaus sein kann, dass erst im 5. Unterverzeichnis eine Datei verschoben werden müsste. Und ich wollte nicht alle Verzeichnisstrukturen wegsichern. Nur die, die Daten enthalten.
 
Der Folder sollte eh einmal erstellt werden. Dann hast du auch Rekursiv das Generieren des Folders.

Die Punktproblematik hast du mit meiner Version nicht.

Zu dem Check: Verstehe ich das Richtig?
Orignal-Datei: X:\TechDoku\Standort1\subFolders\test.xlsx
Krüppeldatei: X:\TechDoku\Standort1\subFolders\test.xlsx.jiofuior


Wenn ja, dann wird das mit meinem Code richtig gehandhabt
Visual Basic:
'Test
    Dim oFile As File
    Set oFile = oFso.GetFile("C:\_TMP\FXPMS_DATA\Data\setup.sql.abcdef")
    Debug.Print oFso.BuildPath(oFile.ParentFolder, oFso.GetBaseName(oFile))

'Ausgabe
C:\_TMP\FXPMS_DATA\Data\setup.sql

Visual Basic:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Basefolder = "X:\TechDoku\Standort1\"
Savefolder = "X:\Save\"

Basefolder1 = oFSO.GetBaseName(Basefolder)
Logfile = "C:\Temp\DMS_Script\Logfile_" & Basefolder1 & ".txt"
Set MyLogfile = oFSO.CreateTextFile(Logfile, true)
MyLogfile.Close
Set MyLogfile = oFSO.OpenTextFile(Logfile, 8)
sub ExecuteFolder (Foldername)
    Dim oFolder1 oFile, oSubFolder
    Dim sFile2, sFile2_Path, sFile2_Fullname
    set oFolder1 = oFSO.GetFolder (Foldername)
    MyLogfile.WriteLine (oFolder1)

    'Create Folder
    sFile2_Path = oFso.BuildPath(Savefolder, Mid(oFolder1, Len(oFolder1.Drive) + 1).path)
    if not oFSO.Folderexists(sFile2_Path) then
        oFSO.CreateFolder sFile2_Path
        if oFSO.Folderexists(sFile2_Path) then
            MyLogfile.WriteLine (" Sicherungsordner erstellt")
        else
            MyLogfile.WriteLine (" Fehler beim Erstellen von " & sFile2_Path)
        end if
    end if

    For Each oFile In oFolder1.Files
        'Dateipfad ohne Endung
        sFile2 = oFSO.BuildPath(oFile.ParentFolder, oFSO.GetBaseName(oFile))
        If (oFSO.FileExists(sFile2)) Then
            MyLogfile.WriteLine (oFile)
            'Unterordner am Ziel mit demselben Namen & Struktur
            'Neuer Filepfad
            sFile2_Fullname = oFSO.BuildPath(sFile2_Path, oFile.name)
            oFile.copy sFile2_Fullname, true
            If oFSO.FileExists(sFile2_Fullname) Then
                MyLogfile.WriteLine (" verschoben")
                oFile.delete true
            else
                MyLogfile.WriteLine (" Fehler beim Verschieben nach " & sFile2_Fullname)
            end if
        end if
    Next
    For Each oSubFolder in oFolder1.SubFolders
        ExecuteFolder oSubFolder.Path
    Next
    set oFolder1 = nothing
end sub
ExecuteFolder (Basefolder)
MyLogfile.Close
Set oFSO = nothing
msgbox "Fertig"
 
Habe gerade mal Deine erste Version an einem Testobjekt getestet.
Logfilename wird etwas verkrüppelt, wenn das Startverzeichnis einen Punkt enthält. Sollte jedoch kein Problem sein.

Zu dem Check: Verstehe ich das Richtig?
Orignal-Datei: X:\TechDoku\Standort1\subFolders\test.xlsx
Krüppeldatei: X:\TechDoku\Standort1\subFolders\test.xlsx.jiofuior

Ja, genau so ist es.
Mein Filterversuch birgt natürliche das Risiko, dass auch Anwender-gewollte Dateiumbenennungen verschoben werden. z.B. xyz.doc und xyz.doc.orig
Deshalb will ich ja die Sicherungskopie bereitstellen, so dass der Anwender ggf. nochmal durchschauen kann. Wenn ich jedoch dann alle Verzeichnisse 1zu1 anlege, wird das recht mühselig. Sind eh schon recht viele. Der Anwender könnte mit vollständigem Verzeichnisbaum dann gleich die Originalverzeichnisse durchschauen. Und das sind deutlich mehr, als die Relevanten.

Ohne Deine Variante mit vollständiger Verzeichnisstruktur wirft oFSO.CreateFolder jedoch wie erwartet einen Fehler aus.

Wenn ich nur die relevanten Verzeichnisse haben möchte, müsste ich somit für das zu erstellende eine Routine für den vollständigen Pfadaufbau einbauen. Hättest Du da eine schnelle Lösung?
Eine Alternative wäre ggf. noch, das Logfile selber durchsehen zu lassen. Das würde ich dann auf die Dateizeilen einschränken.
 
Ich habe da in meiner Trickkiste eine Funktion gefunden....
Visual Basic:
'/**
' * Erstellt einen Ordner, prüft dabei ob der Parent vorhanden ist und erstellt ihn ggf ebenfalls
' * @param  String
' */
Public Sub createFolder(ByVal iFolderPath As String)
    Static fso As Object: If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(iFolderPath) Then Exit Sub
    createFolder fso.GetParentFolderName(iFolderPath)
    fso.createFolder iFolderPath
End Sub

fso hast du bereits als Public Variable. Ergo kanns du das ganze so anpassen
Visual Basic:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Basefolder = "X:\TechDoku\Standort1\"
Savefolder = "X:\Save\"

Basefolder1 = oFSO.GetBaseName(Basefolder)
Logfile = "C:\Temp\DMS_Script\Logfile_" & Basefolder1 & ".txt"
Set MyLogfile = oFSO.CreateTextFile(Logfile, true)
MyLogfile.Close
Set MyLogfile = oFSO.OpenTextFile(Logfile, 8)
'/**
' * Erstellt einen Ordner, prüft dabei ob der Parent vorhanden ist und erstellt ihn ggf ebenfalls
' * @param  String
' */
Sub createFolder(ByVal iFolderPath As String)
    If ofso.FolderExists(iFolderPath) Then Exit Sub
    createFolder ofso.GetParentFolderName(iFolderPath)
    ofso.createFolder iFolderPath
End Sub

sub ExecuteFolder (Foldername)
    Dim oFolder1 oFile, oSubFolder
    Dim sFile2, sFile2_Path, sFile2_Fullname
    set oFolder1 = oFSO.GetFolder (Foldername)
    MyLogfile.WriteLine (oFolder1)

    'Ziel Folderpfad
    sFile2_Path = oFso.BuildPath(Savefolder, Mid(oFolder1, Len(oFolder1.Drive) + 1).path)

    For Each oFile In oFolder1.Files
        'Dateipfad ohne Endung
        sFile2 = oFSO.BuildPath(oFile.ParentFolder, oFSO.GetBaseName(oFile))
        If (oFSO.FileExists(sFile2)) Then
            MyLogfile.WriteLine (oFile)
            'Unterordner am Ziel mit demselben Namen & Struktur
            createFolder sFile2_Path
            'Neuer Filepfad
            sFile2_Fullname = oFSO.BuildPath(sFile2_Path, oFile.name)
            oFile.copy sFile2_Fullname, true
            If oFSO.FileExists(sFile2_Fullname) Then
                MyLogfile.WriteLine (" verschoben")
                oFile.delete true
            else
                MyLogfile.WriteLine (" Fehler beim Verschieben nach " & sFile2_Fullname)
            end if
        end if
    Next
    For Each oSubFolder in oFolder1.SubFolders
        ExecuteFolder oSubFolder.Path
    Next
    set oFolder1 = nothing
end sub
ExecuteFolder (Basefolder)
MyLogfile.Close
Set oFSO = nothing
msgbox "Fertig"
 
ich musste noch ein paar Sachen anpassen ...
  • sub ExecuteFolder (Foldername)
  • Dim oFolder1 oFile, oSubFolder
Komma ergänzt.
  • Sub createFolder(ByVal iFolderPath As String)
As String wirft einen Fehler. habe ich erstmal rausgenommen.
  • sFile2_Path = oFso.BuildPath(Savefolder, Mid(oFolder1, Len(oFolder1.Drive) + 1).path)
.path war noch zuviel.

Hatte dann noch das Problem, dass es anscheinend auch Dateien gibt, die schreibgeschützt sind.
oFile.copy sFile2_Fullname, true
copy gibt in diesem Fall einen Fehler. Kann ich mir noch nicht erklären, da ja eigentlich nur kopiert wird?!
Habe ich erstmal mir on error resume next überbrückt, da der Schreibvorgang ja nochmal separat geprüft und das Ergebnis im Logfile ausgegeben wird.

Allerdings habe ich auch mit dem angepassten Script das Problem, dass nicht alle Verzeichnisse abgearbeitet werden. Gleiche Stand wie vorher. Gibt es vielleicht irgendwelche Begrenzungen in der Anzahl offener Objekte?

Ich muss noch etwas testen. Wird jedoch erst nächste Woche. Ich stell den vollständigen Code dann noch mal ein.

Trotzdem schon mal 10 Daumen hoch für die Unterstützung und ein schönes Osterwochenende.
 
Das Programm dient nach Befall durch einen Cryptolocker-Virus dem Auffinden der verschlüsselten und umbenannten Dateien. Kann jedoch ggf. auch dazu verwendet werden, hausgemachte Sicherungskopie-Arien ausfindig zu machen (z.B. dokument.doc.save).
Voraussetzung ist ein geeignetes Backupkonzept.
Hinweis: Da eine Vollsicherung sehr viel Backup-Speicherplatz benötigt, ist es sehr wahrscheinlich, dass nur eine begrenzte Anzahl an Vollsicherungen aufgehoben wird. Wird der Virusbefall bzw. die Auswirkungen nicht rechtzeitig erkannt, stehen für das Recovery u.U. nur noch verschlüsselte Dateien zur Verfügung. Bei wichtigen Daten sollten auf das Backupsystem somit zum Schutz vor versehentlich oder bewusstem Verändern alle Dateien ergänzend zum vorherigen Backup fortlaufend weggeschrieben werden.
In unserem Fall konnten wir so die Originaldaten inkl. der verschlüsselten Daten zurücksichern, hatten jedoch dann das Problem, die doppelten (verschlüsselten) Dateien identifizieren und wieder aus dem System nehmen zu müssen. Anbei unser Lösungsansatz dazu. Vielleicht haben andere ja das selbe Problem. Die Erpresseraktivitäten nehmen ja leider zu.
Nochmal besten Dank an Yaslaw für die schnelle und professionelle Unterstützung.

Hier die letzte Version.
Code:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Basefolder = "C:\temp\Verzeichniskopie"
Savefolder = "C:\temp\Save"

Basefolder1 = oFSO.GetBaseName(Basefolder)
Logfile = "C:\Temp\Log\Logfile_" & Basefolder1 & ".txt"
Set MyLogfile = oFSO.CreateTextFile(Logfile, true)
MyLogfile.Close
Set MyLogfile = oFSO.OpenTextFile(Logfile, 8)

Sub createFolder(ByVal iFolderPath)
'/**
' * Erstellt einen Ordner, prüft dabei ob der Parent vorhanden ist und erstellt ihn ggf ebenfalls
' * @param  String
' */
    If ofso.FolderExists(iFolderPath) Then Exit Sub
    createFolder ofso.GetParentFolderName(iFolderPath)
    ofso.createFolder iFolderPath
End Sub

sub ExecuteFolder (Foldername)
    Dim oFolder1, oFile, oSubFolder
    Dim sFile2, sFile2_Path, sFile2_Fullname
    set oFolder1 = oFSO.GetFolder (Foldername)
    MyLogfile.WriteLine (oFolder1)

'Ziel Folderpfad
    sFile2_Path = oFso.BuildPath(Savefolder, Mid(oFolder1, Len(oFolder1.Drive) + 1))
    For Each oFile In oFolder1.Files
        'Dateipfad ohne Endung
    sFile2 = oFSO.BuildPath(oFile.ParentFolder, oFSO.GetBaseName(oFile))
'Dateien ohne Endung nicht als doppelt erkennen
    if sFile2 = oFile then
        MyLogfile.WriteLine ("== ohne Endung: " & oFile)
           MyLogfile.WriteLine ("")
    else
           If (oFSO.FileExists(sFile2)) Then
'            MyLogfile.WriteLine (oFile)
'Unterordner im Zielpfad mit demselben Namen & Struktur
            createFolder sFile2_Path
'Neuer Filepfad
            sFile2_Fullname = oFSO.BuildPath(sFile2_Path, oFile.name)
'kopiere Dateiobjekt nach ...
            on error resume next
            oFile.copy sFile2_Fullname, true
'prüfe, ob kopiert werden konnte
            If oFSO.FileExists(sFile2_Fullname) Then
                        MyLogfile.WriteLine (oFile.name)
                       MyLogfile.WriteLine ("-> " & sFile2_Fullname)
                on error resume next
                      oFile.delete true
'prüfe, ob oFile gelöscht werden konnte
                If oFSO.FileExists(oFile) Then
                         MyLogfile.WriteLine ("<- nicht gelöscht: " & oFile)
                end if
            else
                MyLogfile.WriteLine (" Fehler beim verschieben: " & sFile2_Fullname)
            end if
                     MyLogfile.WriteLine ("")
        end if
    end if
    Next
    For Each oSubFolder in oFolder1.SubFolders
        ExecuteFolder oSubFolder.Path
    Next
    set oFolder1 = nothing
end sub
ExecuteFolder (Basefolder)
MyLogfile.Close
Set oFSO = nothing
msgbox "Fertig"

Hinweis: Für mein ursprüngliches Problem, dass die rekursive Suche mittendrin abbrach, konnte die Ursache durch Tests gefixt werden. Grund war ein DMS-System mit eigener SMB-Schnittstelle. Der Java-Hintergrundprozess war durch die rekursive Suche am Limit. Tests auf reinen Windows-Systemen liefen problemlos durch. Allerdings nur im Rahmen der spezifizierten Windows-Grenzen Pfad- und Dateilänge.
 
Zurück