Classic ASP code migration - asp.net
I am trying to migrate some code from Classic ASP/VBScript.
This code shown below generates a barcode. As it is known, some functions do not exist or are entirely different in .NET. So I figured I would thrown the old code, in the code-behind of my barcode.aspx page (as I call the barcode generation sequence like this:
<img src="/barcode.aspx?code="<%: getID(sheet_id)%>" border="0" height="80"/>
This is the Classic code:
<%
Option Explicit
Response.CodePage = 1252
Response.CharSet = "windows-1252"
Response.Contenttype = "image/bmp"
' code = bar code value
' height = height of barcode in pixels.
' width = width MULTIPLIER in pixels.
' mode = type of barcode (Currently supported barcode types: code39, code128b, UPC-A, EAN-13)
'
dim code, origcode, height, width, mode, caching, FontKey, FontCN10, FontCN12
caching = False ' turn this on to cache barcodes in '10101010' format. Might speed things up on busy servers, although this script doesn't take many resources to begin with. An EAN-13 or UPC barcode will take less than 100 bytes of memory space. Other types will take more or less depending on the length of the barcode created.
' DO NOT EDIT BELOW THIS LINE!
code = Request.QueryString("code")
height = 80 'request.querystring("height")
width = 2 'request.querystring("width")
mode = "code39" 'request.querystring("mode")
origcode = code
if not IsNumeric(height) or height = "" then height = 1 else height = numeric(height)
if not IsNumeric(width) or width = "" then width = 1 else width = numeric(width)
if caching AND application("cache" & origcode & mode & height & width) <> "" then
code = application("cache" & origcode & mode & height & width)
else
select case lcase(mode)
case "raw" ' do nothing. non-0 chars are automatically 1s
case "code39": code = code39(code)
case "code128b": code = code128b(code)
case "upc-a": code = codeean13("0" & code, "AAAAAA")
case "ean-13": code = codeean13(code, eanflag(left(code, 1)))
end select
if caching then
Application.Lock
Application("cache" & origcode & mode & height & width) = code
Application.UnLock
end if
end if
Function stb(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
stb = B
End Function
function tstr(data, width)
dim tchar, total, tpos, i, j, x
tchar = 0
total = ""
tpos = 8
for i = 1 to len(data)
for j = 1 to width
tpos = tpos - 1
if mid(data, i, 1) <> "0" then tchar = tchar + 2^tpos
if tpos = 0 then
total = total & chr(tchar)
tpos = 8
tchar = 0
end if
next
next
if tpos <> 8 then
total = total & chr(tchar)
end if
x = len(total) mod 4
if x = 0 then x = 4
for i = x to 3
total = total & chr(0)
next
tstr = total
end function
function numeric(num)
dim numb, valid, i
numb = ""
valid = "0123456789"
for i = 1 to len(num)
if InStr(valid, mid(num, i, 1)) > 0 then numb = numb & mid(num, i, 1)
next
num = left(num, 30)
numeric = cint(num)
end function
function size(lngth)
lngth = cdbl(lngth)
if lngth > 255 then
if lngth > 65535 then lngth = 65535
size = chr(lngth mod 256) & chr(int(lngth/256))
else
size = chr(lngth) & chr(0)
end if
end function
function code39(code)
dim output, i, clet
output = ""
code = "*" & replace(code, "*", "") & "*"
for i = 1 to len(code)
clet = ""
select case ucase(mid(code, i, 1))
case "1": clet = "111010001010111"
case "2": clet = "101110001010111"
case "3": clet = "111011100010101"
case "4": clet = "101000111010111"
case "5": clet = "111010001110101"
case "6": clet = "101110001110101"
case "7": clet = "101000101110111"
case "8": clet = "111010001011101"
case "9": clet = "101110001011101"
case "0": clet = "101000111011101"
case "A": clet = "111010100010111"
case "B": clet = "101110100010111"
case "C": clet = "111011101000101"
case "D": clet = "101011100010111"
case "E": clet = "111010111000101"
case "F": clet = "101110111000101"
case "G": clet = "101010001110111"
case "H": clet = "111010100011101"
case "I": clet = "101110100011101"
case "J": clet = "101011100011101"
case "K": clet = "111010101000111"
case "L": clet = "101110101000111"
case "M": clet = "111011101010001"
case "N": clet = "101011101000111"
case "O": clet = "111010111010001"
case "P": clet = "101110111010001"
case "Q": clet = "101010111000111"
case "R": clet = "111010101110001"
case "S": clet = "101110101110001"
case "T": clet = "101011101110001"
case "U": clet = "111000101010111"
case "V": clet = "100011101010111"
case "W": clet = "111000111010101"
case "X": clet = "100010111010111"
case "Y": clet = "111000101110101"
case "Z": clet = "100011101110101"
case "-": clet = "100010101110111"
case ".": clet = "111000101011101"
case " ": clet = "100011101011101"
case "*": clet = "100010111011101"
case "$": clet = "100010001000101"
case "/": clet = "100010001010001"
case "+": clet = "100010100010001"
case "%": clet = "101000100010001"
end select
output = output & clet & "0"
next
code39 = left(output, len(output)-1)
end function
Function code128b(ByVal InputString)
Const MinValidAscii = 32
Const MaxValidAscii = 126
Dim CharValue(255)
Dim i
for i = 0 to 94
CharValue(i+32) = i
next
for i = 95 to 106
CharValue(i+100) = i
next
' Encode the input string
InputString = Trim(InputString)
Dim CheckDigitValue, CharPos, CharAscii, InvalidCharsFound
InvalidCharsFound = false
CheckDigitValue = CharValue(204)
For CharPos = 1 To Len(InputString)
CharAscii = Asc(Mid(InputString, CharPos, 1))
if (CharAscii < MinValidAscii) OR (CharAscii > MaxValidAscii) then
CharAscii = Asc("?")
InvalidCharsFound = true
end if
CheckDigitValue = CheckDigitValue + (CharValue(CharAscii) * CharPos)
Next
CheckDigitValue = (CheckDigitValue Mod 103)
Dim CheckDigitAscii
if CheckDigitValue < 95 then
CheckDigitAscii = CheckDigitValue + 32
else
CheckDigitAscii = CheckDigitValue + 100
end if
Dim OutputString
OutputString = Chr(204) & InputString & Chr(CheckDigitAscii) & Chr(206)
Dim BarcodePattern(255)
BarcodePattern(32) = "212222" ' <SPACE>
BarcodePattern(33) = "222122" ' !
BarcodePattern(34) = "222221" ' "
BarcodePattern(35) = "121223" ' #
BarcodePattern(36) = "121322" ' $
BarcodePattern(37) = "131222" ' %
BarcodePattern(38) = "122213" ' &
BarcodePattern(39) = "122312" ' '
BarcodePattern(40) = "132212" ' (
BarcodePattern(41) = "221213" ' )
BarcodePattern(42) = "221312" ' *
BarcodePattern(43) = "231212" ' +
BarcodePattern(44) = "112232" ' ,
BarcodePattern(45) = "122132" ' -
BarcodePattern(46) = "122231" ' .
BarcodePattern(47) = "113222" ' /
BarcodePattern(48) = "123122" ' 0
BarcodePattern(49) = "123221" ' 1
BarcodePattern(50) = "223211" ' 2
BarcodePattern(51) = "221132" ' 3
BarcodePattern(52) = "221231" ' 4
BarcodePattern(53) = "213212" ' 5
BarcodePattern(54) = "223112" ' 6
BarcodePattern(55) = "312131" ' 7
BarcodePattern(56) = "311222" ' 8
BarcodePattern(57) = "321122" ' 9
BarcodePattern(58) = "321221" ' :
BarcodePattern(59) = "312212" ' ;
BarcodePattern(60) = "322112" ' <
BarcodePattern(61) = "322211" ' =
BarcodePattern(62) = "212123" ' >
BarcodePattern(63) = "212321" ' ?
BarcodePattern(64) = "232121" ' #
BarcodePattern(65) = "111323" ' A
BarcodePattern(66) = "131123" ' B
BarcodePattern(67) = "131321" ' C
BarcodePattern(68) = "112313" ' D
BarcodePattern(69) = "132113" ' E
BarcodePattern(70) = "132311" ' F
BarcodePattern(71) = "211313" ' G
BarcodePattern(72) = "231113" ' H
BarcodePattern(73) = "231311" ' I
BarcodePattern(74) = "112133" ' J
BarcodePattern(75) = "112331" ' K
BarcodePattern(76) = "132131" ' L
BarcodePattern(77) = "113123" ' M
BarcodePattern(78) = "113321" ' N
BarcodePattern(79) = "133121" ' O
BarcodePattern(80) = "313121" ' P
BarcodePattern(81) = "211331" ' Q
BarcodePattern(82) = "231131" ' R
BarcodePattern(83) = "213113" ' S
BarcodePattern(84) = "213311" ' T
BarcodePattern(85) = "213131" ' U
BarcodePattern(86) = "311123" ' V
BarcodePattern(87) = "311321" ' W
BarcodePattern(88) = "331121" ' X
BarcodePattern(89) = "312113" ' Y
BarcodePattern(90) = "312311" ' Z
BarcodePattern(91) = "332111" ' [
BarcodePattern(92) = "314111" ' /
BarcodePattern(93) = "221411" ' ]
BarcodePattern(94) = "431111" ' ^
BarcodePattern(95) = "111224" ' _
BarcodePattern(96) = "111422" ' `
BarcodePattern(97) = "121124" ' a
BarcodePattern(98) = "121421" ' b
BarcodePattern(99) = "141122" ' c
BarcodePattern(100) = "141221" ' d
BarcodePattern(101) = "112214" ' e
BarcodePattern(102) = "112412" ' f
BarcodePattern(103) = "122114" ' g
BarcodePattern(104) = "122411" ' h
BarcodePattern(105) = "142112" ' i
BarcodePattern(106) = "142211" ' j
BarcodePattern(107) = "241211" ' k
BarcodePattern(108) = "221114" ' l
BarcodePattern(109) = "413111" ' m
BarcodePattern(110) = "241112" ' n
BarcodePattern(111) = "134111" ' o
BarcodePattern(112) = "111242" ' p
BarcodePattern(113) = "121142" ' q
BarcodePattern(114) = "121241" ' r
BarcodePattern(115) = "114212" ' s
BarcodePattern(116) = "124112" ' t
BarcodePattern(117) = "124211" ' u
BarcodePattern(118) = "411212" ' v
BarcodePattern(119) = "421112" ' w
BarcodePattern(120) = "421211" ' x
BarcodePattern(121) = "212141" ' y
BarcodePattern(122) = "214121" ' z
BarcodePattern(123) = "412121" ' {
BarcodePattern(124) = "111143" ' |
BarcodePattern(125) = "111341" ' }
BarcodePattern(126) = "131141" ' ~
BarcodePattern(195) = "114113"
BarcodePattern(196) = "114311"
BarcodePattern(197) = "411113"
BarcodePattern(198) = "411311"
BarcodePattern(199) = "113141"
BarcodePattern(200) = "114131"
BarcodePattern(201) = "311141"
BarcodePattern(202) = "411131"
BarcodePattern(203) = "211412"
BarcodePattern(204) = "211214"
BarcodePattern(205) = "211232"
BarcodePattern(206) = "2331112"
Dim OutputPattern, ThisPattern, thischar
OutputPattern = ""
for CharPos = 1 to Len(OutputString)
ThisPattern = BarcodePattern(Asc(Mid(OutputString, CharPos, 1)))
for i = 1 to len(ThisPattern)
if i mod 2 = 1 then thischar = "1" else thischar = "0"
OutputPattern = OutputPattern & replace(space(int(mid(ThisPattern, i, 1))), " ", thischar)
next
next
code128b = OutputPattern
End Function
Function CodeEAN13(code, encoding)
Dim leftA, leftB, rght, OutputPattern, i
if len(code) = 13 then
LeftA = Array("0001101", "0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011")
LeftB = Array("0100111", "0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111")
Rght = Array("1110010", "1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100")
OutputPattern = "101"
for i = 1 to 6
if mid(ucase(encoding), i, 1) = "A" then
OutputPattern = OutputPattern & LeftA(cint(mid(code, i+1, 1)))
else
OutputPattern = OutputPattern & LeftB(cint(mid(code, i+1, 1)))
end if
next
OutputPattern = OutputPattern & "01010"
for i = 1 to 6
OutputPattern = OutputPattern & Rght(cint(mid(code, i+7, 1)))
next
OutputPattern = OutputPattern & "101"
CodeEAN13 = OutputPattern
end if
End Function
Function eanflag(num)
select case num
case 0: eanflag = "AAAAAA"
case 1: eanflag = "AABABB"
case 2: eanflag = "AABBAB"
case 3: eanflag = "AABBBA"
case 4: eanflag = "ABAABB"
case 5: eanflag = "ABBAAB"
case 6: eanflag = "ABBBAA"
case 7: eanflag = "ABABAB"
case 8: eanflag = "ABABBA"
case 9: eanflag = "ABBABA"
end select
End Function
dim dataout, i
if code <> "" then
dataout = tstr(code, width)
response.binarywrite stb(chr(66) & chr(77) & size(62+(len(dataout)*height)) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(62) & chr(0) & chr(0) & chr(0) & chr(40) & chr(0) & chr(0) & chr(0) & size(len(code)*width) & chr(0) & chr(0) & size(height) & chr(0) & chr(0) & chr(1) & chr(0) & chr(1) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(37) & chr(14) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0) & chr(255) & chr(255) & chr(255) & chr(0) & chr(0) & chr(0) & chr(0) & chr(0))
for i = 1 to height
response.binarywrite stb(dataout)
next
end if
%>
The stuff the are "problematic" (based on VS underlining) are:
For I = 1 To Len(text)
B = B & ChrB(Asc(Mid(text, I, 1)))
Next
and Array in CodeEAN13 function, which I completely commented out since I am using Code39
I put this piece of code on code-behind of barcode.aspx's page load:
Response.Charset = "windows-1252"
Response.ContentType = "image/bmp"
Dim code, origcode, height, width, mode, caching, FontKey, FontCN10, FontCN12
caching = False ' turn this on to cache barcodes in '10101010' format. Might speed things up on busy servers, although this script doesn't take many resources to begin with. An EAN-13 or UPC barcode will take less than 100 bytes of memory space. Other types will take more or less depending on the length of the barcode created.
' DO NOT EDIT BELOW THIS LINE!
code = Request.QueryString("code")
height = 80 'request.querystring("height")
width = 2 'request.querystring("width")
mode = "code39" 'request.querystring("mode")
origcode = code
If Not IsNumeric(height) Or height = "" Then height = 1 Else height = numeric(height)
If Not IsNumeric(width) Or width = "" Then width = 1 Else width = numeric(width)
If caching And Application("cache" & origcode & mode & height & width) <> "" Then
code = Application("cache" & origcode & mode & height & width)
Else
Select Case LCase(mode)
Case "raw" ' do nothing. non-0 chars are automatically 1s
Case "code39" : code = code39(code)
Case "code128b" : code = code128b(code)
'Case "upc-a" : code = codeean13("0" & code, "AAAAAA")
'Case "ean-13" : code = codeean13(code, eanflag(Left(code, 1)))
End Select
If caching Then
Application.Lock()
Application("cache" & origcode & mode & height & width) = code
Application.UnLock()
End If
End If
If code <> "" Then
dataout = tstr(code, width)
Response.BinaryWrite(stb(Chr(66) & Chr(77) & size(62 + (Len(dataout) * height)) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(62) & Chr(0) & Chr(0) & Chr(0) & Chr(40) & Chr(0) & Chr(0) & Chr(0) & size(Len(code) * width) & Chr(0) & Chr(0) & size(height) & Chr(0) & Chr(0) & Chr(1) & Chr(0) & Chr(1) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(37) & Chr(14) & Chr(0) & Chr(0) & Chr(37) & Chr(14) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(255) & Chr(255) & Chr(255) & Chr(0) & Chr(0) & Chr(0) & Chr(0) & Chr(0)))
For i = 1 To height
Response.BinaryWrite(stb(dataout))
Next
End If
Also, I tried changing
Function stb(text)
Dim I, B
For I = 1 To Len(text)
B = B & ChrB(Asc(Mid(text, I, 1)))
Next
stb = B
End Function
to
Function stb(text)
Dim I, B
For I = 1 To Len(text)
B = B & Convert.ToChar(Asc(Mid(text, I, 1)))
Next
stb = B
End Function
Well, needless to say, it does not work :)
So, after several hours of sweating and beating myself, I have used another solution.I will post it here for anyone that might have similar problems.
What I did was basically using the Barcode Rendering Framework
As no clear documentation exists for this library, I will explain the procedure below:
Download the library from the link above.
Add a reference to your project, browsing to Zen.Barcode.Core.dll
Import zen.barcode in your code-behind
The rest is in my code :)
Dim sheet_id As String = Session("generated_id")
Dim height As Integer = 80
Dim width As Integer = 80
'Dim mode As String = "code39"
Dim bar As Code39BarcodeDraw = BarcodeDrawFactory.Code39WithoutChecksum
Dim img As Image = bar.Draw(sheet_id, height, width)
Dim bmp As Bitmap = img
Dim stream As New System.IO.MemoryStream
bmp.Save(stream, Imaging.ImageFormat.Bmp)
stream.Position = 0
Dim size As Integer = stream.Length
Dim data(stream.Length) As Byte
stream.Read(data, 0, stream.Length)
Response.BinaryWrite(data)
The call is being made on the landing page's body like so:
<img src="/barcode.aspx" border="0" height="80" width="250"/>
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
Pad the month with '0'
This is my code: If FinalMonth = "" OR FinalYear = "" Then FinalMonth = Month(Now()) FinalYear = Year(Now()) End If Select Case(FinalMonth) Case "01","03","05","07","08","10","12" FinalDay = "31" Case "04","06","09","11" FinalDay = "30" Case "02" If ( (FinalYear Mod 4) <> 0 ) Then FinalDay = "28" Else FinalDay = "29" End If End Select I want to set my month with 0 before the number 1 (January) per example, and finally Month 01. How can I do it please?
You can; If FinalMonth = "" OR FinalYear = "" Then FinalMonth = Month(Now()) FinalYear = Year(Now()) End If 'get last day of month - add 1 month then deduct 1 day FinalDay = Day(DateSerial(FinalYear, FinalMonth + 1, 1) - 1) 'pad month if (FinalMonth < 10) then FinalMonth = "0" & FinalMonth
what about this ? <%=Right("0" & Day(now()), 2)%>-<%=Right("0" & Month(now()), 2)%>-<%=Year(now())%> Output : 10-02-2018
counting shopping cart 2d Array items in asp-classic
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
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
how can to stop the inserting when the validation is wrong for textbox?
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