Imports Microsoft.VisualBasic
Imports System.Data.SqlClient
Imports System.Data
Imports System.Security.Cryptography
Imports System
Imports System.IO
Imports System.Text
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.ComponentModel
Namespace All
Public Class Choice
Inherits QuestionChoice
Public Sub New(ByVal Value As String, ByVal Text As String)
MyBase.New(Value, Text)
End Sub
End Class
Public Class ChoiceMatrix
Private _Choice As ArrayList
Private _ChoiceOptions As ArrayList
Public Sub New()
_Choice = New ArrayList
_ChoiceOptions = New ArrayList
End Sub
Public Sub AddChoice(ByVal vChoice As Choice)
_Choice.Add(vChoice)
End Sub
Public Sub AddChoiceOption(ByVal vChoiceOption As ChoiceOption)
_ChoiceOptions.Add(vChoiceOption)
End Sub
Public Function Choices() As ArrayList
Return _Choice
End Function
Public Function ChoiceOptions() As ArrayList
Return _ChoiceOptions
End Function
End Class
Public Class ChoiceMatrixWithSubOption
Inherits Monkey.Survey.ChoiceMatrix
Public Sub New()
MyBase.New()
End Sub
End Class
Public Class ChoiceOption
Inherits QuestionChoice
Private _subOptions As ArrayList
Private _ChoiceControlType As ChoiceControlTypes
Public Sub New(ByVal Value As String, ByVal Text As String, ByVal ChoiceControlType As ChoiceControlTypes)
MyBase.New(Value, Text)
_subOptions = New ArrayList
_ChoiceControlType = ChoiceControlType
End Sub
Public Sub AddSubOption(ByVal SubOption As ChoiceSubOption)
_subOptions.Add(SubOption)
End Sub
Public ReadOnly Property ChoiceSubOptions() As ArrayList
Get
Return _subOptions
End Get
End Property
Public ReadOnly Property ChoiceControlType() As ChoiceControlTypes
Get
Return _ChoiceControlType
End Get
End Property
End Class
Public Enum ChoiceControlTypes
CheckBox '0
RadioButton '1
DropDown '2
TextBox '3
ListBox '4
'ListBox '2
'DropDown '3
'TextBox '4
End Enum
Public Class ChoiceSubOption
Inherits QuestionChoice
Public Sub New(ByVal Value As String, ByVal Text As String)
MyBase.New(Value, Text)
End Sub
End Class
Public Module clsAppFunctions
Dim con As New SqlConnection
Dim cmd As New SqlCommand("", con)
Dim strSQL As String
Public Sub loadddlStatus(ByVal ddlstatus As DropDownList)
With ddlstatus.Items
.Insert(0, "any status")
.Insert(1, "not sent")
.Insert(2, "sent")
.Insert(3, "responded")
.Insert(4, "declined")
End With
End Sub
Public Sub loadDDLType(ByVal ddlType As DropDownList)
With ddlType.Items
.Clear()
.Insert(0, "EMail")
.Insert(1, "FirstName")
.Insert(2, "LastName")
End With
End Sub
Public Sub loadDDLStartsWith(ByVal ddlStartsWith As DropDownList)
With ddlStartsWith.Items
.Clear()
.Insert(0, "starts with")
.Insert(1, "ends with")
.Insert(2, "contains")
.Insert(3, "equals")
End With
'ddlStartsWith.Items.Add(New ListItem("starts with", 0))
'ddlStartsWith.Items.Add(New ListItem("ends with", 1))
'ddlStartsWith.Items.Add(New ListItem("contains", 2))
'ddlStartsWith.Items.Add(New ListItem("equals", 3))
End Sub
Public Function loadDDL(ByVal ddlload As DropDownList, ByVal con As SqlConnection, ByVal cmd As SqlCommand, ByVal strSQL As String)
Dim i As Integer = 1
Dim rd As SqlDataReader
cmd = New SqlCommand(strSQL, con)
ddlload.Items.Insert(0, "Select")
With cmd
cmd.CommandType = Data.CommandType.Text
rd = cmd.ExecuteReader
End With
While rd.Read
ddlload.Items.Insert(i, rd(0))
i = i + 1
End While
rd.Close()
Return 1
End Function
Public Sub refreshGridViewWithDataAdapter(ByVal gridview1 As GridView, ByVal con As SqlConnection, ByVal strSql As String)
Dim cmd As New SqlCommand
Dim ad As SqlDataAdapter
Dim ds As New System.Data.DataSet
With cmd
.CommandType = CommandType.Text
.CommandText = strSql
.Connection = con
End With
ad = New SqlDataAdapter(cmd)
'ad.SelectCommand = cmd
ad.Fill(ds)
' gridview1.DataSource = New DataSet("ds").Tables(0)
If ds.Tables.Count <> 0 Then
gridview1.DataSource = ds.Tables(0)
gridview1.DataBind()
Else
gridview1.DataSource = Nothing
gridview1.DataBind()
End If
End Sub
Public Sub ExecuteQuery(ByVal con As SqlConnection, ByVal strSQL As String)
Dim cmd As New SqlCommand(strSQL, con)
cmd.CommandType = CommandType.Text
cmd.ExecuteNonQuery()
End Sub
Public Function checkExists(ByVal con As SqlConnection, ByVal strSQL As String)
Dim cmd As New SqlCommand(strSQL, con)
Dim rd As SqlDataReader
cmd.CommandType = CommandType.Text
rd = cmd.ExecuteReader
If rd.HasRows Then
rd.Close()
Return True
Else
rd.Close()
Return False
End If
End Function
End Module
Public Enum ControlTypes
RadioButtonList = 1
CheckBoxList = 2
ListBox = 3
DropDown = 4
TextBox = 5
Label = 6
MultipleTextBox = 7
MultipleDropDown = 8
Image = 9
Calendar = 10
Buttons = 11
Matrix = 12
FileUpload = 13
NameAddressUS = 14
NameAddressGeneral = 15
'MatrixRadioButton = 12
'MatrixCheckBox = 14
'MatrixDropDown = 15
End Enum
Public Module ModCommonFunctions
Public Const COMMA = ","
Public Function OpenConnection(ByVal c As SqlConnection) As SqlConnection
c.ConnectionString = ConfigurationManager.AppSettings("connectionstring")
If c.State = Data.ConnectionState.Closed Then
c.Open()
End If
Return c
End Function
Public Sub CloseConnection(ByRef c As SqlConnection)
If c.State = Data.ConnectionState.Open Then
c.Close()
End If
End Sub
Public Sub SetFocus(ByVal ctrlname As Control, ByVal Pagename As Page)
Dim str As String
Dim a As Integer = 0
str = "<script languauge=javascript>document.getElementById('" & ctrlname.ID & "').focus();</script>"
Dim PgName As Page
PgName = Pagename
' PgName.RegisterStartupScript("setfocus", str)
End Sub
' Public Shared Sub checkSession(ByVal intUserID)
Public Sub checkSession(ByVal intUserID)
If CStr(intUserID) = "" Then
HttpContext.Current.Response.Redirect("../home.aspx?expired=1")
End If
End Sub
Public Function getDataSet(ByVal ds As System.Data.DataSet, ByVal sqlCmd As SqlCommand, ByVal strSql As String, ByVal sqlCon As SqlConnection) As System.Data.DataSet
Dim da As New SqlDataAdapter
sqlCmd = New SqlCommand(strSql, sqlCon)
da = New SqlDataAdapter(sqlCmd)
da.Fill(ds)
Return ds
End Function
' can be 192 or 128
Public Function ConvertStringToBit(ByVal str) As Int32
'Dim i As Integer
If IsDBNull(str) = True Then
'i = -1
Return -1
Exit Function
End If
'If str = True Then
' i = 1
'Else
' i = 0
'End If
Return IIf(str = True, 1, 0)
End Function
Function ChangeNullToString(ByVal strValue) As String
Dim strReturn As String
If IsDBNull(strValue) = True Or IsNothing(strValue) = True Then
strReturn = ""
Else
strReturn = strValue
End If
Return strReturn
End Function
Function ChangeNumberToNull(ByVal txtValue) As String
Dim retStr As String
If IsDBNull(txtValue) = True Or txtValue = "" Or IsNothing(txtValue) = True Then
retStr = "Null"
Else
retStr = txtValue
End If
Return retStr
End Function
Function ChangeToNull(ByVal txtValue)
If txtValue = "" Or IsDBNull(txtValue) = True Then
txtValue = "null"
Else
txtValue = "'" & txtValue & "'"
End If
ChangeToNull = txtValue
End Function
Public Function NumbersOnly(ByVal Data As String) As String
Dim strNumber As String = ""
Try
Dim blndigit As Boolean = False
Dim I As Integer
If IsDBNull(Data) = True Or Trim(Data) = "" Then
Return ""
Exit Function
End If
For I = 1 To Len(Data)
Select Case Mid(Data, I, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
strNumber &= Mid(Data, I, 1)
'Case "1"
' strNumber &= Mid(Data, I, 1)
'Case "2"
' strNumber &= Mid(Data, I, 1)
'Case "3"
' strNumber &= Mid(Data, I, 1)
'Case "4"
' strNumber &= Mid(Data, I, 1)
'Case "5"
' strNumber &= Mid(Data, I, 1)
'Case "6"
' strNumber &= Mid(Data, I, 1)
'Case "7"
' strNumber &= Mid(Data, I, 1)
'Case "8"
' strNumber &= Mid(Data, I, 1)
'Case "9"
' strNumber &= Mid(Data, I, 1)
End Select
Next
NumbersOnly = strNumber
' Return strNumber
Catch ex As Exception
Throw ex
'MsgBox(ex.Message, MsgBoxStyle.Information)
End Try
End Function
Public Function NumbersOnlyFound(ByVal Data As String) As Boolean
Try
Dim blnFound As Boolean = True
Dim I As Integer
If IsDBNull(Data) = True Or Trim(Data) = "" Then
Return ""
Exit Function
End If
For I = 1 To Len(Data)
Dim strVal As String
strVal = Mid(Data, I, 1)
If strVal = "0" Or strVal = "1" Or strVal = "2" Or strVal = "3" Or _
strVal = "4" Or strVal = "5" Or strVal = "6" Or strVal = "7" _
Or strVal = "8" Or strVal = "9" Then
Else
blnFound = False
Exit For
End If
Next
NumbersOnlyFound = blnFound
Catch ex As Exception
Throw ex
'MsgBox(ex.Message, MsgBoxStyle.Information)
End Try
End Function
Function ChangeToZero(ByVal txtValue)
If IsDBNull(txtValue) Then
txtValue = 0
ElseIf CStr(txtValue) = "" Then
txtValue = 0
Else
txtValue = txtValue
End If
ChangeToZero = txtValue
End Function
Function ChangeNumberToEmpty(ByVal txtValue)
If IsDBNull(txtValue) Or txtValue = "0" Then
txtValue = ""
Else
txtValue = txtValue
End If
ChangeNumberToEmpty = txtValue
Return ChangeNumberToEmpty
End Function
' Function ChangeToEmptySQLString(ByVal txtValue)
' If IsDBNull(txtValue) Or Trim(txtValue) = "" Then
' ChangeToEmptySQLString = "''"
' Else
' ChangeToEmptySQLString = txtValue
' End If
' End Function
Function PrepareStringForDropDownList(ByVal strVariant As Object, Optional ByVal isValueAString As Boolean = False)
'' will be used only when a string datatype is used for value in a drowdown box and
'' you want to return null for the first item as empty string or zero (as string)
' '' NULL WILL BE RETURNED IF blnReturnNull = TRUE
' '' Emty quotes will be returned if blnreturnnull = false
'Dim Str As String
'Dim Strnull As System.DBNull
'' If blnReturnNull = True Then
If Trim(strVariant) = "" Or Trim(strVariant) = "0" Then
PrepareStringForDropDownList = "Null"
Exit Function
Else
If isValueAString = True Then
PrepareStringForDropDownList = Quoted(Trim(strVariant))
Else
PrepareStringForDropDownList = strVariant
End If
End If
''End If
'' If IsDBNull(strVariant) = True Or Trim(strVariant) = "" Then
'' PrepareStringForDropDownList = "''"
'' Else
'' Str = strVariant
'' PrepareStringForDropDownList = Quoted(Trim(Str))
'' End If
End Function
Function PrepareString(ByVal strVariant As Object, ByVal blnReturnNull As Boolean)
' NULL WILL BE RETURNED IF blnReturnNull = TRUE
' '' Emty quotes will be returned if blnreturnnull = false
Dim Str As String
Dim Strnull As System.DBNull = Nothing
If blnReturnNull = True Then
If IsDBNull(strVariant) = True Or Trim(strVariant) = "" Then
PrepareString = "Null"
Exit Function
End If
End If
If IsDBNull(strVariant) = True Or Trim(strVariant) = "" Then
PrepareString = "''"
Else
Str = strVariant
PrepareString = Quoted(Trim(Str))
End If
End Function
Function PrepareString(ByVal strVariant As Object)
Dim Str As String
If IsDBNull(strVariant) = True Or Trim(strVariant) = "" Then
PrepareString = "''"
Else
Str = strVariant
PrepareString = Quoted(Trim(Str))
End If
End Function
Public Function Quoted(ByVal strToBeQuoted)
Quoted = "'" & Replace(Trim(strToBeQuoted), "'", "''") & "'"
Exit Function
End Function
Public Function PreparePwd(ByVal str As String)
PreparePwd = "'" & Replace(str, "'", "''") & "'"
End Function
Public Function RemoveLastCharacter(ByVal str As String, ByVal LastChar As String) As String
Dim strReturn As String
str = Trim(str)
If Right(str, 1) = LastChar Then
strReturn = Left(str, Len(str) - 1)
Else
strReturn = str
End If
Return strReturn
End Function
Function ConvertToBit(ByVal val As Boolean) As Integer
If val = True Then
ConvertToBit = 1
Else
ConvertToBit = 0
End If
End Function
Public Sub cleartextboxes(ByRef p As Page)
Dim c As Control
For Each c In p.Controls
If c.GetType.ToString.Equals("System.Web.UI.WebControls.TextBox") Then
CType(c, TextBox).Text = ""
End If
Next
End Sub
Public Sub setlstValue(ByRef lst As ListBox, ByVal strValue As Object)
If IsDBNull(strValue) = False Then
lst.SelectedValue = strValue
End If
End Sub
Public Sub RefreshGrid(ByRef dg As DataGrid, ByRef sqlcmd As SqlCommand, ByVal strSQL As String)
Dim sqlReader As SqlDataReader
With sqlcmd
.CommandText = strSQL
.CommandType = Data.CommandType.Text
sqlReader = .ExecuteReader
End With
dg.DataSource = sqlReader
dg.DataBind()
sqlReader.Close()
End Sub
Public Function getSelectedFromList(ByRef lst As Object) As String
Dim str As String = ""
Dim i As Integer
For i = 0 To (lst.Items.Count - 1)
If (lst.Items(i).Selected) Then
str += lst.Items(i).Value & ","
End If
Next
If Len(str) > 0 Then str = Left(str, Len(str) - 1)
Return str
End Function
Public Sub setOptListValue(ByRef opt As RadioButtonList, ByVal strValue As Object)
Dim i As Integer
i = ConvertStringToBit(strValue)
If i <> -1 Then opt.SelectedValue = i
End Sub
Public Function ChangeDBNullToEmptyString(ByVal tStr As Object) As Object
Dim str As String = ""
If IsDBNull(tStr) = True Then
Return str
Else
Return tStr
End If
End Function
Public Function ChangeCboValueToDBNull(ByVal str As String) As Object
If IsNothing(str) = True Or str = "0" Then
Return DBNull.Value
Else
Return str
End If
End Function
Public Function ChangetxtValueToDBNull(ByVal str As String, ByVal allowEmptyString As Boolean) As Object
If allowEmptyString = False Then
If IsNothing(str) = True Or str = "" Then
Return DBNull.Value
Else
Return str
End If
Else
If IsNothing(str) = True Then
Return DBNull.Value
Else
Return str
End If
End If
End Function
' Public Shared Function CreatePasswordChar(ByVal Intlen As Integer) As String
Public Function CreatePasswordChar(ByVal Intlen As Integer) As String
Dim I As Integer
CreatePasswordChar = ""
For I = 1 To Intlen
CreatePasswordChar = CreatePasswordChar & "*"
Next
Return CreatePasswordChar
End Function
Public Sub ClearFields(ByVal parent As System.Web.UI.Control)
Dim c As Control
For Each c In parent.Controls
If c.GetType() Is GetType(TextBox) Then
'is it a textbox?
Dim t As TextBox = c
t.Text = ""
ElseIf c.GetType() Is GetType(HtmlControls.HtmlInputHidden) Then
'is it a hidden text?
Dim h As HtmlControls.HtmlInputHidden = c
h.Value = ""
ElseIf c.GetType() Is GetType(DropDownList) Then
'is it a dropdown list?
Dim d As DropDownList = c
d.ClearSelection()
ElseIf c.GetType() Is GetType(ListBox) Then
'is it a listbox?
Dim l As ListBox = c
l.ClearSelection()
ElseIf c.GetType() Is GetType(RadioButtonList) Then
'is it a radiobutton list?
Dim rl As RadioButtonList = c
rl.ClearSelection()
ElseIf c.GetType() Is GetType(CheckBox) Then
'is it a checkbox?
Dim chk As CheckBox = c
chk.Checked = False
ElseIf c.GetType() Is GetType(CheckBoxList) Then
'is it a checkbox list?
Dim cl As CheckBoxList = c
cl.ClearSelection()
End If
If c.HasControls Then
ClearFields(c)
End If
Next
End Sub
Public Function GetColumnCaption(ByVal intfieldID As Long, ByVal intsurveyId As Long, ByVal intForWhichlstBox As Int16) As String
Dim conn As New SqlConnection
OpenConnection(conn)
Dim columncaption As String
' Dim cmd As New SqlCommand("Exec GetQuestionText " & ChangeToZero(intfieldID) & COMMA & ChangeToZero(intsurveyId), conn)
Dim cmd As New SqlCommand("Exec GetQuestionText " & ChangeToZero(intfieldID) & COMMA & ChangeToZero(intsurveyId) & COMMA & ChangeToZero(intForWhichlstBox), conn)
cmd.CommandType = Data.CommandType.Text
columncaption = cmd.ExecuteScalar
If columncaption <> "" Then
GetColumnCaption = columncaption
Else
GetColumnCaption = ""
End If
End Function
'Public Sub GetEncryptedvalue(ByVal val As String)
' Dim i As Long
' If Len(val) > 0 And val.Trim <> "" Then
' Dim str As String
' str = ""
' For i = 1 To Len(val)
' If str = "" Then
' ' str=mid(
' End If
' Next
' End If
'End Sub
Public Sub SetError()
HttpContext.Current.Session("errormsg") = HttpContext.Current.Server.GetLastError.GetBaseException.Message
End Sub
Public Function getRecordSet(ByRef sqlcmd As SqlCommand, ByVal strSQL As String) As SqlDataReader
Dim sqlReader As SqlDataReader
With sqlcmd
.CommandText = strSQL
.CommandType = Data.CommandType.Text
sqlReader = .ExecuteReader()
End With
Return sqlReader
End Function
Public Function getSingleValue(ByRef sqlcmd As SqlCommand, ByVal strSQL As String) As String
Dim str As String
With sqlcmd
.CommandText = strSQL
.CommandType = Data.CommandType.Text
str = ChangeDBNullToEmptyString(.ExecuteScalar)
End With
Return str
sqlcmd.Parameters.Clear()
End Function
'for ins, upd, delete
Public Sub runNonQuery(ByRef sqlcmd As SqlCommand, ByVal strSQL As String)
With sqlcmd
.CommandText = strSQL
.CommandType = Data.CommandType.Text
.ExecuteNonQuery()
End With
End Sub
Public Sub CheckForSession() '' For Checking whether the session is expired or not
If ChangeToZero(HttpContext.Current.Session("surveyId")) = 0 Then
HttpContext.Current.Session.Abandon()
HttpContext.Current.Response.Redirect("Home.aspx?reason=expired")
End If
End Sub
Public Function IsFieldAsname(ByVal name As String) As Boolean
IsFieldAsname = True
Dim names, na, i, c
names = name
For Each na In names
If Len(names) <= 0 Then
IsFieldAsname = False
Exit Function
End If
Next
For i = 1 To Len(name)
c = LCase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.'", c) <= 0 Or IsNumeric(c) Then 'Chang ed by Senthil on Aug26th
IsFieldAsname = False
Exit Function
End If
Next
End Function
Public Function IsValidEmail(ByVal email As String) As Boolean
IsValidEmail = True
Dim names, name, i, c
names = Split(email, "@")
If UBound(names) <> 1 Then
IsValidEmail = False
Exit Function
End If
For Each name In names
If Len(name) <= 0 Then
IsValidEmail = False
Exit Function
End If
For i = 1 To Len(name)
c = LCase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.'", c) <= 0 And Not IsNumeric(c) Then 'Changed by Senthil on Aug26th
IsValidEmail = False
Exit Function
End If
Next
If Left(name, 1) = "." Or Right(name, 1) = "." Then
IsValidEmail = False
Exit Function
End If
If Left(name, 1) = "'" Or Right(name, 1) = "'" Then 'New validation Added by senthil on Aug 26th
IsValidEmail = False
Exit Function
End If
Next
If InStr(names(1), ".") <= 0 Then
IsValidEmail = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
IsValidEmail = False
Exit Function
End If
If InStr(email, "..") > 0 Then
IsValidEmail = False
End If
End Function
Public Function IsValidURL(ByVal Url As String) As Boolean
IsValidURL = True
Dim names, name, i, c
names = Split(Url, "://")
If UBound(names) <> 1 Then
IsValidURL = False
Exit Function
End If
For Each name In names
If Len(name) <= 0 Then
IsValidURL = False
Exit Function
End If
For i = 1 To Len(name)
c = LCase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.'", c) <= 0 And Not IsNumeric(c) Then
IsValidURL = False
Exit Function
End If
Next
If Left(name, 1) = "." Or Right(name, 1) = "." Then
IsValidURL = False
Exit Function
End If
If Left(name, 1) = "'" Or Right(name, 1) = "'" Then 'New validation Added by senthil on Aug 26th
IsValidURL = False
Exit Function
End If
Next
If InStr(names(1), ".") <= 0 Then
IsValidURL = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
IsValidURL = False
Exit Function
End If
If InStr(Url, "..") > 0 Then
IsValidURL = False
End If
End Function
Public Function GetModuleName(ByVal intModId As Integer) As String
Dim strsql As String = ""
Dim sqlcmd As SqlCommand = Nothing
strsql = "Exec GetModuleName " & Convert.ToString(intModId)
With sqlcmd
.CommandText = strsql
.CommandType = Data.CommandType.Text
GetModuleName = .ExecuteScalar
.Parameters.Clear()
End With
End Function
Function AuthenticateUser() As Boolean
If HttpContext.Current.Session("UserID") Is Nothing Then Return False
Return True
End Function
End Module
Public Module modFillList
Public Sub FillList(ByRef chklst As CheckBoxList, ByRef cmd As SqlCommand, ByVal strSQL As String, ByVal strValue As String, ByVal strText As String)
Dim sqlReader As SqlDataReader
With cmd
.CommandText = strSQL
sqlReader = .ExecuteReader
.CommandType = CommandType.Text
End With
With chklst
.DataSource = sqlReader
.DataValueField = strValue
.DataTextField = strText
.DataBind()
End With
sqlReader.Close()
cmd.Parameters.Clear()
End Sub
Public Sub FillList(ByRef lst As ListBox, ByRef sqlcmd As SqlCommand, ByVal strSQL As String, ByVal strValue As String, ByVal strText As String, ByVal blnAddFirstRow As Boolean)
Dim sqlReader As SqlDataReader
With sqlcmd
.CommandText = strSQL
.CommandType = CommandType.Text
sqlReader = .ExecuteReader
End With
With lst
.DataSource = sqlReader
.DataValueField = strValue
.DataTextField = strText
.DataBind()
End With
If blnAddFirstRow = True Then
lst.Items.Insert(0, (New ListItem("Select One", 0)))
End If
sqlReader.Close()
sqlcmd.Parameters.Clear()
End Sub
Public Sub FillList(ByRef lst As DropDownList, ByRef sqlcmd As SqlCommand, ByVal strSQL As String, ByVal strValue As String, ByVal strText As String, ByVal blnAddFirstRow As Boolean, Optional ByVal FirstItem As String = "", Optional ByVal Val As Int16 = 0)
Dim sqlReader As SqlDataReader
With sqlcmd
.CommandText = strSQL
.CommandType = CommandType.Text
sqlReader = .ExecuteReader
End With
With lst
.DataSource = sqlReader
.DataValueField = strValue
.DataTextField = strText
.DataBind()
End With
If blnAddFirstRow = True Then
If Val = 1 Then
lst.Items.Insert(0, (New ListItem("", 0)))
Else
If FirstItem = "" Then
lst.Items.Insert(0, (New ListItem("Select", 0)))
Else
lst.Items.Insert(0, (New ListItem(FirstItem, 0)))
End If
End If
End If
sqlReader.Close()
sqlcmd.Parameters.Clear()
End Sub
Public Sub FillList(ByRef rbutlst As RadioButtonList, ByRef cmd As SqlCommand, ByVal strSQL As String, ByVal strValue As String, ByVal strText As String, ByVal intSelValue As Integer)
Dim sqlReader As SqlDataReader
With cmd
.CommandText = strSQL
sqlReader = .ExecuteReader
.CommandType = CommandType.Text
End With
'sqlReader.
With rbutlst
.DataSource = sqlReader
.DataValueField = strValue
.DataTextField = strText
.DataBind()
End With
rbutlst.SelectedValue = intSelValue
sqlReader.Close()
cmd.Parameters.Clear()
End Sub
Public Sub FillList(ByRef chklst As CheckBoxList, ByRef cmd As SqlCommand, ByVal strSQL As String, ByVal strValue As String, ByVal strText As String, ByVal setvalues As Boolean)
Dim sqlReader As SqlDataReader
With cmd
.CommandText = strSQL
sqlReader = .ExecuteReader
.CommandType = CommandType.Text
End With
With sqlReader
While .Read()
Dim stritemvalue, stritemtext
stritemvalue = sqlReader.Item(strValue)
stritemtext = sqlReader(strText)
chklst.Items.Add(New ListItem(.Item(strText), .Item(strValue)))
'If System.Convert.ToBoolean(.Item(2)) = True Then
' chklst.Items.FindByValue(.Item(0)).Selected = True
'End If
End While
End With
sqlReader.Close()
cmd.Parameters.Clear()
End Sub
Public Function checkBox(ByRef c As CheckBox) As Integer
Dim int As Integer
If c.Checked = True Then
int = 1
Else
int = 0
End If
End Function
End Module
Public Class QuestionChoice
Private _Value As String
Private _Text As String
Public Sub New(ByVal Value As String, ByVal Text As String)
_Value = Value
_Text = Text
End Sub
Public ReadOnly Property Value() As String
Get
Return _Value
End Get
End Property
Public ReadOnly Property Text() As String
Get
Return _Text
End Get
End Property
End Class
Public Class ReportQuestion
Dim _questionText As String
Dim _questionNo As String
Public Property QuestionText() As String
Get
Return _questionText
End Get
Set(ByVal value As String)
_questionText = value
End Set
End Property
Public Property QuestionNo() As Integer
Get
Return _questionNo
End Get
Set(ByVal value As Integer)
_questionNo = value
End Set
End Property
End Class
Public Class SubColumnInfo
Public Sub New(ByVal Value As String, ByVal Text As String)
'MyBase.New(Value, Text)
End Sub
End Class
Public Class SubColumns
Private _Value As String
Private _Text As String
Public Sub New(ByVal Value As String, ByVal Text As String)
_Value = Value
_Text = Text
End Sub
Public ReadOnly Property Value() As String
Get
Return _Value
End Get
End Property
Public ReadOnly Property Text() As String
Get
Return _Text
End Get
End Property
End Class
Public Class RequiredFieldValidForCheckBoxLists
Inherits System.Web.UI.WebControls.BaseValidator
Private _listctrl As ListControl
Public Sub New()
MyBase.EnableClientScript = False
End Sub
Protected Overloads Overrides Function ControlPropertiesValid() As Boolean
Dim ctrl As Control = FindControl(ControlToValidate)
If Not (ctrl Is Nothing) Then
_listctrl = CType(ctrl, ListControl)
Return (Not (_listctrl Is Nothing))
Else
Return False
End If
End Function
Protected Overloads Overrides Function EvaluateIsValid() As Boolean
Return Not (_listctrl.SelectedIndex = -1)
End Function
End Class
Public Class ValidatiorchkBoxLst
Inherits System.Web.UI.WebControls.BaseValidator
Protected Overrides Function ControlPropertiesValid() As Boolean
Return True
End Function
Protected Overrides Function EvaluateIsValid() As Boolean
' Return this.EvaluateIsChecked()
Return EvaluateIsChecked()
End Function
Protected Overrides Sub OnPreRender(ByVal e As EventArgs)
' If MyBase.EnableClientScript Then
If EnableClientScript Then
'this.clientscript()
ClientScript()
End If
MyBase.OnPreRender(e)
End Sub
Protected Function EvaluateIsChecked() As Boolean
Dim _cbl As CheckBoxList
_cbl = CType(FindControl(ControlToValidate), CheckBoxList)
Dim li As ListItem
For Each li In _cbl.Items
If li.Selected = True Then
Return True
End If
Next
Return False
End Function
Protected Sub ClientScript()
MyBase.Attributes("evaluationfunction") = "cb_verify"
Dim sb_Script As New StringBuilder
sb_Script.Append("<script language='javascript'>")
sb_Script.Append("\r")
sb_Script.Append("\r")
sb_Script.Append("function cb_vefify(val) {")
sb_Script.Append("\r")
sb_Script.Append("var val = document.all[document.all(\")
sb_Script.Append(MyBase.ID)
sb_Script.Append("\).controltovalidate);")
sb_Script.Append("\r")
sb_Script.Append("var col = val.all;")
sb_Script.Append("\r")
sb_Script.Append("if ( col != null ) {")
sb_Script.Append("\r")
sb_Script.Append("for ( i = 0; i < col.length; i++ ) {")
sb_Script.Append("\r")
sb_Script.Append("if (col.item(i).tagName == \'INPUT\') {")
sb_Script.Append("\r")
sb_Script.Append("if ( col.item(i).checked ) {")
sb_Script.Append("\r")
sb_Script.Append("\r")
sb_Script.Append("return true;")
sb_Script.Append("\r")
sb_Script.Append("}")
sb_Script.Append("\r")
sb_Script.Append("}")
sb_Script.Append("\r")
sb_Script.Append("}")
sb_Script.Append("\r")
sb_Script.Append("\r")
sb_Script.Append("\r")
sb_Script.Append("return false;")
sb_Script.Append("\r")
sb_Script.Append("}")
sb_Script.Append("\r")
sb_Script.Append("}")
sb_Script.Append("\r")
sb_Script.Append("</script>")
'MyBase.Page.RegisterClientScriptBlock("RBLScript", sb_Script.ToString())
MyBase.Page.ClientScript.RegisterClientScriptBlock(GetType(String), "RBLScript", sb_Script.ToString)
End Sub
End Class
End Namespace