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