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