http://dieseyer.de • all rights reserved • © 2011 v11.4
'*** 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 )
http://dieseyer.de • all rights reserved • © 2011 v11.4