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

'*** v9.3 *** www.dieseyer.de ******************************
'
' Datei: dateilisteholenmitdatumundname.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Die Prozedur ist Bestandteil von WinTuC_vbs.vbs (WinTuC.de)
'
'***********************************************************

Option Explicit

Dim Tst

Tst = DateilisteHolenMitDatumUndName( "c:\windows\", "KB956" )

Call ArrayZeigen( Tst )

Call ArrayZeigen( DateilisteHolenMitDatumUndName( "c:\windows\", "" ) )

Wscript.Quit



'*** v9.3 *** www.dieseyer.de ******************************
Function DateilisteHolenMitDatumUndName( Verz, DNA )
'***********************************************************
' Die Prozedur
' DateilisteHolenMitDatumUndName( Verz, DNA )
' gibt ein Array mit dem Dateinamen (ohne Verzeichnis) von
' allen Dateien zurück, die in dem übergebenen Verzeichnis
' vorhanden sind - vor dem Dateinamen steht das Änderungsdatum
' (Datum & Uhrzeit; ähnlich DMTF). Ein rekursives Auflisten
' der Datein in Unterverzeichnissen erfolgt nicht!

' DNA: DateiNamenAnfang; z.B. alle Dateien, die mit "KB" beginnen

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

Dim i, oFolder, oFiles, DateiX, ZeitPkt, Tst, Txt, errTst
ReDim Preserve DateilisteholenX( 0 )

Set oFolder = fso.GetFolder( Verz )
Set oFiles = oFolder.Files
For Each DateiX In oFiles
If InStr( DateiX, Ausgeschl ) = 0 Then ' Dateien mit dem Namen des VBS, werden nicht an das Array übergeben
If InStr( UCase( DateiX.Name ), UCase( DNA ) ) = 1 Then ' Dateien mit dem Namen des VBS, werden nicht an das Array übergeben
ReDim Preserve DateilisteholenX( i )
On Error Resume Next
' Tst = fso.GetFile( DateiX & ".dd" ).DateLastModified
Tst = fso.GetFile( DateiX ).DateLastModified
errTst = err.Number & " - " & err.Description
On Error GoTo 0
If Len( errTst ) > 5 Then
DateilisteholenX( i ) = "Fehler: PC nicht (mehr) erreichbar um " & now()
DateilisteHolenMitDatumUndName = DateilisteholenX
Exit Function
End If

ZeitPkt = Year( Tst )
Txt = Month( Tst ) : If Len( Txt ) < 2 Then Txt = "0" & Txt
ZeitPkt = ZeitPkt & Txt
Txt = Day( Tst ) : If Len( Txt ) < 2 Then Txt = "0" & Txt
ZeitPkt = ZeitPkt & Txt
Txt = Hour( Tst ) : If Len( Txt ) < 2 Then Txt = "0" & Txt
ZeitPkt = ZeitPkt & Txt
Txt = Minute( Tst ) : If Len( Txt ) < 2 Then Txt = "0" & Txt
ZeitPkt = ZeitPkt & Txt
Txt = Second( Tst ) : If Len( Txt ) < 2 Then Txt = "0" & Txt
ZeitPkt = ZeitPkt & Txt
DateilisteholenX( i ) = ZeitPkt & "~" & DateiX.Name
i = i + 1
End If
End If
Next
Set oFiles = nothing
Set oFolder = nothing
DateilisteHolenMitDatumUndName = DateilisteholenX

End Function ' DateilisteHolenMitDatumUndName( Verz, DNA )


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

MsgBox TxtOben , , "131 :: " & WScript.ScriptName

End Function ' ArrayZeigen( InArray )

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