1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
| ''''''''''
' Options
Option Explicit
'''''
''''''''''
' Function CompareValues()
Function CompareValues(strValueA, strValueB, intCompType)
If intCompType = vbTextCompare Then
CompareValues = StrComp(strValueA, strValueB, vbTextCompare)
Else 'intCompType = vbBinaryCompare
If strValueA < strValueB Then
CompareValues = -1
ElseIf strValueA = strValueB Then
CompareValues = 0
Else
CompareValues = 1
End If
End If
End Function
'''''
''''''''''
' Function SwapValues()
Sub SwapValues(strValueA, strValueB)
Dim strTemp
strTemp = strValueB
strValueB = strValueA
strValueA = strTemp
End Sub
'''''
''''''''''
' Function QuickSort()
Sub QuickSort(arrValues, intMinIndex, intMaxIndex, intCompType)
Const INT_LESS = -1
Const INT_MORE = 1
Dim strMediumValue
Dim intRandIndex, intLowIndex, intHighIndex
If intMinIndex >= intMaxIndex Then Exit Sub
Randomize()
intRandIndex = Int(Rnd * (intMaxIndex - intMinIndex)) + intMinIndex
SwapValues arrValues(intMaxIndex), arrValues(intRandIndex)
strMediumValue = arrValues(intMaxIndex)
intLowIndex = intMinIndex
intHighIndex = intMaxIndex
Do
Do While (intLowIndex < intHighIndex) AND NOT (CompareValues(arrValues(intLowIndex), strMediumValue, intCompType) = INT_MORE)
intLowIndex = intLowIndex + 1
Loop
Do While (intHighIndex > intLowIndex) AND NOT (CompareValues(arrValues(intHighIndex), strMediumValue, intCompType) = INT_LESS)
intHighIndex = intHighIndex - 1
Loop
If intLowIndex < intHighIndex Then
SwapValues arrValues(intLowIndex), arrValues(intHighIndex)
End If
Loop While intLowIndex < intHighIndex
SwapValues arrValues(intLowIndex), arrValues(intMaxIndex)
If (intLowIndex - intMinIndex) < (intMaxIndex - intLowIndex) Then
QuickSort arrValues, intMinIndex, intLowIndex - 1, intCompType
QuickSort arrValues, intLowIndex + 1, intMaxIndex, intCompType
Else
QuickSort arrValues, intLowIndex + 1, intMaxIndex, intCompType
QuickSort arrValues, intMinIndex, intLowIndex - 1, intCompType
End If
End Sub
'''''
''''''''''
' Vars
Dim objFso, objFileIn, objFileOut
Dim arrFileContent
Dim strLine
Dim intLineCounter
'''''
''''''''''
' Main
Set objFso=CreateObject("Scripting.FileSystemObject")
Set objFileIn= objFso.OpenTextFile("fichier.txt", 1)
Redim arrFileContent(0)
intLineCounter = 0
Do Until objFileIn.AtEndOfStream
Redim Preserve arrFileContent(intLineCounter)
arrFileContent(intLineCounter) = objFileIn.readline
intLineCounter = intLineCounter + 1
Loop
objFileIn.Close
Quicksort arrFileContent, LBound(arrFileContent), UBound(arrFileContent), vbTextCompare
Set objFileOut = objFso.CreateTextFile("fichier2.txt", True)
For Each strLine In arrFileContent
objFileOut.WriteLine strLine
Next
objFileOut.Close
'''''
''''''''''
'Clean up objects vars
Set objFso = Nothing
Set objFileIn = Nothing
Set objFileOut = Nothing
'''''
''''''''''
'End
WScript.Echo "END"
WScript.quit
''''' |
