http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** v10.8 *** www.dieseyer.de *****************************
' Datei: AcronisAlteTibEntfernen.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Die anzugebebene Datei wird nicht gelöscht, aber ALLE
' Dateien in dem selben Verzeichnis mit der selben Datei-
' Erweiterung (Extension), die ein bestimmtes Alter haben,
' werden beim Skriptaufruf gelöscht!
'
'***********************************************************
Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Const DateiBleibt = "\\benz-tspro\backup\acronis\benz-ts01\BENZ-TS01.tib"
Const Alter = 99 ' Dateien, die seit xxx Tagen nicht geändert wurden - außer DateiBleibt
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Const VielLog = "-Ja"
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim WSHNet : Set WSHNet = WScript.CreateObject("WScript.Network")
Dim LogDatei : LogDatei = WScript.ScriptFullName & ".log"
' Call Trace32Log( " ", 0 ) ' erstellt neue LogDatei
Call Trace32Log( " ", 1 ) ' fügt Leerzeile in LogDatei ein
Trace32Log " ", 1 ' fügt Leerzeile in LogDatei ein
' WSHShell.Popup vbTab & "= = = S T A R T = = =", 2, "037 :: " & WScript.ScriptName, vbInformation
Trace32Log "038 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
Trace32Log "039 :: LogDatei: " & LogDatei, 1
Trace32Log "040 :: PCname: " & WSHNet.ComputerName, 1
Trace32Log "041 :: Angemeldeter User: " & WSHNet.UserName, 1
AcronisAlteTibEntfernen DateiBleibt, Alter
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
WSHShell.Popup vbTab & "= = = E N D E = = =", 2, "046 :: " & WScript.ScriptName, 4096 + vbInformation
Trace32Log "047 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )", 1
Trace32Log " ", 1
Wscript.Quit
'*** v10.8 *** www.dieseyer.de *****************************
Function AcronisAlteTibEntfernen( DateiBleibt, Alter )
'***********************************************************
Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim WSHShell : Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim Verz, DateiErw, oFiles, Datei, DateiTst, Txt, Tst, errTst, i, n
i = 0 : n = 0
Trace32Log "063 :: Alte Dateien sollen gelöscht werden - min. Alter der zu löschenden Dateien: " & Alter & "d", 1
Trace32Log "064 :: Alte Dateien sollen gelöscht werden - Änderungsdatum der Dateien am oder vor dem " & FormatDateTime( now() - Alter, 2) & " - aktuelles Datum: " & Date(), 1
If not fso.FileExists( DateiBleibt ) then
WSHShell.Popup vbTab & "Datei / Verzeichnis existiert nicht:" & vbCRLF & vbCRLF & DateiBleibt, 5, "067 :: " & WScript.ScriptName, 4096 + vbCritical
Trace32Log "068 :: Datei / Verzeichnis existiert nicht: " & DateiBleibt, 3
Exit Function
End If
Trace32Log "071 :: Alte Dateien sollen gelöscht werden - außer: " & DateiBleibt, 1
Verz = fso.GetParentFolderName( DateiBleibt )
If not fso.FolderExists( Verz ) then
WSHShell.Popup vbTab & "Verzeichnis existiert nicht:" & vbCRLF & vbCRLF & Verz, 5, "075 :: " & WScript.ScriptName, 4096 + vbCritical
Trace32Log "076 :: Verzeichnis existiert nicht: " & Verz, 3
Exit Function
End If
Trace32Log "079 :: Alte Dateien sollen gelöscht werden - Verzeichnis: " & Verz, 1
DateiErw = UCase( fso.GetExtensionName( DateiBleibt ) )
Trace32Log "082 :: Alte Dateien sollen gelöscht werden - Dateierweiterung (Extension): " & DateiErw, 1
Trace32Log "084 :: ", 1
Set oFiles = fso.GetFolder( Verz ).Files
For Each Datei In oFiles
DateiTst = "OK"
' Trace32Log "090 :: Datei wird geprüft: " & Datei.Path, 1
' Trace32Log "091 :: Letzte Dateiänderung: " & Datei.DateLastModified, 1
' Trace32Log "092 :: min. ALter: " & FormatDateTime( now() - Alter, 2) & " - " & Alter & "d", 1
' Trace32Log "093 :: ALtersunterschied zu heute: " & DateDiff( "d" , Datei.DateLastModified, Date() ) & "d", 1
' Trace32Log "094 :: Daeierweiterung: " & UCase( fso.GetExtensionName( Datei.Path ) ), 1
' MsgBox Datei.GetExtensionName, , "096 :: " : WScript.Quit
If VielLog = "Ja" Then Trace32Log "098 :: Datei wird geprüft: " & Datei, 1
If not UCase( fso.GetExtensionName( Datei.Name) ) = DateiErw Then DateiTst = "-OK" : If VielLog = "Ja" Then Trace32Log "100 :: Dateierweiterung stimmt nicht: " & UCase( fso.GetExtensionName( Datei ) ), 1
If DateDiff( "d" , Datei.DateLastModified, Date() ) < Alter Then DateiTst = "-OK" : If VielLog = "Ja" Then Trace32Log "102 :: Datei ist nicht alt genug - Alter: " & DateDiff( "d" , Datei.DateLastModified, Date() ), 1
If UCase( Datei ) = UCase( DateiBleibt ) Then DateiTst = "-OK" : Trace32Log "104 :: Datei soll bleiben (Ausnahme-Datei): " & Datei, 2
If not DateiTst = "OK" Then
If VielLog = "Ja" Then Trace32Log "107 :: Datei wird nicht gelöscht: " & Datei, 1
Else
Txt = Datei.path ' nach dem Löschen von Datei.Path ist, fehlt Datei.Path
Tst = Datei.DateLastModified & " = " & DateDiff( "d" , Datei.DateLastModified, Date() ) & "d alt."
If VielLog = "Ja" Then Trace32Log "111 :: Datei soll gelöscht werden: " & Txt, 1
On Error Resume Next
fso.DeleteFile Txt, True
errTst = Err.Number & " - " & Err.Description
On Error GoTo 0
if Len( errTst ) < 5 Then
Trace32Log "119 :: Datei ist Gelöscht: " & Txt & " - Dateidatum: " & Tst, 1
i = i + 1
Else
Trace32Log "122 :: Datei nicht löschbar: " & Txt & " - " & errTst, 3
n = n + 1
End if
End if
Next
Set oFiles = nothing
Set fso = nothing
Trace32Log "131 :: ", 1
Trace32Log "132 :: " & i & " Dateien sind gelöscht.", 1
If n > 0 Then Trace32Log "133 :: " & n & " Dateien konnten nicht gelöscht werden - wegen Fehler.", 2
Trace32Log "134 :: ", 1
End Function ' AcronisAlteTibEntfernen( DateiBleibt, Alter )
'*** v9.C *** www.dieseyer.de ******************************
Sub Trace32Log( LogTxt, ErrType )
'***********************************************************
' in VBS und HTA verwendbar
' Aufbau einer LOG-Datei für trace32.exe ( SMS Trace;
' ALLES in einer Zeile!):
' <![LOG[...]LOG]!>
' <
' time="08:12:54.309+-60"
' date="03-14-2008"
' component="SrcUpdateMgr"
' context=""
' type="0"
' thread="1812"
' file="productpackage.cpp:97"
' >
'
' "context=" Info wird nicht angezeigt
' type="0" normale Zeie => NEUE LOG-DATEI - ggf. alte überschreiben !!!!!!!!!!!!
' type="1" normale Zeie
' type="2" gelbe Zeie
' type="3" rote Zeie
' type="F" rote Zeie
' "thread=" kann eine Dezimalzahl aufnehmen; trace32 zeigt
' neben der Dezimalzahl in Klammern die entspr.
' Hexadezimalzahl an - z.B. "33 (0x21)"
' "file=" wird in "Source:" angezeigt
'
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim LogDateiX, TitelX, Tst, Nr
On Error Resume Next
Tst = KeineLog
On Error Goto 0
If UCase( Tst ) = "JA" Then Exit Sub
On Error Resume Next
TitelX = Titel ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
TitelX = title ' Fehler, wenn die Variable 'Titel' nicht außerhalb der Prozedur definiert wurde
If Len( TitelX ) < 2 Then TitelX = document.title ' .hta
If Len( TitelX ) < 2 Then TitelX = WScript.ScriptName ' .vbs
On Error Goto 0
On Error Resume Next
LogDateiX = LogDatei ' wurde die Variable 'LogDatei' nicht außerhalb der Prozedur definiert
If Len( LogDateiX ) < 2 Then LogDateiX = WScript.ScriptFullName & ".log" ' .vbs
If Len( LogDateiX ) < 2 Then LogDateiX = TitelX & ".log" ' .hta
On Error Goto 0
Nr = 0 ' Wenn in Thread die Zeilennummer stehen soll:
Nr = 999999
If Nr = 0 AND InStr( LogTxt, " :" & ": " ) > 0 Then
' Wenn in Thread die Zeilennummer stehen soll - Voraussetzung
' ist eine ZeilenNr. im Format '22 :: '
Nr = LogTxt
Nr = Mid( Nr, 1, InStrRev( Nr, " :" & ": " ) -1 ) ' nach der Zeilennummer
Nr = Mid( Nr, InStrRev( Nr, " " ) + 1 ) ' vor der Zeilennummer
On Error Resume Next : Tst = Int( Nr ) : On Error Goto 0 ' Zeilennummer als (Integer) Zahl
Do ' Tst für Vergleich auf gleiche Länge wie Nr anpassen
If Len( Tst ) = Len( Nr ) Then Exit Do
Tst = "0" & Tst
Loop
If "x" & Tst = "x" & Nr Then
LogTxt = Replace( LogTxt, Tst & " :" & ": ", "" )
Nr = Int( Nr )
End If
End If
If Nr = 999999 Then Nr = 0
' Zwei Nachkommastellen (nach Sekunden) der aktuellen Zeit
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tst = Timer() ' timer() in USA: 1234.22
Tst = Replace( Tst, "," , ".") ' timer() in Deutschland: 123454,12
If InStr( Tst, "." ) = 0 Then Tst = Tst & ".000"
Tst = Mid( Tst, InStr( Tst, "." ), 4 )
If Len( Tst ) < 3 Then Tst = Tst & "0"
' Zeitzone ermitteln - neu (v9.C) und immer richtig(er)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim AktDMTF : Set AktDMTF = CreateObject("WbemScripting.SWbemDateTime")
AktDMTF.SetVarDate Now(), True : Tst = Tst & Mid( AktDMTF, 22 ) ' : MsgBox Tst, , "223 :: "
' MsgBox "AktDMTF: '" & AktDMTF & "'", , "224 :: "
Set AktDMTF = nothing
LogTxt = "<![LOG[" & LogTxt & "]LOG]!>"
LogTxt = LogTxt & "<"
LogTxt = LogTxt & "time=""" & Hour( Time() ) & ":" & Minute( Time() ) & ":" & Second( Time() ) & Tst & """ "
LogTxt = LogTxt & "date=""" & Month( Date() ) & "-" & Day( Date() ) & "-" & Year( Date() ) & """ "
LogTxt = LogTxt & "component=""" & TitelX & """ "
LogTxt = LogTxt & "context="""" "
LogTxt = LogTxt & "type=""" & ErrType & """ "
LogTxt = LogTxt & "thread=""" & Nr & """ "
LogTxt = LogTxt & "file=""dieseyer.de"" "
LogTxt = LogTxt & ">"
Tst = 8 ' LOG-Datei erweitern
If ErrType = 0 Then Tst = 2 ' LOG-Datei erneuern (alte löschen, neue erstellen)
On Error Resume Next
If LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
If not LogTxt = vbCRLF Then fso.OpenTextFile( LogDateiX, Tst, true).WriteLine ( LogTxt )
On Error Goto 0
Set fso = Nothing
End Sub ' Trace32Log( LogTxt, ErrType )
http://dieseyer.de • all rights reserved • © 2011 v11.4