i tried something like this, it insert into the database even thought nric is wrong.
So i want it to stop inserting the data into the database when the nric validation is wrong, however from what i do, the result is it still insert the name in....so where should change to allow it stop inserting until user change the value then can continue insert???
Protected Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
register()
End Sub
Protected Sub nricValidate()
Dim strRegex As String = "^([sS]\d{7}[a-zA-Z])$"
Dim myRegex As Regex = New Regex(strRegex)
Dim strNr As String = txtNRIC.Text
Dim nric As String = txtNRIC.Text
If String.IsNullOrEmpty(txtNRIC.Text) Then
ElseIf myRegex.IsMatch(strNr) Then
Dim nricArray() As Char = nric.ToArray
Dim sum As Integer = 0
Dim num As Integer = 0
Dim result As Integer = 0
Dim numbers As Char
Dim no As String = ""
Dim i As Integer = 0
Do While (i < nricArray.Length)
If (i = 1) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 2)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 2) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 7)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 3) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 6)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 4) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 5)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 5) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 4)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 6) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 3)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 7) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 2)
nricArray(i) = Convert.ToChar(num)
End If
i = (i + 1)
Loop
i = 0
Do While (i < nricArray.Length)
If ((i > 0) _
AndAlso (i < 8)) Then
numbers = nricArray(i)
num = Convert.ToInt32(numbers)
sum = (sum + num)
End If
i = (i + 1)
Loop
result = (sum Mod 11)
If (result = 10) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(65)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'A' Nric Error"
End If
ElseIf (result = 9) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(66)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'B' Nric Error"
End If
ElseIf (result = 8) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(67)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'C'Nric Error"
End If
ElseIf (result = 7) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(68)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'D'Nric Error"
End If
ElseIf (result = 6) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(69)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'E'Nric Error"
End If
ElseIf (result = 5) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(70)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'F'Nric Error"
End If
ElseIf (result = 4) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(71)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'G'Nric Error"
End If
ElseIf (result = 3) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(72)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'H'Nric Error"
End If
ElseIf (result = 2) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(73)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'I'Nric Error"
End If
ElseIf (result = 1) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(90)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'Z'Nric Error"
End If
ElseIf (result = 0) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(74)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'J'Nric Error"
End If
End If
Return
Else
ResultLabel.Text = "The NRIC is incorrect!"
txtNRIC.Text = String.Empty
txtNRIC.Focus()
End If
End Sub
Protected Sub register()
Dim myConn As New SqlConnection
Dim myCmd As New SqlCommand
myConn.ConnectionString = ConfigurationManager.ConnectionStrings("Company").ConnectionString
Dim cmd As String
cmd = "Insert into Customer values (#fullName, #nric) "
myCmd.CommandText = cmd
myCmd.CommandType = CommandType.Text
nricValidate()
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myCmd.Connection = myConn
myConn.Open()
myCmd.ExecuteNonQuery()
myCmd.Dispose()
myConn.Dispose()
End Sub
That big loop is entirely unnecessary. There's so much to fix here that I'll do a big rewrite. I turned 216 lines into 41, no problem. It could most likely be made much better, too.
Protected Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
If nricValidate() Then
Using myConn As New SqlConnection(ConfigurationManager.ConnectionStrings("Company").ConnectionString),
myCmd As SqlCommand = myConn.CreateCommand()
myCmd.CommandText = "INSERT INTO Customer VALUES(#fullName, #nric)"
myCmd.CommandType = CommandType.Text
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myConn.Open()
myCmd.ExecuteNonQuery()
End Using
End If
End Sub
Protected Function nricValidate() As Boolean
Dim myRegex As New Regex("^([sS]\d{7}[a-zA-Z])$")
If Not String.IsNullOrEmpty(txtNRIC.Text) AndAlso myRegex.IsMatch(txtNRIC.Text) Then
Dim nricArray(txtNRIC.Text.Length - 1) As Integer
Dim sum As Integer = 0
For i As Integer = 1 To 7
sum += Integer.Parse(txtNRIC.Text.Substring(i, 1)) * If(i = 1, 2, 9 - i)
Next
If nricArray(8) <> 75 - sum Mod 11 Then
txtNRIC.Focus()
ResultLabel.Text = "The last value should be " & (75 - sum Mod 11).ToString() & ": NRIC Error"
Return False
End If
Return True
Else
ResultLabel.Text = "The NRIC is incorrect!"
txtNRIC.Text = String.Empty
txtNRIC.Focus()
End If
Return False
End Function
Your actual answer is - you need to turn nricValidate into a Function, return a success value, and check for success before inserting into the database. But the rest of your code could be heavily optimized too, as you can see.
I do apologize in advance, but that is the worst code I've ever seen in my entire life. Please read up on how to program in general.
change your nricValidate to return true if validation pass
Protected Function nricValidate() As Boolean
'Return True if validation pass
End Function
then you can validate and proceed
If nricValidate() Then
Dim myConn As New SqlConnection
Dim myCmd As New SqlCommand
myConn.ConnectionString = ConfigurationManager.ConnectionStrings("Company").ConnectionString
Dim cmd As String
cmd = "Insert into Customer values (#fullName, #nric) "
myCmd.CommandText = cmd
myCmd.CommandType = CommandType.Text
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myCmd.Connection = myConn
myConn.Open()
myCmd.ExecuteNonQuery()
myCmd.Dispose()
myConn.Dispose()
End If
another way is if ResultLabel has text on validation fail check that before execute database operation.
you have to make a return false on every validation fail. like this:
If (nricArray(8) = Microsoft.VisualBasic.ChrW(65)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'A' Nric Error"
return False
End If
...
return True 'at the end of the function
dont forget to change the sub to function of boolean return type.
Protected function nricValidate() as Boolean
and then inside you register sub
replace nricValidate() with if not nricValidate() then exit sub and make it bfore any declaration so no need to dispose anything ...
Since you are posting the error to the result label, you could use this object within the button submit to detect an error:
If (String.IsNullOrEmpty(ResultLabel.Text)) Then
' valid,continue
End IF
Related
I am creating an ASP.Net website with VB.Net as code behind and this is the error that appears from the published version on a web server (this does not appear when run directly from the code or from the published version on the IIS server):
error message screenshot
This is a snippet from the controller:
Function Index(ByVal pSurveyName As String) As ActionResult
Try
If IsNothing(pSurveyName) Then
Return New HttpStatusCodeResult(HttpStatusCode.BadRequest)
End If
Dim l_question As Object = GetQuestion()
Return View(l_question)
Catch ex As Exception
Call ExceptionHandler(ex)
Return View()
End Try
End Function
Function GetQuestion() As Object
Dim l_questionnaire = Session("ActiveQuestionnaire")
Dim l_surveySession = Session("SurveySession")
Dim l_redirectQueue = Session("RedirectQueue")
Dim l_sessionAnswers = Session("SessionAnswers")
Dim l_CurrentQuestion As CurrentItem = New CurrentItem
Dim l_Choices As List(Of Choice) = New List(Of Choice)
Dim l_TempDBQuestions = db.Questions
Dim l_TempDBChildQuestions = db.ChildQuestions
Dim l_TempDBChoices = db.Choices
Dim l_tempFiltered_Q
Dim li_questionnaireID As Integer
Dim li_questionCtr As Integer
Dim li_total_NoOfQuestion As Integer = 0
Dim li_resultCount As Integer = 0
Dim li_childQID As Integer = 0
Dim ls_prevAnswer As String = ""
Dim ls_err As String = ""
Try
li_questionnaireID = l_questionnaire.ID
li_questionCtr = l_surveySession.QuestionCtr
If Session("Back") = False Then
li_questionCtr = GetQuestionCtr(NEXT_QUESTION, l_surveySession, l_redirectQueue, l_sessionAnswers,, ls_prevAnswer)
Else
Dim l_current = Session("CurrentQuestion")
li_questionCtr = GetQuestionCtr(PREVIOUS_QUESTION, l_surveySession, l_redirectQueue, l_sessionAnswers, l_current, ls_prevAnswer)
End If
l_tempFiltered_Q = l_TempDBQuestions.Where(Function(q) q.QuestionnaireID.Equals(li_questionnaireID) And q.QuestionOrder.Equals(li_questionCtr))
li_resultCount = l_TempDBQuestions.Where(Function(q) q.QuestionnaireID.Equals(li_questionnaireID) And q.QuestionOrder.Equals(li_questionCtr)).Count
If li_resultCount = 0 Then
l_tempFiltered_Q = l_TempDBChildQuestions.Where(Function(q) q.QuestionnaireID.Equals(li_questionnaireID) And q.QuestionOrder.Equals(li_questionCtr))
Session("FrmChildQuestions") = True
Else
Session("FrmChildQuestions") = False
End If
For Each item In l_tempFiltered_Q
'item could be from Questions or ChildQuestions
If li_resultCount = 0 Then
Session("IsNextQuestionChild") = item.IsNextQuestionChild
End If
With l_CurrentQuestion
.ID = item.ID
.QuestionnaireID = item.QuestionnaireID
.QuestionOrder = item.QuestionOrder
.Description = item.Description
.AnswerType = item.AnswerType
.AllowMultipleAnswers = item.AllowMultipleAnswers
.QuestionNo = item.QuestionNo
.Required = item.Required
.TempAnswer = ls_prevAnswer
End With
Next
If l_CurrentQuestion.AnswerType = constants.MULTIPLE_CHOICE Then
'Get Choices
Dim li_questionID As Integer = l_CurrentQuestion.ID
If li_resultCount = 0 Then
l_Choices = db.Choices.SqlQuery("select * from Choices where ChildQuestionID = " & li_questionID & "").ToList
Else
l_Choices = db.Choices.SqlQuery("select * from Choices where QuestionID = " & li_questionID & "").ToList
End If
Session("Choices") = l_Choices
End If
If Session("TotalQuestions") Is Nothing Then
li_total_NoOfQuestion = db.Database.SqlQuery(Of Integer) _
("select max(a.MaxOrder) from(select max(QuestionOrder) " &
"as MaxOrder from Questions union select QuestionOrder from " &
"ChildQuestions)a").FirstOrDefault
Session("TotalQuestions") = li_total_NoOfQuestion
End If
With l_surveySession
.QuestionCtr = li_questionCtr
End With
Session("SurveySession") = l_surveySession
Session("CurrentQuestion") = l_CurrentQuestion
Session("Back") = False
Return l_CurrentQuestion
Catch ex As Exception
Call ExceptionHandler(ex)
End Try
End Function
And this is from the view:
#ModelType Survey_App.Models.CurrentItem
#Code
ViewData("Title") = "Index"
Layout = "~/Views/Shared/_Layout.vbhtml"
Dim l_choices = Session("Choices")
Dim l_activeSurvey = Session("ActiveSurvey")
Dim ls_tempAnsType As String = Model.AnswerType.ToString 'this is the line indicated in the error msg
Dim ls_temp As String = ""
Dim ls_tempAnswer() As String = Nothing
Dim li_totalQuestions As Integer = 0
li_totalQuestions = Session("TotalQuestions")
Dim ls_POSTAction As String = vbNullString
The error appears some time (maybe 10-15 seconds) after going through the home page but not always immediately. I also tried some debugging and it looks like the session variables also return nothing after that some time.
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
I need to perform median calculation in MS Report Builder 3.0, could anyone explain how I could achieve it considering my original value are
Region - Etab- Value
Abc - Def - 10
Abc - Def - 12
Ged - Tae - 1
I need to group by Region and Etab.
I've managed to get the proper values using hashtable the following way :
Dim theHashTable As New System.Collections.Hashtable
Function AddValue(theRapport As String, theRegion As String, theEtab As String, theRow As String, theValue As String) As Integer
Dim num As Integer
num = 0
If (theHashTable Is Nothing) Then
theHashTable = New System.Collections.Hashtable
End If
If Integer.TryParse(theValue, num) Then
If (num >= 0) Then
If (theHashTable.ContainsKey(theRapport)) Then
Dim regionHT As New System.Collections.Hashtable
regionHT = theHashTable(theRapport)
If (regionHT.ContainsKey(theRegion)) Then
Dim etabHT As New System.Collections.Hashtable
etabHT = regionHT(theRegion)
If (etabHT.ContainsKey(theEtab)) Then
Dim valueHT As New System.Collections.Hashtable
valueHT = etabHT(theEtab)
If (Not valueHT.ContainsKey(theRow)) Then
valueHT.Add(theRow, theValue)
End If
etabHT(theEtab) = valueHT
Else
Dim valueHT As New System.Collections.Hashtable
valueHT.Add(theRow, theValue)
etabHT.Add(theEtab, valueHT)
End If
regionHT(theRegion) = etabHT
Else
Dim etabHT As New System.Collections.Hashtable
Dim valueHT As New System.Collections.Hashtable
valueHT.Add(theRow, theValue)
etabHT.Add(theEtab, valueHT)
regionHT.Add(theRegion, etabHT)
End If
theHashTable(theRapport) = regionHT
Else
Dim regionHT As New System.Collections.Hashtable
Dim etabHT As New System.Collections.Hashtable
Dim valueHT As New System.Collections.Hashtable
valueHT.Add(theRow, theValue)
etabHT.Add(theEtab, valueHT)
regionHT.Add(theRegion, etabHT)
theHashTable.Add(theRapport, regionHT)
End If
End If
End If
Return num
End Function
Function GetMedian(theRapport As String, theRegion As String, theEtab As String) As String
Dim arrayInt As New System.Collections.ArrayList
arrayInt = GetArray(theRapport, theRegion, theEtab)
arrayInt.Sort()
Dim mid As Double = (arrayInt.Count - 1) / 2.0
Dim midInt As Integer = mid
Dim mid2Int As Integer = mid + 0.5
If arrayInt.Count >= 2 Then
Return ((arrayInt(midInt) + arrayInt(mid2Int)) / 2).ToString()
ElseIf arrayInt.Count = 1 Then
Return arrayInt(0)
Else
Return ""
End If
End Function
Function GetQ1(theRapport As String, theRegion As String, theEtab As String) As String
Dim arrayInt As New System.Collections.ArrayList
arrayInt = GetArray(theRapport, theRegion, theEtab)
arrayInt.Sort()
Dim taille As Integer = arrayInt.Count
If (taille = 1) Then
Return arrayInt(0)
ElseIf ((taille Mod 2) = 0 And taille > 0) Then
Dim mid1 As Integer = taille / 2
Dim midmid As Integer = mid1 / 2
If (mid1 Mod 2 = 0) Then
Return ((arrayInt(midmid - 1) + arrayInt(midmid)) / 2).ToString()
Else
Return (arrayInt(midmid)).ToString()
End If
ElseIf (taille = 1) Then
Return arrayInt(1)
ElseIf ((taille - 1) Mod 4 = 0) Then
Dim n As Integer = (taille - 1) / 4
Return ((arrayInt(n - 1) * 0.25 + arrayInt(n) * 0.75)).ToString()
ElseIf ((taille - 3) Mod 4 = 0) Then
Dim n As Integer = (taille - 3) / 4
Return ((arrayInt(n) * 0.75 + arrayInt(n + 1) * 0.25)).ToString()
Else
Return ""
End If
End Function
Function GetQ3(theRapport As String, theRegion As String, theEtab As String) As String
Dim arrayInt As New System.Collections.ArrayList
arrayInt = GetArray(theRapport, theRegion, theEtab)
arrayInt.Sort()
Dim taille As Integer = arrayInt.Count
If (taille = 1) Then
Return arrayInt(0)
ElseIf ((taille Mod 2) = 0 And taille > 0) Then
Dim mid1 As Integer = taille / 2
Dim midmid As Integer = mid1 / 2
If (mid1 Mod 2 = 0) Then
Return ((arrayInt(mid1 + midmid - 1) + arrayInt(mid1 + midmid)) / 2).ToString()
Else
Return (arrayInt(mid1 + midmid)).ToString()
End If
ElseIf (taille = 1) Then
Return arrayInt(1)
ElseIf ((taille - 1) Mod 4 = 0) Then
Dim n As Integer = (taille - 1) / 4
Return ((arrayInt(3 * n) * 0.75 + arrayInt(3 * n + 1) * 0.25)).ToString()
ElseIf ((taille - 3) Mod 4 = 0) Then
Dim n As Integer = (taille - 3) / 4
Return ((arrayInt(3 * n + 1) * 0.25 + arrayInt(3 * n + 2) * 0.75)).ToString()
Else
Return ""
End If
End Function
Function GetArray(theRapport As String, theRegion As String, theEtab As String) As System.Collections.ArrayList
Dim arrayInt As New System.Collections.ArrayList
If (theHashTable Is Nothing Or theHashTable.Count = 0) Then
Return arrayInt
Else
If (theHashTable.ContainsKey(theRapport)) Then
Dim regionHT As System.Collections.Hashtable
regionHT = theHashTable(theRapport)
If (theRegion = "" And theEtab = "") Then
For Each value As System.Collections.Hashtable In regionHT.Values
For Each value2 As System.Collections.Hashtable In value.Values
For Each valeur As Integer In value2.Values
arrayInt.Add(valeur)
Next
Next
Next
ElseIf (regionHT.ContainsKey(theRegion) And theEtab = "") Then
Dim etabHT As System.Collections.Hashtable
etabHT = regionHT(theRegion)
For Each value As System.Collections.Hashtable In etabHT.Values
For Each valeur As Integer In value.Values
arrayInt.Add(valeur)
Next
Next
ElseIf (regionHT.ContainsKey(theRegion) And theEtab <> "") Then
Dim etabHT As System.Collections.Hashtable
etabHT = regionHT(theRegion)
If Not (etabHT Is Nothing Or etabHT.Count = 0) Then
If (etabHT.ContainsKey(theEtab)) Then
Dim valuesHT As System.Collections.Hashtable
valuesHT = etabHT(theEtab)
For Each value As Integer In valuesHT.Values
arrayInt.Add(value)
Next
End If
End If
End If
End If
Return arrayInt
End If
End Function
Function PrintArray(theRapport As String, theRegion As String, theEtab As String) As String
Dim arrayInt As New System.Collections.ArrayList
arrayInt = GetArray(theRapport, theRegion, theEtab)
Dim str As String = ""
If (arrayInt.Count > 0) Then
str = String.Join(" | ", arrayInt.ToArray)
Else
str = " "
End If
Return str
End Function
The first hashtable is for different tables of the report needing the median.
I then use the following command to add value
Code.AddValue("3_2",Fields!Region.Value,Fields!Etablissement.Value,Fields!rowNumber.Value,Fields!Value.Value)
Then I get the median using the expressions
=Code.GetMedian("3_2", Fields!Region.Value,Fields!Etablissement.Value)
=Code.GetMedian("3_2", Fields!Region.Value,"")
=Code.GetMedian("3_2", "","")
I've tried placing the AddValue fonction on a hidden table and in the summary row of the tables.
I get the proper value but as soon as I expand or collapse a row everything is change to blank. How can I keep the value or where could I put the AddValue function to make sure it is called on every action, for every table in the report ?
Thanks
I have a shopping cart that using 2d array Cart(3, 20) to store user shop in a session.
It storing data like this:
Cart(0,0) = Product_ID
Cart(1,0) = Product_Name
Cart(2,0) = Product_Price
Cart(3,0) = Product_Qty
I want to count Items based on product_id ( we have not repetitive product_id)
I found a function here:
Function UniqueEntryCount(SourceRange)
Dim MyDataset
Dim dic
Set dic=Server.CreateObject("Scripting.Dictionary")
MyDataset = SourceRange
For i = 1 To UBound(MyDataset, 2)
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
Next
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
But one problem is remain, When my Cart is empty, it show me 1
How can solved it?
An unitialized fixed array (Dim a(i, j)) contains i * j empty elements; your
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
will pick up and count the first empty item. Demonstrated in code:
Dim afCart(3, 4)
Dim dicPID : Set dicPID = countPID00(afCart)
Dim aKeys : aKeys = dicPID.Keys
Dim vKey : vKey = aKeys(0)
WScript.Echo "A", dicPID.Count, TypeName(vKey)
Set dicPID = countPID(afCart)
WScript.Echo "B", dicPID.Count
afCart(0, 0) = "ignored"
afCart(0, 1) = 4711
afCart(0, 2) = 4712
afCart(0, 3) = 4711
' afCart(0, 4) = "not initialized/Empty"
Set dicPID = countPID(afCart)
WScript.Echo "C"
For Each vKey In dicPID.Keys
WScript.Echo "", vKey, "=", dicPID(vKey)
Next
Function countPID00(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim MyDataset : MyDataset = afCart ' waste of ressources
Dim iRow
For iRow = 1 To UBound(MyDataset, 2)
If Not dicRVal.Exists(MyDataset(0, iRow)) Then
dicRVal(MyDataset(0, iRow)) = "" ' loss of info; will pick up Empty item
End If
Next
Set countPID00 = dicRVal
End Function ' countPID00
Function countPID(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim iRow
For iRow = 1 To UBound(afCart, 2)
If Not IsEmpty(afCart(0, iRow)) Then
dicRVal(afCart(0, iRow)) = dicRVal(afCart(0, iRow)) + 1
End If
Next
Set countPID = dicRVal
End Function ' countPID
output:
A 1 Empty
B 0
C
4711 = 2
4712 = 1
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