'*** v10.5 *** www.dieseyer.de *****************************
'
' Datei:  arrayanzeigen-dateiinhalt.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


  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 "027 :: Start " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"
  LogEintrag "028 :: LogDatei: " & LogDatei

Dim arrTst, arrUnSort
Dim Tst
Tst = WScript.ScriptFullName

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
arrTst = DateiInhalt( Tst )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Tst = "037 :: UBound( arrTst ) = " & UBound( arrTst )
  LogEintrag Tst
  MsgBox Tst, , "039 :: "

ArrayZeigen( arrTst )

arrUnSort = arrTst

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
QuickSort arrTst, LBound( arrTst ), UBound( arrTst )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Tst = "048 :: UBound( arrTst ) = " & UBound( arrTst )
  LogEintrag Tst
  MsgBox Tst, , "050 :: "

ArrayZeigen( arrTst )

  Tst = "054 :: UBound( arrUnSort ) = " & UBound( arrUnSort )
  LogEintrag Tst
  MsgBox Tst, , "056 :: "

ArrayZeigen( arrUnSort )

  Tst = WScript.ScriptFullName & ".txt"
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call DateiSchreiben( arrTst, Tst )
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

CreateObject("WScript.Shell").Run "notepad " & Tst ' geschriebene Datei anzeigen

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

LogEintrag "069 :: Ende " & WScript.ScriptFullName & " ( " & fso.GetFile( WScript.ScriptFullName ).DateLastModified & " )"

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

WScript.Quit


'*** v10.5 *** www.dieseyer.de *****************************
Function DateiInhalt( DateiX )
'***********************************************************
  Dim fso         	: Set fso       	= CreateObject("Scripting.FileSystemObject")
  Dim FileIn		: Set FileIn		= fso.OpenTextFile( DateiX, 1 )
  Dim Txt, Tst, i

  i = 0 : ReDim Preserve Zeile(i) : Zeile(i) = ""

  Do While Not ( FileIn.atEndOfStream )
'	Tst = Trim( FileIn.Readline )
	Tst = FileIn.Readline
'	If Len( Tst ) > 2 Then
		Txt = Txt & Tst & vbCRLF
		ReDim Preserve Zeile(i)
		Zeile(i) = Tst
		i = i + 1
'	End If
  Loop
' MsgBox Txt, , "095 :: "

  If UBound( Zeile ) < 1 AND Zeile( UBound( Zeile ) ) = "" Then Zeile( UBound( Zeile ) ) = "LEER"

  FileIn.Close
  Set FileIn  = nothing
  DateiInhalt = Zeile
End Function ' DateiInhalt( DateiX )


'*** v8.C *** www.dieseyer.de ******************************
Sub DateiSchreiben( arrDaten, ZielDatei )
'***********************************************************
  Dim fso         	: Set fso       	= WScript.CreateObject("Scripting.FileSystemObject")
  Dim FileOut, i
  Set FileOut  = fso.OpenTextFile( ZielDatei, 2, True ) ' 2 => neue Datei; 8 => Datei erweitern
	FileOut.WriteLine UBound( arrDaten ) & " Zeilen werden geschrieben (" & now() & ")"
  For i = LBound( arrDaten ) to UBound( arrDaten )
	FileOut.WriteLine arrDaten(i)
  Next
  FileOut.Close
  Set FileOut  = nothing
End Sub ' DateiSchreiben( arrDaten, ZielDatei )


'*** v8.3 *** www.dieseyer.de ******************************
Sub LogEintrag( LogTxt )
'***********************************************************
  Dim fso         : Set fso       = WScript.CreateObject("Scripting.FileSystemObject")
  Dim FileOut

  On Error Resume Next
	Dim LogDatei	' wurde die Variable LogDatei nicht außerhalb der Prozedur definiert
  On Error Goto 0
		' definiert, erfolgt dies jetzt hier:
' If LogDatei = "" Then LogDatei = "c:\" & WScript.Scriptname & ".log"
  If LogDatei = "" Then LogDatei = WScript.ScriptFullName & ".log"

  If LogTxt = "" Then   ' eine neue .LOG-Datei wird erstellt, eine vorhandene überschrieben
    Set FileOut = fso.OpenTextFile( LogDatei, 2, true)
        FileOut.Close
    Set FileOut = Nothing
    Set fso     = Nothing
    Exit Sub
  End If

  LogTxt = Replace( LogTxt, vbTab, "    " )

    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 )

'*** 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 "255 :: " & vbCRLF & TxtOben
  MsgBox TxtOben , , "256 :: "

End Function ' ArrayZeigen( InArray )