Skript zum Erstellen eines Ringspeichers
14.03.2019 09:09:53
Phil
ich bin seit einiger Zeit auf der Suche nach einer Lösung für Speicherproblem:
Wir nehmen tagtäglich etliche Bilder auf, die auf einer externen Festplatte gespeichert werden. Wir haben aktuell eine Batch-Datei laufen, die jeden Tag über die Aufgabenplanung ausgeführt wird und alle Dateien älter als X Tage löscht.
Das Problem hierbei: Das ganze ist zu statisch. Je nach Tag werden jeweils unterschiedlich viele Bilder erzeugt (Kann zwischen einigen GB bis zu 100 GB schwanken!). Um ein Vollaufen der Festplatte zu verhindern müssen X dementsprechend klein wählen. Das führt aber dazu, dass bei wenig anfallenden Bildern die Festplatte (4,5 TB) ziemlich leer ist und wir viel Speicherplatz verschenken.
Ich würde gerne ein Skript schreiben, welches ab einer bestimmten Grenzunterschreitung der Festplattenkapazität (hier 100GB) dann solange die jeweils ältesten Dateien in einem Verzeichnis löscht, bis die Grenze wieder überschritten wird. Da ich von Programmierung keinerlei Ahnung habe, habe ich mir bisher was zusammengegoogelt und leicht modifiziert, komme aber nicht weiter. Gibt es hier eine relativ einfache Lösung?
Anbei mein bisheriger Stand:
Option explicit
Dim intGrenze, kritisch, strText
Dim fso, oDrive, strPlatz, vglGrenze
Dim oMessage
intGrenze = 100000
kritisch = "Nein"
strText = "Noch vorhandener Platz auf den Laufwerken:" & vbcrlf
strText = strText & Platzkontrolle("D:\",intGrenze) & vbcrlf
If kritisch = "Ja" Then
Main()
End if
Function Platzkontrolle(sLW,sLW_Warngrenze)
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDrive = fso.getdrive(sLW)
strPlatz = oDrive.freespace
strPlatz = FormatNumber (strPlatz/1024^2,2)
vglGrenze = FormatNumber (sLW_Warngrenze,2)
If abs(vglGrenze)>abs(strPlatz) Then
kritisch = "Ja"
Platzkontrolle = "ACHTUNG: Auf " & sLW & " wurde die " & vglGrenze & " MB Grenze _
unterschritten. Noch " & strPlatz & " MB frei"
Else
Platzkontrolle = sLW & "OK. Noch " & strPlatz & " MB frei"
End if
Set oDrive = nothing
Set fso = nothing
End Function
Sub Main()
Dim iTage
'wieviele Tage die Datei alt sein muss
iTage = 720
LoescheDateien iTage
End Sub
Private Sub LoescheDateien(ByVal Tage)
'Diese Routine löscht alle Text-Dateien die sich
'im aktuellen Programmverzeichnis befinden und älter
'als x Tage sind
'Parameter: Tage wieviele Tage die Datei alt sein muss
Dim FSO
Dim Datei
Dim Dateien
Dim Ordner
Dim sDateiName
Dim sPfad
Dim DateiDatum
Set FSO = CreateObject("Scripting.FileSystemObject")
'zum aktuellen Datum Tage addieren
DateiDatum = DateAdd("D", -Tage, Format(Now, "dd.mm.yyyy"))
sPfad = App.Path
'Ordner festlegen
Set Ordner = FSO.GetFolder(sPfad)
Set Dateien = Ordner.Files
'Pfad ohne Backslash am Ende formatieren
If Right(sPfad, 1) = "D:\Test" Then sPfad = Left(sPfad, Len(sPfad) - 1)
'Dateien im aktuellen Programmverzeichnis durchlaufen
For Each Datei In Dateien
'Dateipfad zusammensetzen
sDateiName = sPfad + "\" + Datei.Name
'nach Text-Dateien filtern
If UCase(FSO.GetExtensionName(sDateiName)) = "PDF" Then
'Dateien älter als Tage löschen
If DateDiff("d", FileDateTime(sDateiName), Now) > Tage Then
'löschen erzwingen
FSO.DeleteFile sDateiName, True
End If
End If
Next
'Objekte zerstören
Set Ordner = Nothing
Set Dateien = Nothing
Set FSO = Nothing
End Sub
Für eure Hilfe wäre ich sehr dankbar!
Viele Grüße!