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

'*** v3.6 *** www.dieseyer.de *******************************
'
' Datei: sort-quicksort.vbs
' Autor: dieseyer@gmx.de
' Auf: www.dieseyer.de
'
' Sortiert die Zeilen einer Datei alphabetisch
'
' Das Sortieren auf einem Pentium 600MHz von
' 10.000 Zeilen VBScript-Code dauert ca. 2:30 min
' mit 100% CPU-Last
'
'************************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim WSHShell, fso, FileIn, FileOut
Dim Datei, Text, Txt, i, arrSort, arrTest(), oArgs

Dim StartZeit : StartZeit = Timer()

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
set oArgs = Wscript.Arguments

' Fals ein Argument übergeben wurde, sollte es einen Dateinamen
' enthalten
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For i = 0 to oArgs.Count - 1 ' hole alle Argumente
if i = 0 then Datei = oArgs.item(i)
Next


' Gibt's keinen Dateinamen, werden halt die Zeilen des Skripts
' alphabetisch sortiert
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if Datei = "" then Datei = WScript.ScriptName

Text = Text & now() & vbCRLF

' alle Zeilen lesen und an Array übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set FileIn = FSO.OpenTextFile(Datei, 1 ) ' Datei zum Lesen öffnen
i=0
Do While Not (FileIn.atEndOfStream) ' wenn Datei nicht zu ende ist, weiter machen
ReDim Preserve arrTest(i)
arrTest(i) = FileIn.Readline
i = i + 1
Loop
FileIn.Close
Set FileIn = nothing

Text = UBound(arrTest) & " Zeilen der Datei " & Datei & " werden jetzt (" & now() & ") durch " & WScript.ScriptName & " sortiert." & vbCRLF

QuickSort arrTest, LBound(arrTest), UBound(arrTest) ' Array "arrTest" wird sortiert
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Text = Text & UBound(arrTest) & " Zeilen der Datei " & Datei & " sind jetzt (" & now() & ") durch " & WScript.ScriptName & " sortiert."

' Zieldatei
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Datei = Datei & ".txt"


' Datei mit sortierten Zeilen füllen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set FileOut = FSO.OpenTextFile(Datei, 2, true) ' Datei zum Lesen öffnen

' FileOut.WriteLine( Text & vbCRLF ) ' nur Für Testzwecke

for i = 0 to ubound(arrTest)
FileOut.WriteLine( i+1 & vbTab & arrTest(i) )
next

' FileOut.WriteLine( vbCRLF & vbCRLF & now() ) ' nur Für Testzwecke
Text = Text & now()
FileOut.Close
Set FileOut = nothing

' Datei mit sortierten Zeilen anzeigen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
WSHShell.run Datei

MsgBox i & " Zeilen sind nach " & Timer() - StartZeit & "s sortiert.", 4096, WScript.ScriptName

WScript.Sleep 3000


' Datei mit sortierten Zeilen löschen
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' fso.DeleteFile ( Datei )

WScript.Quit
'***************************************************************


'*** v8.3 *** www.dieseyer.de *******************************
Function QuickSort( vntArray, intVon, intBis )
'************************************************************

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' http://www.heise.de/ct/ftp/listings.shtml
' ftp://ftp.heise.de/pub/ct/listings/0205-207.zip
' 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