ソートのアルゴリズムには各種ありますが、ここでは、
プログラムとしては、サーバサイド(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 関数との対比のために残っているだけです。