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