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

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

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