'*** v7.C *** www.dieseyer.de **************************** ' ' Datei: dateienaltdelete-3.vbs ' Autor: dieseyer@gmx.de ' Auf: www.dieseyer.de ' ' Ursprungsskript: ' dateienalteliste.vbs ' mit der Prozedur AlteDateien( arrDateiLst, Alter, ZeitType ) ' ' Erweiterungen: ' - die Prozedur "DateiListeLoeschen arrDateiLst" ' - Parameter um das Löschen zu aktivieren/deaktivieren (LoeschenAktiv = "YES") ' '********************************************************* Option Explicit ' ~~~ Beginn der Definition der Parameter~~~~~~~~~~~~~~~~~ Const QuellVerz = "D:\dieseyer.neu\css" Const Alter = 55 Const ZeitType = "d" Const LoeschenAktiv = "-YES" ' ~~~ End der Definition der Parameter~~~~~~~~~~~~~~~~~~~~ Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell") Dim LogDatei : LogDatei = WScript.ScriptFullName & ".log" Call LogEintrag( "" ) ' erstellt neue LogDatei Call LogEintrag( " " ) ' fügt Leerzeile in LogDatei ein LogEintrag "039 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" LogEintrag "040 :: LogDatei: " & LogDatei LogEintrag "041 :: LogDatei: " & LogDatei If not fso.FolderExists( QuellVerz ) Then WSHShell.Popup "Falscher Parameter für ""QuellVerz"": " & vbCRLF & vbTab & "'" & QuellVerz & "'", 30, "043 :: ENDE - " & WScript.ScriptName : WScript.Quit Dim arrDateiLst ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ arrDateiLst = Dateilisteholen( QuellVerz ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ LogEintrag "051 :: UBound( arrDateiLst ): " & UBound( arrDateiLst ) ArrayZeigen( arrDateiLst ) LogEintrag "055 :: arrDateiAlt = AlteDateien( arrDateiLst, " & Alter & ", " & ZeitType & " )" & vbCRLF ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' arrDateiAlt = AlteDateien( arrDateiLst, Alter, ZeitType ) AlteDateien arrDateiLst, Alter, ZeitType ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ArrayZeigen( arrDateiLst ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ DateiListeLoeschen arrDateiLst ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' CreateObject("WScript.Shell").Run "notepad " & LogDatei WSHShell.Popup "= = = E N D E = = =", 2, "075 :: " & WScript.ScriptName LogEintrag "077 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" WScript.Quit '*** v7.C *** www.dieseyer.de **************************** Function DateiListeLoeschen( arrDateiLst ) '********************************************************* Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim i, m, n, z, Tst i = 0 : m = 0 : n = 0 : z = 0 LogEintrag "089 :: Start der Function-Prozedur 'DateiListeLoeschen( arrDateiLst )'" If LoeschenAktiv = "YES" Then LogEintrag "091 :: LÖSCHEN IST AKTIV - Die Variable ""LoeschenAktiv"" steht auf '" & LoeschenAktiv & "'" If LoeschenAktiv <> "YES" Then LogEintrag "092 :: LÖSCHEN IST DEAKTIVIERT - Die Variable ""LoeschenAktiv"" steht auf '" & LoeschenAktiv & "'" ' Dateinamen des Arrays testen und Datei löschen ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For i = LBound( arrDateiLst ) to UBound( arrDateiLst ) If fso.FileExists( arrDateiLst( i ) ) Then On Error Resume Next Tst = " - " If LoeschenAktiv = "YES" Then fso.DeleteFile arrDateiLst( i ) If LoeschenAktiv <> "YES" Then LogEintrag "102 :: Datei( " & i & " ) wird NICHT gelöscht: " & arrDateiLst( i ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tst = err.Number & " - " & err.Description On Error GoTo 0 If Len( Tst ) > 4 Then LogEintrag "108 :: Datei( " & i & " ) nicht löschbar: " & arrDateiLst( i ) & " " & Tst z = z + 1 Else If LoeschenAktiv = "YES" Then n = n + 1 : LogEintrag "111 :: Datei( " & i + 1 & " ) gelöscht: " & arrDateiLst( i ) End If Else If Len( arrDateiLst( i ) ) > 3 Then LogEintrag "115 :: Datei( " & i & " ) fehlt (kann daher nicht gelöscht werden): " & arrDateiLst( i ) Else m = m + 1 ' LogEintrag "118 :: Datei( " & i & " ): " & arrDateiLst( i ) End If End If Next LogEintrag "123 :: " & n & " von " & i & " Dateien gelöscht." LogEintrag "124 :: " & z & "x ist ein Fehler beim Löschen einer Datei aufgetreten." LogEintrag "125 :: " & m & " Arrayeinträge waren leer bzw. enthielten keinen gültigen Dateinamen." LogEintrag "126 :: Ende der Function-Prozedur 'DateiListeLoeschen( arrDateiLst )'" End Function ' DateiListeLoeschen( arrDateiLst ) '*** v7.C *** www.dieseyer.de **************************** Function AlteDateien( arrDateiLst, Alter, ZeitType ) '********************************************************* ' An die Prozedur ' AlteDateien( arrDateiLst, Alter, ZeitType ) ' wird ein Array übergeben. Als Ergebnis wird dieses Array ' zurück gegeben, das nur die ausgewählten (bzw. alten) ' Dateien enthält - die anderen Array-Elemente sind leer. ' ' AlteDateien( arrDateiLst, Alter, ZeitType ) ' arrDateiLst - wenn die Variable kein Array ist, ' wird ein Fehler angezeigt ' Alter - Alter kann ein Datum oder eine Zahl sein; ' es kann ein - oder ein + davor stehen ' ' ZeitType - Datum als Alter: ' ZeitType kann "VOR" oder "NACH" enthalten; ' für z.B. "VOR" (dem) 03.10.89 (erstellt) ' ' ZeitType - Zahl als Alter: Für den ZeitType ist ' der Syntax der DateDiff-Funktion bindend: ' yyyy Jahr; q Quartal; m Monat ' d Tag; y Tag im Jahr; ' w Wochentag; ww Woche im Jahr ' h Stunde; n Minute; s Sekunde ' ' + heißt älter als (bzw. größer oder "NACH" ??? erstellt) ' - heißt jünger als (bzw. kleiner oder "VOR" ??? erstellt) Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim Tst, Ttt, i Dim ZeitBezug : ZeitBezug = "NACH" LogEintrag "164 :: ZeitBezug: " & ZeitBezug & " Alter: " & Alter & " ZeitType: " & ZeitType & " VarType( Alter ): " & VarType( Alter ) ' 'ZeitBezug' auswerten ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If Left( Alter, 1 ) = "-" Then ZeitBezug = "VOR" : Alter = Mid( Alter, 2 ) If Left( Alter, 1 ) = "+" Then ZeitBezug = "NACH" : Alter = Mid( Alter, 2 ) If ZeitType = "VOR" Then ZeitBezug = "VOR" If ZeitType = "NACH" Then ZeitBezug = "NACH" LogEintrag "173 :: ZeitBezug: " & ZeitBezug & " Alter: " & Alter & " ZeitType: " & ZeitType & " VarType( Alter ): " & VarType( Alter ) ' Prüfen, ob der Inhalt von 'Alter' verwendbar ist ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ On Error Resume Next If not IsDate( Alter ) Then Alter = CLng( Alter ) Tst = err.Number & " - " & err.Description On Error GoTo 0 If Len( Tst ) > 4 Then ' Alter enthält weder ein Datum noch eine Zahl; Alter ist ungültig! WSHShell.Popup "Falscher Parameter für ""Alter"": " & vbCRLF & vbTab & "'" & Alter & "' führt zu" & vbCRLF & vbTab & Tst, 30, "183 :: ENDE - " & WScript.ScriptName : WScript.Quit End If LogEintrag "186 :: ZeitBezug: " & ZeitBezug & " Alter: " & Alter & " ZeitType: " & ZeitType & " VarType( Alter ): " & VarType( Alter ) Tst = "-DATUM" If InStr( Alter, ":" ) Then Alter = CDate( Alter ) : Tst = "DATUM" If InStr( Alter, "/" ) Then Alter = CDate( Alter ) : Tst = "DATUM" If InStr( Alter, "-" ) Then Alter = CDate( Alter ) : Tst = "DATUM" If InStr( Alter, "." ) Then Alter = CDate( Alter ) : Tst = "DATUM" If Tst <> "DATUM" Then Alter = CLng( Alter) LogEintrag "193 :: ZeitBezug: " & ZeitBezug & " Alter: " & Alter & " ZeitType: " & ZeitType & " VarType( Alter ): " & VarType( Alter ) & vbTab & Tst ' Dateinamen des Arrays testen und ggf. im Array löschen ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For i = LBound( arrDateiLst ) to UBound( arrDateiLst ) Tst = fso.GetFile( arrDateiLst( i ) ).DateLastModified Ttt = DateDiff( ZeitType, Tst, now() ) If IsDate( Alter ) Then ' arrDateiLst( i ) = Clng( Tst - Alter ) & vbTab & Tst & vbTab & arrDateiLst( i ) If ZeitBezug = "NACH" AND Tst - Alter < 0 Then arrDateiLst( i ) = "" ' & "N " & arrDateiLst( i ) If ZeitBezug = "VOR" AND Tst - Alter > 0 Then arrDateiLst( i ) = "" ' & "V " & arrDateiLst( i ) Else ' arrDateiLst( i ) = Ttt & vbTab & Tst & vbTab & arrDateiLst( i ) If ZeitBezug = "NACH" AND Ttt < Alter Then arrDateiLst( i ) = "" ' & "n " & arrDateiLst( i ) If ZeitBezug = "VOR" AND Ttt > Alter Then arrDateiLst( i ) = "" ' & "v " & arrDateiLst( i ) End If 'DateDiff(Intervall, Datum1, Datum2 [,ErsterWochentag[,ErsteWocheimJahr]] ) 'Die Syntax der DateDiff-Funktion besteht aus folgenden Next End Function ' AlteDateien( arrDateiLst, Alter, ZeitType ) '*** v7.C *** www.dieseyer.de **************************** Function ArrayZeigen( InArray ) '********************************************************* ' Durch die Prozedur ' ArrayZeigen( InArray ) ' werden von einem Array nur die ersten ' und letzten Elemente angezeigt. Da die MsgBox nur 1024 ' Zeichen anzeigen kann, ist die Anzahl der angezeigten ' Elemente von der Länge der einzelnen Elemente abhängig. Dim TxtOben, TxtUnten, Tst, i, n, o, u Dim Kopf ' für Tests ' Kopf = "LBound( InArray )=" & LBound( InArray ) & " UBound( InArray )=" & UBound( InArray ) & vbCRLF & vbCRLF & Kopf ' Kopf = "O=00000" & " U=00000" & " Len( TxtOben )=00000" & vbCRLF & Kopf For i = LBound( InArray ) to UBound( InArray ) n = UBound( InArray ) - i Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( i ) ) + Len( Kopf ) If Tst < 1000 AND n >= i Then ' TxtOben = TxtOben & "i = " & i & vbTab & "n = " & n & vbTab & Tst & vbTab & InArray( i ) & vbCRLF TxtOben = TxtOben & i & vbTab & InArray( i ) & vbCRLF o = i End If n = UBound( InArray ) - i Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( n ) ) Tst = Len( TxtOben ) + Len( TxtUnten ) + Len( InArray( i ) ) + Len( Kopf ) If Tst < 1000 AND n > i Then ' TxtUnten = "n = " & n & vbTab & "i = " & i & vbTab & Tst & vbTab & InArray( n ) & vbCRLF & TxtUnten TxtUnten = n & vbTab & InArray( n ) & vbCRLF & TxtUnten u = n End If If n <=i then Exit For Next Tst = "" If o <> u AND o + 1 <> u Then Tst = "." & vbCRLF & "." & vbCRLF Kopf = Replace( Kopf, "O=00000", "O=" & o ) Kopf = Replace( Kopf, "U=00000", "U=" & u ) Kopf = Replace( Kopf, ")=00000", ")=" & Len( Kopf & TxtOben & Tst & TxtUnten ) ) TxtOben = Kopf & TxtOben & Tst & TxtUnten LogEintrag "263 :: " & vbCRLF & TxtOben MsgBox TxtOben , , "264 :: " & WScript.ScriptName End Function ' ArrayZeigen( InArray ) '*** v7.C *** www.dieseyer.de **************************** Function Dateilisteholen( Verz ) '********************************************************* ' Die Prozedur ' Dateilisteholen( Verz ) ' gibt ein Array mit dem kompletten Dateinamen von allen ' Dateien zurück, die in dem übergebenen Verzeichnis ' vorhanden sind. Ein rekursives Auflisten der Datein in ' Unterverzeichnissen erfolgt nicht! Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim Ausgeschl : Ausgeschl = Mid( WScript.ScriptName, 1 , InStrRev( WScript.ScriptName, "." ) ) ' Dateien mit dem Namen des VBS, werden nicht an das Array übergeben LogEintrag "282 :: Ausgeschl: " & Ausgeschl Dim i, oFolders, oFiles, DateiX Set oFolders = fso.GetFolder( Verz ) Set oFiles = oFolders.Files For Each DateiX In oFiles If InStr( DateiX, Ausgeschl ) = 0 Then ' Dateien mit dem Namen des VBS, werden nicht an das Array übergeben ReDim Preserve DateilisteholenX(i) DateilisteholenX(i) = DateiX ' LogEintrag "291 :: i = " & i & vbTab & Dateilisteholen(i) i = i + 1 End If Next Set oFiles = nothing Set oFolders = nothing Dateilisteholen = DateilisteholenX End Function ' Dateilisteholen( Verz ) '*** v7.C *** www.dieseyer.de **************************** Sub LogEintrag( LogTxt ) '********************************************************* Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject") Dim FileOut ' Dim LogDatei : LogDatei = "c:\LOG.s\" & WScript.Scriptname & ".log" If LogTxt = "" Then Set FileOut = fso.OpenTextFile( LogDatei, 2, true) FileOut.Close Set FileOut = Nothing Set fso = Nothing Exit Sub End If Set FileOut = fso.OpenTextFile( LogDatei, 8, true) If LogTxt = vbCRLF Then FileOut.WriteLine ( LogTxt ) ' If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & vbTab & LogTxt ) If not LogTxt = vbCRLF Then FileOut.WriteLine ( Now() & " " & LogTxt ) FileOut.Close Set FileOut = Nothing Set fso = Nothing End Sub ' LogEintrag( LogTxt )