http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** 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 )
http://dieseyer.de • all rights reserved • © 2011 v11.4