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

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

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