Solved

Posted on 2003-12-11
175 Views
Can someone show me the ASP version of this:
-------------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Private Sub Command1_Click()

Dim arrMeng As Variant
Dim i As Integer
Dim strMeng As String

arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")

QuickSort arrMeng
strMeng = ""
For i = 0 To UBound(arrMeng)
strMeng = strMeng & arrMeng(i) & vbTab
Next i

MsgBox strMeng

End Sub

Sub QuickSort(arr As Variant, Optional numEls As Variant, _Optional descending As Boolean)

Dim value As Variant, temp As Variant
Dim sp As Integer
Dim leftStk(32) As Long, rightStk(32) As Long
Dim leftNdx As Long, rightNdx As Long
Dim i As Long, j As Long
Dim k As Long
Dim strPrevious As String
Dim strCurrent As String
Dim colTemp As Collection

' account for optional arguments
If IsMissing(numEls) Then numEls = UBound(arr)
' init pointers
leftNdx = LBound(arr)
rightNdx = numEls
' init stack
sp = 1
leftStk(sp) = leftNdx
rightStk(sp) = rightNdx

Do
If rightNdx > leftNdx Then
value = arr(rightNdx)
i = leftNdx - 1
j = rightNdx
' find the pivot item
If descending Then
Do
Do: i = i + 1: Loop Until arr(i) <= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
Else
Do
Do: i = i + 1: Loop Until arr(i) >= value
Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
Loop Until j <= i
End If
' swap found items
temp = arr(j)
arr(j) = arr(i)
arr(i) = arr(rightNdx)
arr(rightNdx) = temp
' push on the stack the pair of pointers that differ most
sp = sp + 1
If (i - leftNdx) > (rightNdx - i) Then
leftStk(sp) = leftNdx
rightStk(sp) = i - 1
leftNdx = i + 1
Else
leftStk(sp) = i + 1
rightStk(sp) = rightNdx
rightNdx = i - 1
End If
Else
' pop a new pair of pointers off the stacks
leftNdx = leftStk(sp)
rightNdx = rightStk(sp)
sp = sp - 1
If sp = 0 Then Exit Do
End If
Loop

Set colTemp = New Collection
strPrevious = ""
For k = 0 To UBound(arr)
strCurrent = arr(k)
If strCurrent = strPrevious Then
Else
End If
strPrevious = strCurrent
Next k

ReDim arr(colTemp.Count)

For k = 1 To colTemp.Count
strCurrent = colTemp.Item(k)
arr(k - 1) = strCurrent
Next k

End Sub
0
Question by:musclejack
• 2
• 2

LVL 17

Accepted Solution

inthedark earned 500 total points
ID: 9926581
When coding in asp just leave off the declaration types.

Example:

Dim arrMeng As Variant
Dim i As Integer
Dim strMeng As String

becomes

Dim arrMeng
Dim i
Dim strMeng

But take my advice and use a disconnected adodb.recordset which will work way faster than your sort routine.

But here is an ASP routine that sorts an array:

PS you don't need the descending option is it is so easy like this:

For i = UBound(arrMeng) To 0 Step -1

Sub SortArray(AnyArray)

' Sort an array.

Dim MaxElement
Dim Buff
Dim blnSwap
Dim i

MaxElement = UBound(AnyArray) - 1
blnSwap = True
Do While blnSwap
blnSwap = False
For i = 0 To MaxElement
If AnyArray(i) > AnyArray(i + 1) Then
Buff = AnyArray(i)
AnyArray(i) = AnyArray(i + 1)
AnyArray(i + 1) = Buff
blnSwap = True
End If
Next
Loop

End Sub
0

LVL 17

Expert Comment

ID: 9926604
Here is a better way to sort in ASP as ASP is much slower than VB so your sort routine will be slooooow

' Create an instance of the recordset

With RS

' prime for use in disconnected mode
Set .ActiveConnection = Nothing
.CursorLocation = adUseClient ' you need to import the ADODB ASP declarations for this to work

' Create columns in your record
With .Fields
End With
End With

' first open the recordset
RS.Open

' create some test data
RS("Team") = "Ford"
RS("Priority") = 2
RS.Update

' create some test data
RS("Team") = "BBC"
RS("Priority") = 1
RS.Update

RS.Sort "Team"

Do While Not RS.Eof
MsgBox RS("Team")

RS.MoveNext
Loop

etc....
0

LVL 6

Expert Comment

ID: 9941205
musclejack,

this is not exactly a VB question. I couldn't exactly understand what you wanted. However, i referred to the other question mentioned in your link and understood what you wanted.

i have provided some ASP code which removes duplicates and then sorts the array for you. while copying the code, copy the below into notepad and then into your asp editor.

just copy paste as it is and try it.

cheers,
srimanth.

--------------------------
<%@ Language="VBScript" %>
<%
Function Sort(arrTemp, nFirstIndex, nLastIndex)
Dim strTemp, strIndex, nBegin, nEnd

If (nFirstIndex - nFirstIndex) = 1 Then
If (arrTemp(nFirstIndex) > arrTemp(nLastIndex)) Then
strTemp = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = arrTemp(nLastIndex)
arrTemp(nLastIndex) = strTemp
End If
End If

strIndex = arrTemp(Int((nFirstIndex + nLastIndex) / 2))
arrTemp(Int((nFirstIndex + nLastIndex) / 2)) = arrTemp(nFirstIndex)
arrTemp(nFirstIndex) = strIndex

nBegin = nFirstIndex + 1
nEnd = nLastIndex

Do
While ((nBegin < nEnd) And (arrTemp(nBegin) <= strIndex))
nBegin = nBegin + 1
Wend

While (arrTemp(nEnd) > strIndex)
nEnd = nEnd - 1
Wend

If (nBegin < nEnd) Then
strTemp = arrTemp(nBegin)
arrTemp(nBegin) = arrTemp(nEnd)
arrTemp(nEnd) = strTemp
End If
Loop While (nBegin < nEnd)

arrTemp(nFirstIndex) = arrTemp(nEnd)
arrTemp(nEnd) = strIndex

If (nFirstIndex < (nEnd - 1)) Then Sort arrTemp, nFirstIndex, nEnd - 1
If ((nEnd + 1) < nLastIndex) Then Sort arrTemp, nEnd + 1, nLastIndex
End Function

Function RemoveDuplicates(arrTemp, nFirstIndex, nLastIndex)
Dim objDictionary, nIndex, strTemp
Set objDictionary = Server.CreateObject("Scripting.Dictionary")

For i = nFirstIndex to nLastIndex
If (Not objDictionary.Exists(arrTemp(i))) Then objDictionary.Add arrTemp(i), arrTemp(i)
Next

nIndex = 0
Redim Preserve arrTemp(objDictionary.Count)
For Each strTemp in objDictionary
arrTemp(nIndex) = strTemp
nIndex = nIndex + 1
Next

Set objDictionary = Nothing
End Function

Function DisplayArray(arrTemp, nFirstIndex, nLastIndex)
Dim i

For i = nFirstIndex to nLastIndex
Response.Write arrTemp(i) & "<br>"
Next
End Function

'Main Code
Dim arrNames()
Redim arrNames(10)
arrNames(0) = "zero"
arrNames(1) = "one"
arrNames(2) = "two"
arrNames(3) = "three"
arrNames(4) = "four"
arrNames(5) = "five"
arrNames(6) = "one"
arrNames(7) = "two"
arrNames(8) = "three"
arrNames(9) = "four"

Response.Write "<b>Unsorted & Duplicates Array</b><br>"
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1

Response.Write "<br><b>Unsorted & Unique Array</b><br>"
RemoveDuplicates arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1

Response.Write "<br><b>Sorted & Unique Array</b><br>"
Sort arrNames, LBound(arrNames), UBound(arrNames) - 1
DisplayArray arrNames, LBound(arrNames), UBound(arrNames) - 1
%>
0

LVL 6

Expert Comment

ID: 9957788
musclejack,

did u try the code i provided? All u have to do is to copy paste the code and try it in your browser. the method provided is quick sort which is very fast for bigger data.

cheers,
srimanth.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

#### Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!