'*** v7.C *** www.dieseyer.de ****************************** ' ' Datei: arrayanzeigen-dateiliste.vbs ' Autor: dieseyer@gmx.de ' Auf: www.dieseyer.de ' ' 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. ' '*********************************************************** Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl ' ~~~ Beginn der Definition der Parameter~~~~~~~~~~~~~~~~~~~ ' Const QuellVerz = "C:\dieseyer.de\scr" Dim QuellVerz : QuellVerz = Mid( WScript.ScriptFullName, 1, InStrRev( WScript.ScriptFullName, "\" ) ) ' ~~~ 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 "035 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" LogEintrag "036 :: LogDatei: " & LogDatei If not fso.FolderExists( QuellVerz ) Then WSHShell.Popup "Falscher Parameter für ""QuellVerz"": " & vbCRLF & vbTab & "'" & QuellVerz & "'", 30, "038 :: ENDE - " & WScript.ScriptName : WScript.Quit Dim arrDateiLst ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ arrDateiLst = Dateilisteholen( QuellVerz ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ LogEintrag "046 :: UBound( arrDateiLst ): " & UBound( arrDateiLst ) ArrayZeigen( arrDateiLst ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ QuickSort arrDateiLst, LBound( arrDateiLst ), UBound( arrDateiLst ) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ArrayZeigen( arrDateiLst ) ' CreateObject("WScript.Shell").Run "notepad " & LogDatei WSHShell.Popup "= = = E N D E = = =", 2, "054 :: " & WScript.ScriptName LogEintrag "056 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )" WScript.Quit '*** 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 "108 :: " & vbCRLF & TxtOben MsgBox TxtOben , , "109 :: " & 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 "127 :: Ausgeschl: " & Ausgeschl Dim i, oFolder, oFiles, DateiX 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 ReDim Preserve DateilisteholenX(i) DateilisteholenX(i) = DateiX ' LogEintrag "136 :: i = " & i & vbTab & Dateilisteholen(i) i = i + 1 End If Next Set oFiles = nothing Set oFolder = 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 ) '*** v8.3 *** www.dieseyer.de ****************************** Function QuickSort( vntArray, intVon, intBis ) '*********************************************************** ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' http://www.heise.de/ct/ftp/listings.shtml ' Der gute, alte QuickSort-Algorithmus als Windows-Script. c't 5/2002 ' Copyright Ralf Nebelo/c't ' QuickSort arrTest, LBound(arrTest), UBound(arrTest) ' Array "arrTest" wird sortiert ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Dim i, j Dim vntTestWert, intMitte, vntTemp If intVon < intBis Then intMitte = (intVon + intBis) \ 2 vntTestWert = vntArray(intMitte) i = intVon j = intBis Do Do While UCase( vntArray(i) ) < Ucase( vntTestWert ) ' Do While vntArray(i) < vntTestWert i = i + 1 Loop Do While UCase( vntArray(j) ) > Ucase( vntTestWert ) ' Do While vntArray(j) > vntTestWert j = j - 1 Loop If i <= j Then vntTemp = vntArray(j) vntArray(j) = vntArray(i) vntArray(i) = vntTemp i = i + 1 j = j - 1 End If Loop Until i > j If j <= intMitte Then Call QuickSort(vntArray, intVon, j) Call QuickSort(vntArray, i, intBis) Else Call QuickSort(vntArray, i, intBis) Call QuickSort(vntArray, intVon, j) End If End If End Function ' QuickSort( vntArray, intVon, intBis )