ソートのアルゴリズムには各種ありますが、ここでは、
プログラムとしては、サーバサイド(ASP)でも、クライアントサイド(IE)でもどちらでも動きます。ただし、Class を使っているので、VBScript のバージョンは 5 以上が必要となります。クライアントサイドにおける VBScript のバージョンの管理が難しい場合は、ソートは JavaScript でおこなうほうが良いでしょう。
VBScript ではなく VB(Visual Basic) にも移植できると思いますが、試してはいません。(その後、VB 用に移植したものを追加しました。)
Sub swap(ByRef x, ByRef y) ' 汎用の交換用(すべてのアルゴリズムで使う) Dim d Set d = x Set x = y Set y = d End Sub Sub sortBubble(ByRef a) ' バブルソート Dim i For i = 0 To UBound(a) - 1 Dim j For j = i + 1 To UBound(a) If a(j).compareTo(a(i)) < 0 Then Call swap(a(i), a(j)) End If Next Next End Sub Sub sortInsertion(ByRef a) ' 挿入ソート Dim i For i = 1 To UBound(a) Dim j For j = i To 1 Step -1 If a(j).compareTo(a(j - 1)) < 0 Then Call swap(a(j), a(j - 1)) Else Exit For End If Next Next End Sub Sub sortSelection(ByRef a) ' 選択ソート Dim i For i = 0 To UBound(a) - 1 Dim k k = i Dim j For j = i + 1 To UBound(a) If a(j).compareTo(a(k)) < 0 Then k = j End If Next Call swap(a(i), a(k)) Next End Sub Sub sortQuickSub(ByRef a, ByVal p, ByVal q) ' クイックソート(内部ルーチン) Dim i i = p Dim j j = q Dim x Set x = a(p) Do Do While a(i).compareTo(x) < 0 i = i + 1 Loop Do while x.compareTo(a(j)) < 0 j = j - 1 Loop If i >= j Then Exit Do End If Call swap(a(i), a(j)) i = i + 1 j = j - 1 Loop If p < i - 1 Then Call sortQuickSub(a, p, i - 1) End If If j + 1 < q Then Call sortQuickSub(a, j + 1, q) End If End Sub Sub sortQuick(ByRef a) ' クイックソート If 0 < UBound(a) Then Call sortQuickSub(a, 0, UBound(a)) End If End Sub
Class PersonClass Dim intAge ' 年齢 Dim strName ' 名前 Function compareTo(ByRef o) If intAge < o.intAge Then compareTo = -1 ElseIf intAge > o.intAge Then compareTo = 1 Else ' 年齢が同じ場合は名前でソートする If strName < o.strName Then compareTo = -1 ElseIf strName > o.strName Then compareTo = 1 Else compareTo = 0 End If End If End Function End Class Sub sampleA() Dim x(3) ' 4 人分 Dim o Set o = New PersonClass o.intAge = 33 o.strName = "suzuki" Set x(0) = o Set o = New PersonClass o.intAge = 15 o.strName = "tanaka" Set x(1) = o Set o = New PersonClass o.intAge = 33 o.strName = "sato" Set x(2) = o Set o = New PersonClass o.intAge = 20 o.strName = "yamada" Set x(3) = o ' ソートアルゴリズムをどれかひとつ使う ' Call sortBubble(x) ' バブルソート ' Call sortInsertion(x) '挿入ソート ' Call sortSelection(x) '選択ソート Call sortQuick(x) ' クイックソート Dim s s = "" Dim i For i = 0 To UBound(x) s = s & x(i).strName & ": " & x(i).intAge & vbNewLine Next Call MsgBox(s) ' クライアントサイド(IE)の場合 ' Call Response.Write(s) ' サーバサイド(ASP)の場合 End Sub Call sampleA()
Class OneField Dim x ' 単一の値 Function compareTo(ByRef o) If x < o.x Then compareTo = -1 ElseIf x > o.x Then compareTo = 1 Else compareTo = 0 End If End Function End Class Sub sampleB() Dim x(9) ' 10 個の要素 Dim i For i = 0 To UBound(x) x(i) = CLng(Int(Rnd(1) * 100)) ' 0 以上 100 未満の整数を乱数で求める Next ' 汎用ルーチンを呼び出すためコピーする ReDim y(UBound(x)) For i = 0 To UBound(x) Set y(i) = New OneField y(i).x = x(i) Next ' ソートアルゴリズムをどれかひとつ使う ' Call sortBubble(y) ' バブルソート ' Call sortInsertion(y) '挿入ソート ' Call sortSelection(y) '選択ソート Call sortQuick(y) ' クイックソート ' 汎用ルーチンから得られたものをコピーし直す For i = 0 To UBound(x) x(i) = y(i).x Next Call Erase(y) ' 使い終わったので消す Dim s s = "" For i = 0 To UBound(x) s = s & x(i) & vbNewLine Next Call MsgBox(s) ' クライアントサイド(IE)の場合 End Sub Call sampleB()
sort.txt: WSH 用のサンプルプログラムです(ダウンロード後に拡張子を .vbs に変えれば WSH 上で動きます)。動かすと要素数とソートアルゴリズムを聞いてきますので、指定してください。(キーは1から数えて)年齢を第1キー、名前を第2キーとしてソートします。したがって年齢が同じなら、名前のアルファベット順でソートされていることになります。
sort.js: 上記の JavaScript 版です。機械的に VBScript から JavaScript へ移植した感が強いです。サンプルとしての入出力は手が抜いてあるので、適宜拡張してください。なお、このコード中で「埋め込み」とあるのは、別段アルゴリズムの種別を指すのではなく、JavaScript のエンジンに埋め込まれている sort 関数を使うという意味です。これは単に各種ソートアルゴリズムの自前の実装と sort 関数との対比のために残っているだけです。