'*** v10.2 *** www.dieseyer.de *****************************
'
' Datei:  arrayanzeigen-verzeichnisliste.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 "036 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"
  LogEintrag "037 :: LogDatei: " & LogDatei

If not fso.FolderExists( QuellVerz ) Then 	  WSHShell.Popup "Falscher Parameter für ""QuellVerz"": " & vbCRLF & vbTab & "'" & QuellVerz & "'", 30, "039 :: ENDE - " & WScript.ScriptName : WScript.Quit

Dim arrVerzLst

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
arrVerzLst = Verzeichnislisteholen( QuellVerz )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  LogEintrag "046 :: UBound( arrVerzLst ): " & UBound( arrVerzLst )


ArrayZeigen( arrVerzLst )


' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
QuickSort arrVerzLst, LBound( arrVerzLst ), UBound( arrVerzLst )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


ArrayZeigen( arrVerzLst )


' CreateObject("WScript.Shell").Run "notepad " & LogDatei

WSHShell.Popup "= = = E N D E = = =", 2, "062 :: " & WScript.ScriptName

LogEintrag "064 :: 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 "116 :: " & vbCRLF & TxtOben
  MsgBox TxtOben , , "117 :: " & WScript.ScriptName

End Function ' ArrayZeigen( InArray )


'*** v10.2 *** www.dieseyer.de *****************************
Function Verzeichnislisteholen( Verz )
'***********************************************************
' Die Prozedur
'    Verzeichnislisteholen( Verz )
' gibt ein Array mit dem kompletten Dateinamen von allen
' Verzeichnisse zurück, die in dem übergebenen Verzeichnis
' vorhanden sind. Ein rekursives Auflisten der Verzeichnisse
' in Unterverzeichnissen erfolgt nicht!

  Dim fso			: Set fso		= WScript.CreateObject("Scripting.FileSystemObject")
  Dim Ausgeschl     : Ausgeschl    = Mid( WScript.ScriptName, 1 , InStrRev( WScript.ScriptName, "." ) )
  Dim i, oFolders, oSubFolder, VerzX
  i = 0
  Set oFolders   = fso.GetFolder( Verz )  
  Set oSubFolder = oFolders.SubFolders
  For Each VerzX In oSubFolder
	ReDim Preserve VerzeichnislisteholenX(i)
'	ReDim Preserve Verzeichnislisteholen(i)
	VerzeichnislisteholenX(i) = VerzX
	i = i + 1
  Next
  Set oSubFolder = nothing
  Set oFolders   = nothing
  Verzeichnislisteholen = VerzeichnislisteholenX

End Function ' Verzeichnislisteholen( 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 )