How to check if radiobutton in a row is unchecked - asp.net

Private Sub Arr(ByVal arrRad() As RadioButton, ByVal arrLbl() As Label)
Dim result As Integer = 0
Dim temp As Integer = 0
'arrRad is my control array Radiobutton, arrLbl is my control array Label
'I have 15 Radiobutton and 3 Label
For i As Integer = 0 To arrRad.Length - 1 Step 5
If arrRad(i).Checked = True Then
temp = arrRad(i).Text.Substring(0, 1)
ElseIf arrRad(i + 1).Checked = True Then
temp = arrRad(i + 1).Text.Substring(0, 1)
ElseIf arrRad(i + 2).Checked = True Then
temp = arrRad(i + 2).Text.Substring(0, 1)
ElseIf arrRad(i + 3).Checked = True Then
temp = arrRad(i + 3).Text.Substring(0, 1)
ElseIf arrRad(i + 4).Checked = True Then
temp = arrRad(i + 4).Text.Substring(0, 1)
Else
temp = 0
End If
result += temp
Next
txtKetQua.Text = result.ToString()
End Sub
I want to show lblError if that row radiobutton is unchecked, but I don't know how to show it
P/s: Sorry for my bad English

You can do it in a very shorter way using LInQ Extension .Any():
lblError.Visible = Not arrRad.Any(Function(rb) rb.Ckecked)

Related

Argument 'expression' cannot be converted to type 'DBNull'

I have an app by vb for taking a list of doneators in Dvg and have about 17 forum and local mssql db and using if not is dbnull expression and by pressing the button some calculation happened and the answer appears in labels on the fourm.. But A strange problem happened when I run this app by the visual studio 2017 it run perfectly and there is no error.. But when converting it to exe file and setup it the following error appear when pressing this button " Argument 'expression' cannot be converted to type 'DBNull'
" although it's not appear when run it with visual studio.. What could the problem be..?
here is the code but i don't think the problem in it because it works fine in visual studio
its long code so i will put a part of it and the rest is repeated for 12 months and 10 yearsthis is pic of the error
If Form1.ComboBox1.Text = "2018" Then
' total kfalat
If TextBox1.Text = "1" Then
Form5.total.Text = Form1.Table1DataGridView.Rows.Count - 1
Dim HoN As Integer = 0
' total done
For Each gvRow As DataGridViewRow In Form2.TableDataGridView.Rows
If Not IsDBNull(gvRow.Cells(13).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(13).Value) AndAlso Val(gvRow.Cells(13).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(1).Value) Then
Dim strNgheo As String = gvRow.Cells(1).Value
If strNgheo = "1" Then
HoN = HoN + 1
End If
End If
End If
End If
Next
Form5.done.Text = HoN.ToString
'undone
Form5.notdone.Text = Val(Form5.total.Text) - Val(Form5.done.Text)
'asbab 3adam alta7seel
'lm yarod
Dim HoN11 As Integer = 0
For Each gvRow As DataGridViewRow In Form2.TableDataGridView.Rows
If Not IsDBNull(gvRow.Cells(13).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(13).Value) AndAlso Val(gvRow.Cells(13).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(1).Value) Then
Dim strNgheo As String = gvRow.Cells(1).Value
If strNgheo = "لم يرد" Then
HoN11 = HoN11 + 1
End If
End If
End If
End If
Next
Form5.Label69.Text = HoN11.ToString
'lmo2agal
Dim HoN12 As Integer = 0
For Each gvRow As DataGridViewRow In Form2.TableDataGridView.Rows
If Not IsDBNull(gvRow.Cells(13).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(13).Value) AndAlso Val(gvRow.Cells(13).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(1).Value) Then
Dim strNgheo As String = gvRow.Cells(1).Value
If strNgheo = "مؤجل" Then
HoN12 = HoN12 + 1
End If
End If
End If
End If
Next
Form5.Label67.Text = HoN12.ToString
'سيحضر
Dim HoN13 As Integer = 0
For Each gvRow As DataGridViewRow In Form2.TableDataGridView.Rows
If Not IsDBNull(gvRow.Cells(13).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(13).Value) AndAlso Val(gvRow.Cells(13).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(1).Value) Then
Dim strNgheo As String = gvRow.Cells(1).Value
If strNgheo = "سيحضر " Then
HoN13 = HoN13 + 1
End If
End If
End If
End If
Next
Form5.Label65.Text = HoN13.ToString
Dim HoN10 As Integer = 0
Dim money As Integer = 0
' astmarat gdeda
For Each gvRow As DataGridViewRow In Form1.Table1DataGridView.Rows
If Not IsDBNull(gvRow.Cells(8).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(8).Value) AndAlso Val(gvRow.Cells(8).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(15).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(15).Value > 0 Then
HoN10 = HoN10 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
money = money + Val(gvRow.Cells(15).Value)
End If
End If
End If
End If
Next
Form5.Label59.Text = HoN10.ToString
Form5.Label58.Text = money.ToString
Dim orphensmoney1 As Integer = 0
Dim HoN1 As Integer = 0
Dim familiesmoney1 As Integer = 0
Dim HoN2 As Integer = 0
Dim sicksmoney1 As Integer = 0
Dim HoN3 As Integer = 0
Dim studentsmoney1 As Integer = 0
Dim HoN4 As Integer = 0
' alkafalat almotwagda belf3l
For Each gvRow As DataGridViewRow In Form1.Table1DataGridView.Rows
If Not IsDBNull(gvRow.Cells(19).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(19).Value = True Then
HoN1 = HoN1 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
orphensmoney1 = orphensmoney1 + Val(gvRow.Cells(23).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(20).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(20).Value = True Then
HoN2 = HoN2 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
familiesmoney1 = familiesmoney1 + Val(gvRow.Cells(24).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(21).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(21).Value = True Then
HoN3 = HoN3 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
sicksmoney1 = sicksmoney1 + Val(gvRow.Cells(25).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(22).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(22).Value = True Then
HoN4 = HoN4 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
studentsmoney1 = studentsmoney1 + Val(gvRow.Cells(26).Value)
End If
End If
Next
Form5.Label11.Text = HoN1.ToString
Form5.Label10.Text = orphensmoney1.ToString
Form5.Label14.Text = HoN2.ToString
Form5.Label13.Text = familiesmoney1.ToString
Form5.Label17.Text = HoN3.ToString
Form5.Label16.Text = sicksmoney1.ToString
Form5.Label20.Text = HoN4.ToString
Form5.Label19.Text = studentsmoney1.ToString
Form5.Label8.Text = (Val(HoN1) + Val(HoN2) + Val(HoN3) + Val(HoN4)).ToString
Form5.Label9.Text = (Val(orphensmoney1) + Val(familiesmoney1) + Val(sicksmoney1) + Val(studentsmoney1)).ToString
Dim HoN5 As Integer = 0
Dim ORPHENS As Integer = 0
Dim HoN6 As Integer = 0
Dim families As Integer = 0
Dim HoN7 As Integer = 0
Dim sicks As Integer = 0
Dim HoN8 As Integer = 0
Dim students As Integer = 0
' almo7asal fe kol band
For Each gvRow As DataGridViewRow In Form2.TableDataGridView.Rows
If Not IsDBNull(gvRow.Cells(13).Value) Then
If Val(Me.TextBox2.Text) <= Val(gvRow.Cells(13).Value) AndAlso Val(gvRow.Cells(13).Value) <= Val(Me.TextBox3.Text) Then
If Not IsDBNull(gvRow.Cells(14).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(14).Value > 0 Then
HoN5 = HoN5 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
ORPHENS = ORPHENS + Val(gvRow.Cells(14).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(16).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(16).Value > 0 Then
HoN6 = HoN6 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
families = families + Val(gvRow.Cells(16).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(18).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(18).Value > 0 Then
HoN7 = HoN7 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
sicks = sicks + Val(gvRow.Cells(18).Value)
End If
End If
If Not IsDBNull(gvRow.Cells(20).Value) Then
'Dim strNgheo As Integer = gvRow.Cells(19).Value
' If strNgheo = (gvRow.Cells(19).Value = True) Then
If gvRow.Cells(20).Value > 0 Then
HoN8 = HoN8 + 1
' ElseIf gvRow.Cells(19).Value = False Then
' End
students = students + Val(gvRow.Cells(20).Value)
End If
End If
End If
End If
Next
Form5.Label32.Text = HoN5.ToString
Form5.Label31.Text = ORPHENS.ToString
Form5.Label29.Text = HoN6.ToString
Form5.Label28.Text = families.ToString
Form5.Label26.Text = HoN7.ToString
Form5.Label25.Text = sicks.ToString
Form5.Label23.Text = HoN8.ToString
Form5.Label22.Text = students.ToString
Form5.Label35.Text = Val(HoN8.ToString) + Val(HoN7.ToString) + Val(HoN6.ToString) + Val(HoN5.ToString)
Form5.Label34.Text = Val(ORPHENS.ToString) + Val(families.ToString) + Val(sicks.ToString) + Val(students.ToString)
Form5.Label53.Text = Val(Form5.Label8.Text) - Val(Form5.Label35.Text)
Form5.Label52.Text = Val(Form5.Label9.Text) - Val(Form5.Label34.Text)
Form5.Label50.Text = Val(Form5.Label11.Text) - Val(Form5.Label32.Text)
Form5.Label49.Text = Val(Form5.Label10.Text) - Val(Form5.Label31.Text)
Form5.Label47.Text = Val(Form5.Label14.Text) - Val(Form5.Label29.Text)
Form5.Label46.Text = Val(Form5.Label13.Text) - Val(Form5.Label28.Text)
Form5.Label44.Text = Val(Form5.Label17.Text) - Val(Form5.Label26.Text)
Form5.Label43.Text = Val(Form5.Label16.Text) - Val(Form5.Label25.Text)
Form5.Label41.Text = Val(Form5.Label20.Text) - Val(Form5.Label23.Text)
Form5.Label40.Text = Val(Form5.Label19.Text) - Val(Form5.Label22.Text)
End If

How to validate Google Recaptcha 2.0 server side in ASP Classic?

I need help to implement the answer Google Recaptcha 2.0.
I've tried a few ways to recover the response after sending the form but not consigui get the answer True.
Follows the example I'm trying:
<%#LANGUAGE=VBSCRIPT%>
<%
Option Explicit
%>
<html>
<head>
<script src="https://www.google.com/recaptcha/api.js" async defer></script>
</head>
<body>
<%
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Dim recaptcha_secret, sendstring, objXML
' Secret key
recaptcha_secret = "xxxxxxxxxxsec"
sendstring = "https://www.google.com/recaptcha/api/siteverify?secret=" & recaptcha_secret & "&response=" & Request.form("g-recaptcha-response")
Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "GET", sendstring, False
objXML.Send
Response.write "<br><h3>Response: " & objXML.responseText & "</h3><br>"
Set objXML = Nothing
END If
%>
<form method="post" action="">
<!-- Site key -->
<div class="g-recaptcha" data-sitekey="xxxxxxxxxx"></div>
<br />
<input type="submit" value="Try">
</form>
</body>
</html>
How do I implement a way to check that Recaptcha were marked?
finally found it after so many search i found it
first i use this asp class https://github.com/zhennanzhuce/js/blob/master/js/ueditor/1.4.3/asp/ASPJson.class.asp
then to validate the response i use this
result = (objXML.responseText)
Set oJSON = New aspJSON
oJSON.loadJSON(result)
Set objXML = Nothing
success = oJSON.data("success")
if success = "True" then
action = "go to next page"
else
action = ""
end if
now the used code is :
<%#LANGUAGE=VBSCRIPT%>
<%
Option Explicit
%>
<html>
<head>
<script src="https://www.google.com/recaptcha/api.js" async defer></script>
</head>
<body>
<!-- #include file="aspJSON.asp"-->
<%
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Dim recaptcha_secret, sendstring, objXML
' Secret key
recaptcha_secret = "XXXCCCXXXX"
sendstring = "https://www.google.com/recaptcha/api/siteverify?onload=onloadCallback&render=explicit&secret=" & recaptcha_secret & "&response=" & Request.form("g-recaptcha-response")
Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "GET", sendstring, False
objXML.Send
dim result, oJSON, success, action, errorCapatcha, errorMsg
result = (objXML.responseText)
Set oJSON = New aspJSON
oJSON.loadJSON(result)
Set objXML = Nothing
success = oJSON.data("success")
if success = "True" then
action = "go to next page"
else
action = "do nothing"
end if
END If
%>
<form method="post" action="">
<!-- Site key -->
<div class="g-recaptcha" data-sitekey="XXXXXXXXX"></div>
<br />
<input type="submit" value="Try">
</form>
</body>
Many Thanks to Lankymart, Leonardo Duarte
First download json.asp https://github.com/tugrul/aspjson
insert in page
<script language="javascript" runat="server" src="json2.asp"></script>
in return do so
If success(objXML.responseText) = True Then
Response.write "success"
Elseif success(objXML.responseText) = False Then
Response.write "failure"
End If
call the function to get the json
Function success(result)
Set motor = JSON.parse(result)
success = motor.success
Set motor = Nothing
End Function
There is a better way and stand alone captcha for ASP instead google captcha. You don't need to add JSON function.
Here is the code:
On your submit page, add:
Type the number bellow:<br>
<input type=text name="captchacode" value="" size=5 maxlength=5><br/>
<img id="imgCaptcha" src="captcha.asp" /><br />
Refresh<br/>
<script language="Javascript">
function RefreshImage(valImageId) {
var objImage = document.images[valImageId];
if (objImage == undefined) {
return;
}
var now = new Date();
objImage.src = objImage.src.split('?')[0] + '?x=' + now.toUTCString();
}
</script>
Insert the function bellow to your asp file:
'*******************************************************
function TestCaptcha(byval valSession, byval valCaptcha)
'*******************************************************
dim tmpSession
valSession = Trim(valSession)
valCaptcha = Trim(valCaptcha)
if (valSession = vbNullString) or (valCaptcha = vbNullString) then
TestCaptcha = false
else
tmpSession = valSession
valSession = Trim(Session(valSession))
Session(tmpSession) = vbNullString
if valSession = vbNullString then
TestCaptcha = false
else
valCaptcha = Replace(valCaptcha,"i","I")
if StrComp(valSession,valCaptcha,1) = 0 then
TestCaptcha = true
else
TestCaptcha = false
end if
end if
end if
end function
Save the code bellow to captcha.asp:
<%#LANGUAGE="VBSCRIPT"%>
<%
'ASP Security Image Generator v4.0 - 13/July/2008
'Generate images to make a CAPTCHA test
'© 2006-2007 Emir Tüzül. All rights reserved.
'http://www.tipstricks.org
'This program is free software; you can redistribute it and/or
'modify it under the terms of the Common Public License
'as published by the Open Source Initiative OSI; either version 1.0
'of the License, or any later version.
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'Common Public License for more details.
'*[null pixel]Numbers[repeat count], #[text]Numbers[repeat count], &[row reference]number[referenced row index]
'First row [font height, chars...]
'Following rows [char width, pixel maps...]
FontMap = Array(_
split("13,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9",",") ,_
split("14,*5#4*5,*4#6*4,&2,&2,*3#3*2#3*3,&5,*2#4*2#4*2,*2#3*4#3*2,*2#10*2,*1#12*1,*1#3*6#3*1,&11,#3*8#3",",") ,_
split("11,#8*3,#10*1,#3*4#3*1,&3,&3,&1,&2,#3*4#4,#3*5#3,&9,&8,&2,#9*2",",") ,_
split("11,*4#6*1,*2#9,*1#4*4#2,*1#3*6#1,#3*8,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
split("12,#8*4,#10*2,#3*4#4*1,#3*5#3*1,#3*6#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
split("9,#9,&1,#3*6,&3,&3,#8*1,&6,&3,&3,&3,&3,&1,&1",",") ,_
split("9,#9,&1,#3*6,&3,&3,&1,&1,&3,&3,&3,&3,&3,&3",",") ,_
split("13,*4#7,*2#11,*1#4*5#3,*1#3*8#1,#3,#3,#3*4#6,&7,#3*7#3,*1#3*6#3,*1#5*4#3,&2,&1",",") ,_
split("11,#3*5#3,&1,&1,&1,&1,#11,&6,&1,&1,&1,&1,&1,&1",",") ,_
split("7,#7,#7,*2#3,&3,&3,&3,&3,&3,&3,&3,&3,&1,&1",",") ,_
split("8,*2#6,&1,*5#3,&3,&3,&3,&3,&3,&3,&3,*4#4,#7,#6",",") ,_
split("12,#3*5#4,#3*4#4,#3*3#4,#3*2#4,#3*2#3,#3*1#3,#7,#8,&5,#3*3#3,#3*4#3,#3*5#3,&1",",") ,_
split("9,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#3,#9,#9",",") ,_
split("13,#3*7#3,#4*5#4,&2,#5*3#5,&4,#6*1#6,#3*1#2*1#2*1#3,#3*1#5*1#3,#3*2#3*2#3,&9,#3*7#3,&11,&11",",") ,_
split("11,#4*4#3,#5*3#3,&2,#6*2#3,&4,#3*1#3*1#3,&6,#3*2#6,&8,#3*3#5,&10,#3*4#4,#3*5#3",",") ,_
split("13,*4#5,*2#9,*1#4*3#4,*1#3*5#3,#3*7#3,&5,&5,&5,&5,&4,&3,&2,&1",",") ,_
split("10,#8,#9,#3*3#4,#3*4#3,&4,&4,&3,&2,#7,#3,#3,#3,#3",",") ,_
split("13,*3#6,*2#8,*1#3*4#3,*1#2*6#2,#2*8#2,&5,&5,#2*4#1*3#2,#2*4#2*2#2,*1#2*4#4,&3,*2#10,*3#6*2#2",",") ,_
split("12,#8,#9,#3*4#3,&3,&3,#3*3#4,&2,&1,#3*2#4,#3*3#3,&3,#3*4#4,#3*5#4",",") ,_
split("11,*3#6,*1#9,#4*4#2,#3*6#1,#4,#8,&2,*3#8,*7#4,#1*7#3,#3*4#4,#10,*1#7",",") ,_
split("11,#11,&1,*4#3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3,&3",",") ,_
split("11,#3*5#3,&1,&1,&1,&1,&1,&1,&1,&1,&1,#4*3#4,*1#9,*3#5",",") ,_
split("14,#3*8#3,*1#3*6#3,&2,*1#3*5#4,*2#3*4#3,&5,*3#3*2#3,&7,&7,*4#6,&10,&10,*5#4",",") ,_
split("17,#3*4#3*4#3,&1,#3*3#5*3#3,*1#3*2#2*1#2*2#3,&4,*1#3*1#3*1#3*1#3,&6,*1#3*1#2*3#2*1#3,&8,*2#5*3#5,&10,*2#4*5#4,&12",",") ,_
split("14,#4*6#4,*1#4*4#4,*2#4*2#4,*3#3*2#3,*3#8,*4#6,*5#4,&6,&5,&4,&3,&2,&1",",") ,_
split("13,#4*5#4,*1#3*5#3,*2#3*3#3,*2#4*1#4,*3#3*1#3,*3#7,*4#5,*5#3,&8,&8,&8,&8,&8",",") ,_
split("10,#10,&1,*6#4,*5#4,*5#3,*4#3,*3#4,*3#3,*2#3,*1#4,#4,&1,&1",",") ,_
split("10,*3#4*3,*1#8*1,*1#3*2#3*1,#3*4#3,&4,&4,&4,&4,&4,&4,&3,&2,&1",",") ,_
split("9,*3#3*3,&1,#6*3,&3,*3#3*3,&5,&5,&5,&5,&5,&5,#9,&12",",") ,_
split("10,*1#6*3,#8*2,#2*3#4*1,#1*5#3*1,*6#3*1,&5,*5#3*2,*4#4*2,*3#4*3,*2#4*4,*1#4*5,#10,&12",",") ,_
split("11,*1#8*2,#10*1,#3*5#3,#1*7#3,*7#3*1,*3#6*2,*3#7*1,*7#4,*8#3,&4,#3*4#4,&2,*1#7*3",",") ,_
split("12,*6#4*2,*5#5*2,&2,*4#2*1#3*2,*3#3*1#3*2,*2#3*2#3*2,*1#3*3#3*2,#3*4#3*2,#12,&9,*7#3*2,&11,&11",",") ,_
split("11,*1#10,&1,*1#3*7,&3,*1#8*2,*1#9*1,*7#4,*8#3,&8,#1*7#3,#3*4#3*1,#10*1,*1#7*3",",") ,_
split("11,*4#6*1,*2#8*1,*1#4*6,*1#3*7,#3*1#5*2,#10*1,#3*4#4,#3*5#3,&8,&8,*1#3*3#3*1,*1#9*1,*3#5*3",",") ,_
split("11,#11,&1,*7#4,*7#3*1,*6#4*1,*6#3*2,*5#3*3,*4#4*3,*4#3*4,*3#4*4,*3#3*5,*2#3*6,*1#4*6",",") ,_
split("11,*2#7*2,*1#9*1,#3*4#4,#3*5#3,#4*3#3*1,*1#8*2,&1,*1#3*1#5*1,&4,&4,#4*3#4,&2,*2#6*3",",") ,_
split("11,*3#5*3,*1#9*1,*1#3*3#3*1,#3*5#3,&4,&4,#4*4#3,*1#10,*2#5*1#3,*7#3*1,*6#4*1,*1#8*2,*1#6*4",",") _
)'Previous row must end with _
'#Begin ColorMap
const BmpColorMap = "dffeff000c851700eceeee006c363600da644a00"
ColorMap = Array(_
split("00,01,01,03",",") ,_
split("02,03,03,01",",") ,_
split("00,04,04,02",",") _
)'End ColorMap
'#Auto calculated variables
dim ImageWidth, ImageHeight, arrTextWidth(), TextHeight, LeftMargin, arrTopMargin(), CursorPos
dim BmpEndLine, BColor, TColor, NColor
dim i, j, k, x, y
'#Editable consts and variables
dim Bitmap(40,200) '[Height,Width]
const CodeLength = 5 'Secure code length (Max:8)
const CodeType = 0 '0[Random numbers], 1[Random chars and numbers], 2[Fake word]
const CharTracking = 35 'Set the tracking between two characters
const RndTopMargin = true 'Randomize top margin every character
const NoiseEffect = 0 '0[none], 1[sketch], 2[random foreground lines], 3[random background lines], 4[1 and 3 (Recommed maximum NoiseLine=4)]
const NoiseLine = 3 'Low values make easy OCR, high values decrease readability
const MinLineLength = 6 'Minimum noise line length
const SessionName = "ASPCAPTCHA" 'Where store your secure code
'#Subroutines and functions
'*****************************
function CreateGUID(valLength)
'*****************************
if CodeType = 1 then
strValid = "A0B1C2D3E4F5G6H7I8J9K8L7M6N5O4P3Q2R1S0T1U2V3W4X5Y6Z7"
else
strValid = "0516273849"
end if
tmpGUID = vbNullString
tmpChr = vbNullString
Randomize(Timer)
for cGUID=1 to valLength
do
tmpChr = Mid(strValid, Int(Rnd(1) * Len(strValid)) + 1, 1)
loop while CStr(tmpChr) = CStr(Right(tmpGUID,1))
tmpGUID = tmpGUID & tmpChr
Next
CreateGUID = tmpGUID
end function
'***************************
function FakeWord(valLength)
'***************************
arrChars = Array("AEIOU", "BCDFGHJKLMNPQRSTVWXYZ")
cVowel = 0
cConsonant = 0
tmpWord = vbNullString
Randomize(Timer)
for cWord=1 to valLength
if (cWord=2) or ((valLength > 1) and (cWord = valLength)) then
ixChars = 1-ixChars
elseif (cVowel < 2) and (cConsonant < 2) then
ixChars = Int(Rnd(1) * 2)
elseif (cVowel < 2) then
ixChars = 0
elseif (cConsonant < 2) then
ixChars = 1
end if
Pattern = arrChars(ixChars)
tmpWord = tmpWord & Mid(Pattern, Int(Rnd(1) * Len(Pattern)) + 1, 1)
if ixChars = 0 then
cVowel = cVowel + 1
cConsonant = 0
else
cVowel = 0
cConsonant = cConsonant + 1
end if
next
FakeWord = tmpWord
end function
'**********************************
function RndInterval(valMin,valMax)
'**********************************
Randomize(Timer)
RndInterval = Int(((valMax - valMin + 1) * Rnd()) + valMin)
end function
'**************************
function GetCharMap(valChr)
'**************************
dim i, j
j = 0
for i=1 to UBound(FontMap(0))
if CStr(FontMap(0)(i)) = CStr(valChr) then
j = i
exit for
end if
next
if j > 0 then
GetCharMap = FontMap(j)
else
GetCharMap = Array(0)
end if
end function
'************************************************
sub WriteCanvas(byval valChr, byval valTopMargin)
'************************************************
dim i, j, k, curPos, tmpChr, arrChrMap, strPixMap, drawPixel, pixRepeat
'find char map
arrChrMap = GetCharMap(valChr)
if UBound(arrChrMap) < 1 then
exit sub
end if
for i=1 to UBound(arrChrMap)
'get pixel map active line
strPixMap = arrChrMap(i)
if Left(strPixMap,1) = "&" then
j = Mid(strPixMap,2)
if (IsNumeric(j) = true) then
strPixMap = arrChrMap(CInt(j))
else
strPixMap = vbNullString
end if
end if
strPixMap = Trim(strPixMap)
'drawing pixel
curPos = CursorPos
drawPixel = false
pixRepeat = vbNullString
for j=1 to Len(strPixMap)
tmpChr = Mid(strPixMap,j,1)
if (IsNumeric(tmpChr) = true) and (j < Len(strPixMap)) then
pixRepeat = pixRepeat & tmpChr
else
'end pixel map?
if IsNumeric(tmpChr) = true then
pixRepeat = pixRepeat & tmpChr
end if
'draw pixel
if (drawPixel = true) and (IsNumeric(pixRepeat) = true) then
for k=1 to CInt(pixRepeat)
curPos = curPos + 1
Bitmap((valTopMargin + i),curPos) = TColor
next
elseif IsNumeric(pixRepeat) = true then
curPos = curPos + CInt(pixRepeat)
end if
'what is new command?
if tmpChr = "#" then
drawPixel = true
else
drawPixel = false
end if
pixRepeat = vbNullString
end if
next
next
end sub
'*******************************
sub PrepareBitmap(valSecureCode)
'*******************************
dim i, j
'image dimensions
ImageWidth = UBound(Bitmap,2)
ImageHeight = UBound(Bitmap,1)
'char and text width
redim arrTextWidth(CodeLength)
arrTextWidth(0) = 0
for i=1 to CodeLength
arrTextWidth(i) = CInt(GetCharMap(Mid(secureCode,i,1))(0))
arrTextWidth(0) = arrTextWidth(0) + arrTextWidth(i)
next
arrTextWidth(0) = arrTextWidth(0) + ((CodeLength - 1) * CharTracking)
'text height
TextHeight = CInt(FontMap(0)(0))
'left margin
LeftMargin = Round((ImageWidth - arrTextWidth(0)) / 2)
'top margin
redim arrTopMargin(CodeLength)
arrTopMargin(0) = Round((ImageHeight - TextHeight) / 2)
if RndTopMargin = true then
for i=1 to CodeLength
arrTopMargin(i) = RndInterval(Int(arrTopMargin(0) / 2),(arrTopMargin(0) + Round(arrTopMargin(0) / 2)))
next
else
for i=1 to CodeLength
arrTopMargin(i) = arrTopMargin(0)
next
end if
'color selection
i = RndInterval(0,UBound(ColorMap))
BColor = ColorMap(i)(0)
NColor = ColorMap(i)(1)
TColor = ColorMap(i)(2)
'Apply background effect
if NoiseEffect = 3 then
AddNoise()
end if
'write text
for i=1 to CodeLength
'calculate cursor pos
CursorPos = 0
for j=(i-1) to 1 step -1
CursorPos = CursorPos + arrTextWidth(j) + CharTracking
next
CursorPos = LeftMargin + CursorPos
'write active char
WriteCanvas Mid(secureCode,i,1),arrTopMargin(i)
next
end sub
'***********************************
sub DrawLine(x0, y0, x1, y1, valClr)
'***********************************
'Reference from Donald Hearn and M. Pauline Baker, Computer Graphics C Version
dim m, b, dx, dy
if (NoiseEffect = 4) and (Bitmap(y0,x0) = TColor) then
clrNoise = vbNullString
else
clrNoise = valClr
end if
Bitmap(y0,x0) = clrNoise
dx = x1 - x0
dy = y1 - y0
if Abs(dx) > Abs(dy) then
m = (dy / dx)
b = y0 - (m * x0)
if dx < 0 then
dx = -1
else
dx = 1
end if
do while x0 <> x1
x0 = x0 + dx
if (NoiseEffect = 4) and (Bitmap(Round((m * x0) + b),x0) = TColor) then
clrNoise = vbNullString
else
clrNoise = valClr
end if
Bitmap(Round((m * x0) + b),x0) = clrNoise
loop
elseif dy <> 0 then
m = (dx / dy)
b = x0 - (m * y0)
if dy < 0 then
dy = -1
else
dy = 1
end if
do while y0 <> y1
y0 = y0 + dy
if (NoiseEffect = 4) and (Bitmap(y0,Round((m * y0) + b)) = TColor) then
clrNoise = vbNullString
else
clrNoise = valClr
end if
Bitmap(y0,Round((m * y0) + b)) = clrNoise
loop
end if
end sub
'*************
sub AddNoise()
'*************
dim median, i, j, x0, y0, x1, y1, dx, dy, dxy
if NoiseEffect = 1 then
clrNoise = vbNullString
else
clrNoise = NColor
end if
for i=1 to NoiseLine
x0 = RndInterval(1,ImageWidth)
y0 = RndInterval(1,ImageHeight)
x1 = RndInterval(1,ImageWidth)
y1 = RndInterval(1,ImageHeight)
'Check minimum line length
dx = Abs(x1 - x0)
dy = Abs(y1 - y0)
median = Round(Sqr((dx * dx) + (dy * dy))/2)
if median < MinLineLength then
dxy = MinLineLength - median
if x1 < x0 then
dx = -1
else
dx = 1
end if
if y1 < y0 then
dy = -1
else
dy = 1
end if
for j=1 to dxy
if ((x1 + dx) < 1) or ((x1 + dx) > ImageWidth) or ((y1 + dy) < 1) or ((y1 + dy) > ImageHeight) then
exit for
end if
x1 = x1 + dx
y1 = y1 + dy
next
end if
'Draw noise line
DrawLine x0,y0,x1,y1,clrNoise
next
end sub
'*****************************************************************
function FormatHex(byval valHex,byval fixByte,fixDrctn,valReverse)
'*****************************************************************
fixByte = fixByte * 2
tmpLen = Len(valHex)
if fixByte > tmpLen then
tmpFixHex = String((fixByte - tmpLen),"0")
if fixDrctn = 1 then
valHex = valHex & tmpFixHex
else
valHex = tmpFixHex & valHex
end if
end if
if valReverse = true then
tmpHex = vbNullString
for cFrmtHex=1 to Len(valHex) step 2
tmpHex = Mid(valHex,cFrmtHex,2) & tmpHex
next
FormatHex = tmpHex
else
FormatHex = CStr(valHex)
end if
end function
'******************
sub SendHex(valHex)
'******************
for cHex = 1 to Len(valHex) step 2
Response.BinaryWrite ChrB(CByte("&H" & Mid(valHex,cHex,2)))
next
end sub
'***************
sub SendBitmap()
'***************
if (ImageWidth mod 4) <> 0 then
BmpEndLine = String((4-(ImageWidth mod 4))*2,"0")
else
BmpEndLine = vbNullString
end if
BmpInfoHeader = Array("28000000","00000000","00000000","0100","0800","00000000","00000000","120B0000","120B0000","00000000","00000000")
BmpInfoHeader(1) = FormatHex(Hex(ImageWidth),4,0,true)
BmpInfoHeader(2) = FormatHex(Hex(ImageHeight),4,0,true)
BmpInfoHeader(6) = FormatHex(Hex((ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
BmpInfoHeader(9) = FormatHex(Hex(Len(BmpColorMap)/8),4,0,true)
BmpInfoHeader(10) = BmpInfoHeader(9)
BmpHeader = Array("424D","00000000","0000","0000","00000000")
BmpHeader(1) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2) + (ImageHeight * ImageWidth) + (ImageHeight * (Len(BmpEndLine) / 2))),4,0,true)
BmpHeader(4) = FormatHex(Hex((Len(Join(BmpHeader,"")) / 2) + (Len(Join(BmpInfoHeader,"")) / 2) + (Len(BmpColorMap) / 2)),4,0,true)
Response.Clear
Response.Buffer = True
Response.ContentType = "image/bmp"
Response.AddHeader "Content-Disposition", "inline; filename=captcha.bmp"
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "no-cache"
Response.Expires = -1
SendHex(Join(BmpHeader,""))
SendHex(Join(BmpInfoHeader,""))
SendHex(BmpColorMap)
for y=ImageHeight to 1 step -1
for x=1 to ImageWidth
tmpHex = Bitmap(y,x)
if tmpHex = vbNullString then
SendHex(BColor)
else
SendHex(tmpHex)
end if
next
SendHex(BmpEndLine)
next
Response.Flush
end sub
'#Generate captcha
if CodeType < 2 then
secureCode = CreateGUID(CodeLength)
else
secureCode = FakeWord(CodeLength)
end if
Session(SessionName) = secureCode
PrepareBitmap(secureCode)
if (NoiseEffect > 0) and (NoiseEffect <> 3) then
AddNoise()
end if
SendBitmap()
%>
Before process, validate the captcha:
<%
if not TestCaptcha("ASPCAPTCHA", request("captchacode")) then
response.write "Captcha error!"
response.end
end if
response.write "Captcha OK"
'... process...
%>

run-time error '5' maps.googleapis.com/maps/api/distancematrix

Yesterday, I ran the following script in excel and it worked, but now it throws an error:
(run-time error '5' )
in the line:
Distance = Mid(Distance, InStr(1, Distance, ">") + 1, InStr(1, Distance, " ") - InStr(1, Distance, ">") - 1)
Sub Поиск_ближайшего_СБС()
Set Points = Worksheets("Точки")
Set SBS = Worksheets("СБС")
Dim Cordinate11, Cordinate12, Cordinate21, Cordinate22 As String
i = 2
Do While SBS.Cells(i, 1) <> Empty
Rows_of_SBS = i
i = i + 1
Loop
i = 2
Do While Cells(i, 1) <> Empty
Dist = 1000
Cordinate21 = Points.Cells(i + 1, 3)
Cordinate22 = Points.Cells(i + 1, 4)
For j = 2 To Rows_of_SBS
Cordinate11 = SBS.Cells(j, 2)
Cordinate12 = SBS.Cells(j, 3)
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
With IE
.Navigate "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" _
& Cordinate11 & ",+" & Cordinate12 _
& "&destinations=" _
& Cordinate21 & ",+" & Cordinate22 _
& "&mode=driving&language=ru&sensor=false"
Do While .Busy
DoEvents
Loop
For Each MyTable In .Document.getElementsByTagName("text")
Distance = MyTable.innertext
Next
Distance = Mid(Distance, InStr(1, Distance, ">") + 1, InStr(1, Distance, " ") - InStr(1, Distance, ">") - 1)
If CDbl(Distance) < Dist Then
Dist = CDbl(Distance) s = j
End If
End With
IE.Quit
Set EI = Nothing
Next j
Points.Cells(i + 1, 5) = Dist
Points.Cells(i + 1, 6) = SBS.Cells(s, 1)
i = i + 1
Loop
End Sub
'

VB.Net save excel file only in program debugging

I got a problem which is not an error in writing data to Excel file from VB.NET.
The code to save data in Excel file is as the following:
Sub WriteToExcel(ByVal dt As DataTable)
Dim excel_app As New Excel.ApplicationClass()
excel_app.Visible = True
Dim workbook As Excel.Workbook = excel_app.Workbooks.Open(Filename:=FileUpload1.PostedFile.FileName)
Dim sheet_name As String = "rptSyncADandITSM"
Dim sheet As Excel.Worksheet = FindSheet(workbook, sheet_name)
sheet.Cells(1, "AF") = "Status"
sheet.Cells(1, "AG") = "Message"
sheet.Range("AF" & 1).Style.VerticalAlignment = VerticalAlign.Top
sheet.Range("AF1").Style.HorizontalAlignment = HorizontalAlign.Center
sheet.Range("AF1").ColumnWidth = 10
sheet.Range("AG1").Style.VerticalAlignment = VerticalAlign.Top
sheet.Range("AG1").Style.HorizontalAlignment = HorizontalAlign.Center
sheet.Range("AG1").ColumnWidth = 15
Dim header_range As Excel.Range = sheet.Range("AF1", "AG1")
header_range.Font.Bold = True
header_range.Font.Color = System.Drawing.ColorTranslator.ToOle(Drawing.Color.Black)
Dim borders As Excel.Borders = header_range.Borders
borders.LineStyle = Excel.XlLineStyle.xlContinuous
borders.Weight = 1.9R
For Each dr As DataRow In dt.Rows
Dim value_range As Excel.Range = sheet.Range("AF" & dr(0).ToString, "AG" & dr(0).ToString)
If Not dr.IsNull(0) Then
sheet.Range("AF" & dr(0).ToString).Style.VerticalAlignment = VerticalAlign.Top
sheet.Range("AF" & dr(0).ToString).Style.HorizontalAlignment = HorizontalAlign.Center
sheet.Range("AF" & dr(0).ToString).ColumnWidth = 10
sheet.Range("AG" & dr(0).ToString).Style.VerticalAlignment = VerticalAlign.Top
sheet.Range("AG" & dr(0).ToString).Style.HorizontalAlignment = HorizontalAlign.Center
sheet.Range("AG" & dr(0).ToString).ColumnWidth = 15
Dim values(0, 1) As String
values(0, 0) = dr(1).ToString
values(0, 1) = dr(2).ToString
value_range.Value2 = values
End If
Dim value_borders As Excel.Borders = value_range.Borders
value_borders.LineStyle = Excel.XlLineStyle.xlContinuous
value_borders.Weight = 2.0R
Next
workbook.Save()
workbook.Close()
'workbook.Close(SaveChanges:=True)
excel_app.Quit()
End Sub
I reference these codes from this
But it only works when i debug the program. In runtime(not debugging) doesn't work to save.

Putting labels inside of a vb.net Array

So i've created 5 different arrays for labels These are
Dim ovsoLabels As Label(), customerLabels() As Label, itemNameLabels() As Label, quantityLabels() As Label, topRightItemNameLbls(5) As Label
Dim indexLabels() As Label
After that I have a function that assigns those variables to actual labels.
'assign labels to array
ovsoLabels(0) = oVSO10
ovsoLabels(1) = oVSO11
ovsoLabels(2) = oVSO12
ovsoLabels(3) = oVSO13
ovsoLabels(4) = oVSO14
customerLabels(0) = custLbl20
customerLabels(1) = custLbl21
customerLabels(2) = custLbl22
customerLabels(3) = custLbl23
customerLabels(4) = custLbl24
itemNameLabels(0) = nameLbl1
itemNameLabels(1) = nameLbl2
itemNameLabels(2) = nameLbl3
itemNameLabels(3) = nameLbl4
itemNameLabels(4) = nameLbl5
quantityLabels(0) = quantLbl1
quantityLabels(1) = quantLbl2
quantityLabels(2) = quantLbl3
quantityLabels(3) = quantLbl4
quantityLabels(4) = quantLbl6
indexLabels(0) = indexLbl10
indexLabels(1) = indexLbl11
indexLabels(2) = indexLbl12
indexLabels(3) = indexLbl13
indexLabels(4) = indexLbl14
After that I call the function in my timer tick
and this is what i'm triying to do (Not quoteArray has numbers in it 0 - infinity)
For i = 0 To 4
If quantityArray(i) = Nothing Then
ElseIf quantityArray(i) = 0 Then
quantityLabels(i).ForeColor = Drawing.Color.Green
customerLabels(i).ForeColor = Drawing.Color.Green
itemNameLabels(i).ForeColor = Drawing.Color.Green
ovsoLabels(i).ForeColor = Drawing.Color.Green
indexLabels(i).ForeColor = Drawing.Color.Green
Else
quantityLabels(i).ForeColor = Drawing.Color.Black
customerLabels(i).ForeColor = Drawing.Color.Black
itemNameLabels(i).ForeColor = Drawing.Color.Black
ovsoLabels(i).ForeColor = Drawing.Color.Black
indexLabels(i).ForeColor = Drawing.Color.Black
End If
Next
This is my first post, so tell me if I can format better. The error I'm getting is that it tells me that there is no object and I need to use the keyword new. Not sure what that means, thanks!

Resources