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