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

'*** v3.6 *** www.dieseyer.de *******************************
'
' Datei: sort-bubblesort.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. 8 min
' mit 20..30% 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


' 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

arrSort = bubblesort(arrTest) ' function - Aufruf
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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
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


'*** v3.6 *** www.dieseyer.de *******************************
Function bubblesort( arrSortieren )
'************************************************************
Dim i, j
for i = 0 to ubound(arrSortieren)

for j = i + 1 to ubound(arrSortieren)
if UCase( arrSortieren(i) ) > UCase( arrSortieren(j) ) then
' Groß- und Kleinbuchstaben werden gelich behandelt
' -------------------------------------------------

' if arrSortieren(i) > arrSortieren(j) then
' erst alle Zeilen die mit Großbuchstaben beginnen
' dann alle Zeilen die mit Kleinbuchstaben beginnen
' -------------------------------------------------

bubblesort = arrSortieren(i)
arrSortieren(i) = arrSortieren(j)
arrSortieren(j) = bubblesort
end if
next
next

End Function ' bubblesort( arrSortieren )

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