[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
Solved

# Can someone convert this VB code to ASP version?

Posted on 2003-12-12
Medium Priority
306 Views
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
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
[X]
###### 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
• 2

LVL 19

Accepted Solution

Rimvis earned 2000 total points
ID: 9927555
<HTML>
<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
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

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

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
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

Question has a verified solution.

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

Most of the sites are being standardized with W3C Web Standards. W3C provides lot of web standard services to the web. They have the web specification, process and documentation for all the web standards. You can apply HTML, CSS and Accessibility st…
Preface This is the third article about the EE Collaborative Login Project. A Better Website Login System (http://www.experts-exchange.com/A_2902.html) introduces the Login System and shows how to implement a login page. The EE Collaborative Logi…
HTML5 has deprecated a few of the older ways of showing media as well as offering up a new way to create games and animations. Audio, video, and canvas are just a few of the adjustments made between XHTML and HTML5. As we learned in our last micr…
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.
###### Suggested Courses
Course of the Month13 days, 8 hours left to enroll