Resize multidimensional array and sort them by date - asp-classic

I think my code successfully creates the multi dimensional array because I get the right amount when I count it with UBound(DataArray).
But I get null value when I try to display one of the data as Response.Write DataArray(1,0).
Any help appreciated!
sDateArray = Split(DateArray, ",")
sVenueArray = Split(VenueArray, ",")
Dim DataArray()
For i = 0 to uBound(sDateArray)-1
ReDim DataArray(i, 1)
DataArray(i, 0) = sDateArray(i)
DataArray(i, 1) = sVenueArray(i)
Next
Response.Write UBound(DataArray) & "<br /><br />"
DataArray(1,0)
Response.Write DataArray(1,0)

Try Redim Preserve DataArray(i, 1) instead of ReDim DataArray(i, 1)
...or...
sDateArray = Split(DateArray, ",")
sVenueArray = Split(VenueArray, ",")
Dim DataArray(uBound(sDateArray)-1, 1)
For i = 0 to uBound(sDateArray)-1
DataArray(i, 0) = sDateArray(i)
DataArray(i, 1) = sVenueArray(i)
Next
Response.Write UBound(DataArray) & "<br /><br />"
' DataArray(1,0) ' <== commented out cos I think this might be an error - ?
Response.Write DataArray(1,0)
Ok I was bored so I wrote this.
May not be perfect - it's been a while since I used Classic ASP
Function SortByDate(a_input)
x = UBound(a_input, 1) - 1
if( x < 1 ) Then
Response.Write "<p>Invalid input array - first element is empty</p>"
Stop
End If
Dim a_output(x, 1)
Dim earliest_date
For j=0 To x
earliest_date = -1
For i=0 To UBound(a_input, 1) - 1
If a_input(0, i) <> "" Then
If earliest_date = -1 Then
earliest_date = i
Else
If CDate(a_input(0,i)) > CDate(a_input(0,earliest_date)) Then
earliest_date = i
End If
End If
End If
Next
a_output(0, i) = a_input(0, earliest_date)
a_output(1, i) = a_input(1, earliest_date)
a_input(0, earliest_date) = "" ' this one is done so skip next time '
Next
SortByDate = a_output
End Function

Related

What's the best way to parse an SQL fragment string into a List(of string) for a Listbox control?

I'm trying to take this string:
(("DISPLAY_NAME" like N'sadf%') And ("ID" = 2) And ("IsCRITERION" = null))
and parse it into a List(of string) so that it can be displayed like:
(
(
"DISPLAY_NAME" like N'sadf%'
)
And
(
"ID" = 2
)
Or
(
"IsCRITERION" = null
)
)
I'm close but don't quite have it. My code currently looks like:
Dim filterlist As New List(Of String)
Dim temp As String = String.Empty
Dim lvl As Integer = 0
Dim pad As String = String.Empty
For Each chr As Char In originalString '--- filter is the string i posted above
Select Case chr.ToString.ToLower()
Case "("
filterlist.Add(pad.PadLeft(lvl * 5) & chr)
lvl += 1
Case ")"
filterlist.Add(pad.PadLeft(lvl * 5) & temp)
If lvl > 0 Then lvl -= 1
filterlist.Add(pad.PadLeft(lvl * 5) & chr)
'If lvl > 0 Then lvl -= 1
temp = String.Empty
Case Else
temp &= chr
End Select
Next
'--- Removes the empty line produced by generating the List(of String)
filterlist = filterlist.Where(Function(s) Not String.IsNullOrWhiteSpace(s)).ToList()
listSelectedCriteria.DataSource = filterlist
listSelectedCriteria.DataBind()
Unfortunately, the above code produces something close to what I desire but the "And"s and "Or"s are not in the right places:
(
(
"DISPLAY_NAME" like N'sadf%'
)
(
And "ID" = 2
)
(
Or "IsCRITERION" = null
)
)
Would using regular expressions be better? Thanks for the help
Probably the "best" way (although that's getting into "primarily opinion-based" territory) would be to use a parser, but assuming that your input is limited to similar looking strings, here's what I came up with:
Dim originalString = "((""DISPLAY_NAME"" like N'sadf%') And (""ID"" = 2) And (""IsCRITERION"" = null))"
Dim filterlist = New List(Of String)()
Dim temp = New StringBuilder()
Dim lvl = 0
Dim addLine =
Sub(x As String)
filterlist.Add(New String(" ", lvl * 4) & x.Trim())
End Sub
For Each c In originalString
Select Case c
Case "("
If temp.Length > 0 Then
addLine(temp.ToString())
temp.Clear()
End If
addLine("(")
lvl += 1
Case ")"
If temp.Length > 0 Then
addLine(temp.ToString())
temp.Clear()
End If
lvl -= 1
addLine(")")
Case Else
temp.Append(c)
End Select
Next
If temp.Length > 0 Then
addLine(temp.ToString())
temp.Clear()
End If
filterlist.Dump() ' LINQPad ONLY
This results in:
(
(
"DISPLAY_NAME" like N'sadf%'
)
And
(
"ID" = 2
)
And
(
"IsCRITERION" = null
)
)
However, you will probably end up having to add code as you find different inputs that don't quite work how you want.
Instead of looking at each characters, I would start be doing a split. And then add/remove padding depending on what character is at the start.
Dim tempString As String = "((""DISPLAY_NAME"" like N'sadf%') And (""ID"" = 2) And (""IsCRITERION"" = null))"
Dim curPadding As String = ""
Const padding As String = " "
Dim result As New List(Of String)
For Each s As String In Text.RegularExpressions.Regex.Split(tempString, "(?=[\(\)])")
If s <> "" Then
If s.StartsWith("(") Then
result.Add(curPadding & "(")
curPadding &= padding
result.Add(curPadding & s.Substring(1).Trim())
ElseIf s.StartsWith(")") Then
curPadding = curPadding.Substring(padding.Length)
result.Add(curPadding & ")")
result.Add(curPadding & s.Substring(1).Trim())
Else
result.Add(curPadding & s)
End If
End If
Next

VBS multidimensional array from a For Each

Perspective: This script will run on user login and on command with a shortcut on the desktop. The order the application start is imperative. Throughout the script, I require the full path and the program name.
Problem: Each program path is a value in an array. I am trying to split each program path by “\” and get the upper bound to get the program name. Then Redim Preserve the original array and add the program on the second dimension. After reading for many hours, I grasp I can only change the last dimension, but I can’t figure out how to not get out of bound errors. This Creating a Multidimensional, Associative Array in VBScript is not trying to redim preserve from a For Each split.
Set objFso = CreateObject("Scripting.FileSystemObject")
'---Create Program Variables
strProgram1 = "%SystemRoot%\notepad.exe"
strProgram2 = "C:\Program Files\Microsoft Office\root\Office16\OUTLOOK.EXE"
strProgram3 = "C:\Program Files\Microsoft Office\root\Office16\ONENOTE.EXE"
strProgram4 = "C:\Program Files (x86)\Internet Explorer\iexplore.exe" & " https://www.google.com" 'IE with URL
'---Add Program Path Variables to an Array
ReDim strProgramList(3)
strProgramList = Array(strProgram1,strProgram2,strProgram3,strProgram4)
strProgramNameList = Array()
strProgramRestartList = Array()
boolNeedsRestart = false
'---Iterating using For each loop to get program name.
ReDim Preserve strProgramList(3, 1)
For Each strProgramPath In strProgramList
strPathComponents = Split(strProgramPath, "\")
strProgramName = strPathComponents(Ubound(strPathComponents))
strProgramList(0, LBound(strProgramList) + 1) = strProgramName
Next
MsgBox strProgramList(0,0) & vbNewLine & strProgramList(1,0) & vbNewLine & strProgramList(2,0) & vbNewLine & strProgramList(3,0) & vbNewLine & strProgramList(0,1) & vbNewLine & strProgramList(1,1) & vbNewLine & strProgramList(2,1) & vbNewLine & strProgramList(3,1)
How to use the FileSystemObject to parse/build pathes and how to work with two-dimensional arrays:
Option Explicit
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim a : a = Split("A:\B\CC.EXE A:\CC\DD.CMD C:\You\Got\It.pl")
ReDim b(2, UBound(a))
Dim i
For i = 0 To UBound(a)
b(0, i) = a(i)
b(1, i) = goFS.GetParentFolderName(a(i))
b(2, i) = goFS.GetFileName(a(i))
Next
ReDim Preserve b(2, UBound(b, 2) + 1)
b(0, UBound(b, 2)) = "P:\i\pa\po.py"
b(1, UBound(b, 2)) = goFS.GetParentFolderName(b(0, UBound(b, 2)))
b(2, UBound(b, 2)) = goFS.GetFileName(b(0, UBound(b, 2)))
For i = 0 To UBound(b, 2)
WScript.Echo b(0, i), "=", b(1, i), "+", b(2, i), "=>", goFS.BuildPath(b(1, i), b(2, i))
Next
output:
cscript twodim.vbs
A:\B\CC.EXE = A:\B + CC.EXE => A:\B\CC.EXE
A:\CC\DD.CMD = A:\CC + DD.CMD => A:\CC\DD.CMD
C:\You\Got\It.pl = C:\You\Got + It.pl => C:\You\Got\It.pl
P:\i\pa\po.py = P:\i\pa + po.py => P:\i\pa\po.py

How to reuse an array in asp.net vb

I'm having to build a table of web pages and languages, i.e. page 1: en it de in a schema where there could be up to 14 languages. The page contents are held in a database. So to build the table I'm doing the following:
Dim rowArrayList As New ArrayList
Dim thisRow(languageNum) As String 'languageNum equates to number of columns -1
Database access then:
'# Create row array of cell arrays
If pageName <> lastPageName Then
lastPageName = pageName
If j >= languageNum Then
rowArrayList.Add(thisRow)
Array.Clear(thisRow, 0, thisRow.Length)
j = 0
End If
thisRow(0) = "<td class=""pageName"">" & pageName & "</td>"
End If
'# Iterate each cell in the row
For i As Integer = 1 To languageNum - 1
If thisRow(i) = "" Then
If transReady = False And active = False Then
thisRow(i) = "<td class=""trans"">" & langISO & "</td>"
ElseIf transReady = True And active = False Then
thisRow(i) = "<td class=""notActive"">" & langISO & "</td>"
ElseIf transReady = True And active = True And i = thisLangID Then
thisRow(i) = "<td class=""active"">" & langISO & "</td>"
End If
End If
j = j + 1
Next
The build the table:
'# Build output table
For Each row As String() In rowArrayList
tableBody.Text += "<tr>"
For Each cell As String In row
If cell = "" Then
tableBody.Text += "<td class=""notTrans""> </td>"
Else
tableBody.Text += cell
End If
Next
tableBody.Text += "</tr>"
Next
The table displays beautifully BUT every row contains the data for what should be the last row. How can it be fixed it so each thisRow is unique in the the rowArrayList? At the moment, every time thisRow is added to rowArrayList, every rowArrayList index is overwritten, not just the one being added.
For the quick fix, instead of this:
Array.Clear(thisRow, 0, thisRow.Length)
Do this:
thisRow = New String(languageNum) {}
or this:
ReDim thisRow(languageNum)
However, I suspect there are some simple design choices you could change that would drastically change this code for the better.

Add Values in an Array - Classic ASP

I am using the following For loop to display all files in a folder excluding files with an .asp extension.
I want to add the filename to an array, so that objFileItem.Name gets added to each element in tmpArray.
I tried using tmpArray(k) = objFileItem.Name but its throwing an error.
For Each objFileItem In objFolderContents
strFileExtension = LCase(Mid(objFileItem.Name, _
InStrRev(objFileItem.Name, ".", -1, 1) + 1))
If strFileExtension <> "asp" Then
strImages=strImages & objFileItem.Name
end if
Next
If you have reasonable amount of items (less than 100) just use dynamic array like this:
Dim tmpArray()
ReDim tmpArray(-1)
For Each objFileItem In objFolderContents
strFileExtension = LCase(Mid(objFileItem.Name, _
InStrRev(objFileItem.Name, ".", -1, 1) + 1))
If strFileExtension <> "asp" Then
strImages = strImages & objFileItem.Name
ReDim Preserve tmpArray(UBound(tmpArray) + 1)
tmpArray(UBound(tmpArray)) = objFileItem.Name
End If
Next
'show array items:
Response.Write("Total of " & (UBound(tmpArray) + 1) & " files:<br />")
For k=0 To UBound(tmpArray)
Response.Write(tmpArray(k) & "<br />")
Next
'when done with the array, release resources to prevent memory leak:
Erase tmpArray

InStr() asp classic form field validation

I'm trying to check for valid email address in a form field using:
if Request ("email") = "" then
bError = true
ElseIf Instr(1, email," ") <> 0 Then
bError = true
ElseIf InStr(1, email, "#", 1) < 2 Then
bError = true
else
*/go to success page*/
But if there is a space in the email address it still passes the validation. So my question is, how do I check for spaces using this method?
You're better off using a regular expression for this.
http://classicasp.aspfaq.com/email/how-do-i-validate-an-e-mail-address.html
Function isEmailValid(email)
Set regEx = New RegExp
regEx.Pattern = "^\w+([-+.]\w+)*#\w+([-.]\w+)*\.\w{2,}$"
isEmailValid = regEx.Test(trim(email))
End Function
Forget about all the elseif stuff do it simple...
Dim strEmail
Dim intErrors
intErrors = 0
strEmail = REQUEST("email")
strEmail = Trim(strEmail)
if strEmail = "" then intErrors = intErrors +1;
if instr(strEmail," ") > 0 then intErrors = intErrors +1;
if instr(strEmail,".") = 0 then intErrors = intErrors +1;
if instr(strEmail,"#") < 2 then intErrors = intErrors +1;
' Put as many test conditions as you want here
if intErrors = 0 then GotoSuccessPage
if Request ("email") = "" or Instr(email," ") > 0 or InStr(email, "#") < 2 then
bError = true
else
'go to success page
'BUT ABOUT OTHER ISSUES?
end if
---------------HERE IS A NON-REGEXP BASED EMAIL CHECKER, NOT SURE IF ITS FOOL PROOF BUT BETTER THAN THE SUBMITTED SNIPPET THAT SHOULD GET YOU GOING...
Function IsEmail(sCheckEmail)
Dim SEmail, NAtLoc
IsEmail = True
SEmail = Trim(sCheckEmail)
NAtLoc = InStr(SEmail, "#")
If Not (nAtLoc > 1 And (InStrRev(sEmail, ".") > NAtLoc + 1)) Then
IsEmail = False
ElseIf InStr(nAtLoc + 1, SEmail, "#") > NAtLoc Then
IsEmail = False
ElseIf Mid(sEmail, NAtLoc + 1, 1) = "." Then
IsEmail = False
ElseIf InStr(1, Right(sEmail, 2), ".") > 0 Then
IsEmail = False
End If
End Function

Resources