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