Additional question from

Posted on 2003-12-11
Last Modified: 2010-05-01
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

        If rightNdx > leftNdx Then
            value = arr(rightNdx)
            i = leftNdx - 1
            j = rightNdx
            ' find the pivot item
            If descending Then
                    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
                    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
                leftStk(sp) = i + 1
                rightStk(sp) = rightNdx
                rightNdx = i - 1
            End If
            ' 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
    Set colTemp = New Collection
    strPrevious = ""
    For k = 0 To UBound(arr)
        strCurrent = arr(k)
        If strCurrent = strPrevious Then
            colTemp.Add strCurrent
        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
Question by:musclejack
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
LVL 17

Accepted Solution

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


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


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

End Sub
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
Set RS = Server.CreateObjct("ADODB.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
  .LockType = adLockBatchOptimistic
   ' Create columns in your record
   With .Fields
       .Append "Team", adVarChar, 100
       .Append "Priority", adSmallInt
   End With
End With

' first open the recordset

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

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

RS.Sort "Team"

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



Expert Comment

ID: 9941205

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.


<%@ 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
            While ((nBegin < nEnd) And (arrTemp(nBegin) <= strIndex))
                  nBegin = nBegin + 1
            While (arrTemp(nEnd) > strIndex)
                  nEnd = nEnd - 1
            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)
      nIndex = 0
      Redim Preserve arrTemp(objDictionary.Count)
      For Each strTemp in objDictionary
            arrTemp(nIndex) = strTemp
            nIndex = nIndex + 1
      Set objDictionary = Nothing
End Function

Function DisplayArray(arrTemp, nFirstIndex, nLastIndex)
      Dim i
      For i = nFirstIndex to nLastIndex
            Response.Write arrTemp(i) & "<br>"
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

Expert Comment

ID: 9957788

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.


Featured Post

Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
VBS file using code from 2nd file (txt or vbs) 4 55
Put text in a picture ASP.NET C# 2 73
How to compare ms sql hashbytes results within vb6 5 105
Hide vba in gp 7 125
Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
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…

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question