http://dieseyer.de • all rights reserved • © 2011 v11.4

'*** v8.2 *** www.dieseyer.de *******************************
'
' Datei: dateisichernbak.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Das Problem: Ein Server schreibt eine .LOG-Datei. Sobald
' diese größer als 1 MByte ist, wird sie in. *.bak umbenannt
' und dabei die alte .BAK-Datei überschrieben - das geschieht
' ca. alle zwei Tage. Das Skript prüft nun stündlich das
' Dateidatum (DateLastModified) dieser .BAK-Datei und sobald
' sich dieses ändert, wird eine Kopie 'sicher gestellt'.
'
'************************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim VBSmodTime ' für die Prozedur "Sub VBSneustart()" erforderlich
Dim VBSmodTest

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 oArgs : Set oArgs = Wscript.Arguments

Dim LogDatei : LogDatei = WScript.ScriptFullName & ".log"
LogDatei = WScript.ScriptFullName & "-" & WSHNet.ComputerName & "-.log"
LogDatei = WScript.ScriptFullName & "-" & WSHNet.UserName & "-.log"
LogDatei = WScript.ScriptFullName & ".log"

' Call LogEintrag( "" ) ' erstellt neue LogDatei
Call LogEintrag( " " ) ' fügt Leerzeile in LogDatei ein

' WSHShell.Popup "= = = S T A R T = = =", 2, "034 :: " & WScript.ScriptName
LogEintrag "035 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"
LogEintrag "036 :: LogDatei: " & LogDatei
LogEintrag "037 :: PCname: " & WSHNet.ComputerName
LogEintrag "038 :: Angemeldeter User: " & WSHNet.UserName

Const BakDatei1 = "C:\k6logs\sysinfo.bak"
Const BakDatei2 = "C:\k6logs\k6.bak"
Const SicherVerz1 = "C:\INFECTED\1"
Const SicherVerz2 = "C:\INFECTED\2"

Dim Tst

Do

' WScript.Sleep 1000 ' neue Sekunde abwarten
Do ' warten, bis eine neue Minute (mit xx:yy:00) anfängt
WScript.Sleep 20
If InStr( now(), ":00" ) = Len( now() ) - 2 Then Exit Do
' If InStr( now(), ":10" ) = Len( now() ) - 2 Then Exit Do
' If InStr( now(), ":20" ) = Len( now() ) - 2 Then Exit Do
If InStr( now(), ":30" ) = Len( now() ) - 2 Then Exit Do
' If InStr( now(), ":40" ) = Len( now() ) - 2 Then Exit Do
' If InStr( now(), ":50" ) = Len( now() ) - 2 Then Exit Do
Loop

If InStr( now(), ":13:0" ) > 0 Then ' in jeder Stunde zur 13. Minute
Tst = BakDateiSichern( BakDatei1, SicherVerz1 )
If Len( Tst ) > 3 Then
LogEintrag "063 :: Gesichert (" & BakDatei1 & ") nach " & Tst
Else
LogEintrag "065 :: Nicht gesichert: " & BakDatei1
End If
End If

If InStr( now(), ":17:0" ) > 0 Then ' in jeder Stunde zur 17. Minute
Tst = BakDateiSichern( BakDatei2, SicherVerz2 )
If Len( Tst ) > 3 Then
LogEintrag "072 :: Gesichert (" & BakDatei2 & ") nach " & Tst
Else
LogEintrag "074 :: Nicht gesichert: " & BakDatei2
End If
End If

If InStr( now(), "9:0" ) > 0 Then ' alle 10min; 09, 19, 29, 39, 49, 59
Tst = BakDateiSichern( BakDatei2, SicherVerz2 )
If Len( Tst ) > 3 Then LogEintrag "080 :: Gesichert (" & BakDatei2 & ") nach " & Tst
End If

If InStr( now(), "8:0" ) OR InStr( now(), "3:0" ) > 0 Then ' alle 5min; 03, 08, 13, 18, ...
Tst = BakDateiSichern( BakDatei2, SicherVerz2 )
If Len( Tst ) > 3 Then LogEintrag "085 :: Gesichert (" & BakDatei2 & ") nach " & Tst
End If

If InStr( now(), "6:0" ) OR InStr( now(), "1:0" ) > 0 Then ' alle 5min; 01, 06, 11, 16, ...
Tst = BakDateiSichern( BakDatei1, SicherVerz1 )
If Len( Tst ) > 3 Then
LogEintrag "091 :: Gesichert (" & BakDatei1 & ") nach " & Tst
Else
LogEintrag "093 :: Nicht gesichert: " & BakDatei1
End If
End If

' Tst = ""
' Tst = BakDateiSichern( BakDatei2, SicherVerz2 ) ' bei jedem Durchlauf'
' If Len( Tst ) > 3 Then
' LogEintrag "100 :: Gesichert (" & BakDatei2 & ") nach " & Tst
' Else
' LogEintrag "102 :: Nicht gesichert: " & BakDatei2
' End If

VBSmodTest = VBSmodTest + 1 : VBSbeenden() : VBSneustart()
' LogEintrag "106 :: VBSmodTest: " & VBSmodTest

WScript.Sleep 1000 ' neue Sekunde abwarten
Loop

WSHShell.Popup "= = = E N D E = = =", 2, "111 :: " & WScript.ScriptName
LogEintrag "112 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"

Wscript.Quit


'*** v8.2 *** www.dieseyer.de *******************************
Function BakDateiSichern( BakDatei, ZielVerz )
'************************************************************
' prüft, ob eine neuere BackDatei als die letzte vorhanden
' existiert - wenn ja, wird die neue gesichert

' On Error Resume Next

' Am Ende von ZielVerz soll ein "\" sein!
If not InStrRev( ZielVerz, "\" ) = Len( ZielVerz ) Then ZielVerz = ZielVerz & "\"
' LogEintrag "127 :: Start: ""Function BakDateiSichern( " & BakDatei & ", " & ZielVerz & " )"" "

Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim DateiNr : DateiNr = 0
Dim i
Dim ZielDatei, ZielEndg, DateiDatum
Dim arrDateiLst
Dim NeuereBakDatei : NeuereBakDatei = "JA"

BakDateiSichern = ""

If fso.FileExists( BakDatei ) Then
' LogEintrag "139 :: Zu kopierende BakDatei (QuellDatei) existiert: " & BakDatei
Else
LogEintrag "141 :: Zu kopierende BakDatei (QuellDatei) fehlt: " & BakDatei
LogEintrag "142 :: Exit: ""Function BakDateiSichern( " & BakDatei & ", " & ZielVerz & " )"" "
Exit Function
End If

' LogEintrag "146 :: BakDatei (QuellDatei): " & BakDatei
ZielDatei = ZielVerz & fso.GetBaseName( BakDatei ) & "_" ' ohne Endung
ZielEndg = "." & fso.GetExtensionName( BakDatei )
DateiDatum = fso.GetFile( BakDatei ).DateLastModified
' LogEintrag "150 :: ZielDatei: " & ZielDatei : LogEintrag "150 :: ZielEndg: " & ZielEndg : LogEintrag "150 :: DateiDatum: " & DateiDatum


' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
arrDateiLst = Dateilisteholen( ZielVerz )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' LogEintrag "156 :: UBound( arrDateiLst ): " & UBound( arrDateiLst ) & " - also " & UBound( arrDateiLst ) + 1 & " Dateien."


For i = LBound( arrDateiLst ) to UBound( arrDateiLst )
' letzte vergebene Lfd.Nr. ermitteln und letztes Änderungsdatum im ZielVerz vergleichen
' LogEintrag "161 :: Testen auf richtige ZielDatei: " & arrDateiLst(i)
If InStr( arrDateiLst(i), ZielDatei ) = 1 Then
' LogEintrag "163 :: Richtiger ZielDatei-Name: " & arrDateiLst(i)
If UCase( Mid( arrDateiLst(i), InStrRev( arrDateiLst(i), "." ) ) ) = UCase( ZielEndg ) Then
' bereits gesicherte Datei gefunden
' LogEintrag "166 :: Richtige ZielDatei-Endung: " & arrDateiLst(i)

' Lfd.Nr. herauslösen; wenn größer als die letzte entdeckte, merken
Tst = Replace( UCase( arrDateiLst(i) ), UCase( ZielDatei ), "" )
Tst = Replace( Tst, UCase( ZielEndg ), "" ) : Tst = Int( Tst )
If Tst > DateiNr Then DateiNr = Tst ' letzte Lfd. Nr wird ermittelt
' LogEintrag "172 :: DateiNr: " & DateiNr

' Dateiänderungsdatumvergleichen
If NeuereBakDatei = "JA" AND DateiDatum = fso.GetFile( arrDateiLst(i) ).DateLastModified Then NeuereBakDatei = "-JA"
' LogEintrag "176 :: " & DateiDatum & " =?= " & fso.GetFile( arrDateiLst(i) ).DateLastModified
' LogEintrag "177 :: NeuereBakDatei: " & NeuereBakDatei

End If
End If
Next

If NeuereBakDatei = "JA" Then
' LogEintrag "184 :: (BakDatei) muss gesichert werden: " & BakDatei
Else
' LogEintrag "186 :: BakDatei ist nicht neuer als eine vorhande - Exit Function"
Exit Function
End If

DateiNr = DateiNr + 1
If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr
If Len( DateiNr ) < 3 Then DateiNr = "0" & DateiNr
ZielDatei = ZielDatei & DateiNr & ZielEndg
fso.CopyFile BakDatei, ZielDatei

' LogEintrag "196 :: Zu kopieren (BakDatei) : " & BakDatei
' LogEintrag "197 :: Erstellte ZielDatei: " & ZielDatei

BakDateiSichern = ZielDatei & " (" & DateiDatum & ")"
' LogEintrag "200 :: Ende: BakDateiSichern = """ & BakDateiSichern & """ "

End Function ' BakDateiSichern( BakDatei, ZielVerz )





'*** 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 "221 :: Ausgeschl: " & Ausgeschl
' LogEintrag "222 :: Verz: " & Verz

Dim i, oFolders, oFiles, DateiX
Set oFolders = fso.GetFolder( Verz )
Set oFiles = oFolders.Files
ReDim Preserve DateilisteholenX(i)
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 "232 :: i = " & i & vbTab & Dateilisteholen(i)
i = i + 1
End If
Next
Set oFiles = nothing
Set oFolders = nothing

Dateilisteholen = DateilisteholenX

End Function ' Dateilisteholen( Verz )


'*** v5.A *** www.dieseyer.de *******************************
Sub VBSbeenden()
'************************************************************
' Dim VBSmodTest
' beendet dieses Skript, wenn es gelöscht oder umbenannt wurde

Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")

On Error Resume Next
If fso.FileExists( WScript.ScriptFullName ) Then Exit Sub
On Error GoTo 0
WScript.Sleep 100

On Error Resume Next
If fso.FileExists( WScript.ScriptFullName ) Then Exit Sub
On Error GoTo 0

' Prozedur-Aufruf für das Schreiben einer Protokolldatei
LogEintrag( "262 :: " & WScript.ScriptFullName & " existiert nicht!" )
LogEintrag( "263 :: " & WScript.ScriptFullName & " wird beendet . . . " & vbCRLF )
LogEintrag( "264 :: " & WScript.ScriptFullName & " wird nach " & i & " Durchläufen beendet . . . " & vbCRLF )

WScript.CreateObject("WScript.Shell").Popup WScript.ScriptFullName & " wird nach " & VBSmodTest & " Durchläufen beendet . . . " , 30, "266 :: " & WScript.ScriptName, 64 + 4096

WScript.Quit

End Sub ' VBSbeenden()


'*** v9.1 *** www.dieseyer.de *******************************
Sub VBSneustart()
'************************************************************
' Dim VBSmodTime ' Muss beim Skriptaufruf als erstes ausgeführt werden !!!
' Dim VBSmodZahl ' für die Prozedur "Sub VBSneustart()" erforderlich

' Startet dieses Skript neu, wenn sich das Dateidatum geändert hat

Dim fso : Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Dim SelbstVBS : SelbstVBS = WScript.ScriptFullName

On Error Resume Next
If not fso.FileExists( SelbstVBS ) Then Exit Sub
On Error GoTo 0

If VBSmodTime = "" Then VBSmodTime = fso.GetFile( SelbstVBS ).DateLastModified

If VBSmodTime = fso.GetFile( SelbstVBS ).DateLastModified Then Exit Sub

' Prozedur-Aufruf für das Schreiben einer Protokolldatei
Trace32Log "293 :: Das Dateidatum von """ & WScript.ScriptName & """ wurde " & VBSmodZahl & "x getestet.", 1

' WSCript.Sleep 1*1000

' Prozedur-Aufruf für das Schreiben einer Protokolldatei
Trace32Log "298 :: Das NEUE """ & SelbstVBS & """ wird jetzt gestartet . . . ", 1

WScript.CreateObject("WScript.Shell").Run """" & SelbstVBS & """"

' Prozedur-Aufruf für das Schreiben einer Protokolldatei
Trace32Log "303 :: Das ALTE """ & SelbstVBS & """ wird jetzt beendet . . . ", 1

WScript.Quit

End Sub ' VBSneustart()


'*** 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 )


'*** 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, , "205 :: "
' MsgBox "AktDMTF: '" & AktDMTF & "'", , "206 :: "
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