[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 311
  • Last Modified:

Can someone convert this VB code to ASP version?

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
musclejack
Asked:
musclejack
  • 2
1 Solution
 
RimvisCommented:
<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
 
RimvisCommented:
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
 
prohacxCommented:
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now