Solved

Can someone convert this VB code to ASP version?

Posted on 2003-12-12
3
265 Views
Last Modified: 2010-04-06
Store the values into an array and sort them and do not have the duplicate
------------------------------------------------------------------------------------.
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
            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
0
Comment
Question by:musclejack
  • 2
3 Comments
 
LVL 19

Accepted Solution

by:
Rimvis earned 500 total points
ID: 9927555
<HTML>
<head></head>
<BODY>
<%
    Dim arrMeng
    Dim i
    Dim strMeng
   
    arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
   
    QuickSort arrMeng, Ubound(arrMeng), false
    strMeng = ""
    For i = 0 To UBound(arrMeng)
        strMeng = strMeng & arrMeng(i) & " "
    Next
   
    Response.Write strMeng


Sub QuickSort(arr, numEls,descending)

    Dim value, temp
    Dim sp
    Dim leftStk(32), rightStk(32)
    Dim leftNdx, rightNdx
    Dim i, j
    Dim k
    Dim strPrevious
    Dim strCurrent
    Dim colTemp()
      
   
   
    ' 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
    i=0
    strPrevious = ""
    For k = 0 To UBound(arr)
        strCurrent = arr(k)
        If strCurrent = strPrevious Then
        Else
            'colTemp.Add strCurrent
            Redim Preserve colTemp(i)
            colTemp(i) = strCurrent
            i = i + 1
        End If
        strPrevious = strCurrent
    Next
   
    ReDim arr(i-1)
   
    For k = 1 To i
        strCurrent = colTemp(k-1)
        arr(k - 1) = strCurrent
    Next
   
End Sub
%>

</BODY>
</HTML>
0
 
LVL 19

Expert Comment

by:Rimvis
ID: 9927566
Here's what I did:

1) removed variable types
2) removed Optional keywords and added default values in procedure call
3) redesigned Collection into dynamic array
0
 
LVL 5

Expert Comment

by:prohacx
ID: 9927686
Or with the use of a dictionairy object instead of the collection:

<%@ Language=VBScript %>

<%

Option Explicit

'Sub Command1_Click()

    Dim arrMeng
    Dim i
    Dim strMeng
   
    arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
   
    QuickSort arrMeng,"",false
    strMeng = ""
    For i = 0 To UBound(arrMeng)
        strMeng = strMeng & arrMeng(i) & vbTab
    Next
   
    Response.Write strMeng

'End Sub

Sub QuickSort(arr, numEls, descending)

    Dim value, temp
    Dim sp
    Dim leftStk(32), rightStk(32)
    Dim leftNdx, rightNdx
    Dim i, j
    Dim k
    Dim strPrevious
    Dim strCurrent
    Dim colTemp, counter

    ' account for optional arguments
    If not Isnumeric(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 = server.CreateObject("Scripting.Dictionary")
    strPrevious = ""
    counter = 0
    For k = 0 To UBound(arr)
        strCurrent = arr(k)
        If strCurrent = strPrevious Then
        Else
            colTemp.Add counter, strCurrent
                  counter = counter+1
        End If
        strPrevious = strCurrent
    Next
   
    ReDim arr(colTemp.Count)
   
    For k = 0 To colTemp.Count
        strCurrent = colTemp.Item(k)
        arr(k) = strCurrent
    Next
   
End Sub


%>

0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

It's sometimes a bit tricky to use date functions in Oracle BPEL. I'll explain quickly how you can add N days to the current date. In a BPEL process this can be useful, and you can adapt it to fit your needs. First of all, let's see how to add 1 …
Shoutout to Emily Plummer (http://www.experts-exchange.com/members/eplummer26.html) for giving me this article! She did most of it, I just finished it up and posted it for her :)    Introduction In a previous article (http://www.experts-exchang…
The viewer will learn how to dynamically set the form action using jQuery.
The viewer will learn the benefit of using external CSS files and the relationship between class and ID selectors. Create your external css file by saving it as style.css then set up your style tags: (CODE) Reference the nav tag and set your prop…

911 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now