siwat/cudreg-saml2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

initial commit

Browse source
This commit is contained in:
Siwat Sirichai 2025-06-08 16:22:20 +07:00
commit 252dac3143
1516 changed files with 694271 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

176
App_Code/Shared/AccessParser.vb Normal file
View file

@ -0,0 +1,176 @@
Imports System
Imports System.Data
Imports System.Data.OleDb
Imports System.Configuration
Imports System.Text
Imports System.IO
Imports System.Collections
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Namespace Persons.UI
''' <summary>
''' Summary description for AccessParser
''' </summary>
Public Class AccessParser
Inherits Parser
Implements IDisposable
#Region "Private Member"
Private fileName As String = String.Empty
Private commandText As String = String.Empty
Private command As OleDbCommand = Nothing
Private connection As OleDbConnection = Nothing
Private reader As OleDbDataReader = Nothing
Private m_connectionString As String = String.Empty
Private _tableName As String = String.Empty
#End Region
#Region "Properties"
Friend ReadOnly Property ConnectionStringOne() As String
Get
If HttpContext.Current.Session("pwd") IsNot Nothing Then
Me.m_connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" + "Data Source=" + Me.fileName + ";" + "Jet OLEDB:Database Password=" + HttpContext.Current.Session("pwd").ToString() + ";"
Return Me.m_connectionString
Else
Me.m_connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" + "Data Source=" + Me.fileName + ";" + "Persist Security Info=False;"
Return Me.m_connectionString
End If
End Get
End Property
Friend ReadOnly Property ConnectionStringTwo() As String
Get
Me.m_connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" + "Data Source=" + Me.fileName + ";"
Return Me.m_connectionString
End Get
End Property
Friend ReadOnly Property TableName() As String
Get
If Not IsValidTableName(Me._tableName) Then
Dim aliasName As String = Me._tableName.Replace(" ", "_") & "_"
Return String.Format("[{0}][{1}]", Me._tableName, aliasName)
Else
Return Me._tableName
End If
End Get
End Property
Private Function IsValidTableName(ByVal tableName As String) As Boolean
Dim specialChar As Char() = New Char() {"~"c, "-"c, "!"c, "@"c, "#"c, "$"c, "%"c, "^"c, "&"c, "*"c, "("c, ")"c, "`"c, "|"c, "\"c, ":"c, ";"c, "'"c, "<"c, ","c, ">"c, "."c, "/"c, "?"c, "["c, "]"c, "{"c, "}"c}
If tableName.IndexOfAny(specialChar) > -1 Then
Return False
Else
Return True
End If
End Function
#End Region
Public Sub New(ByVal file As String, ByVal tableName As String)
'
' Add constructor logic here
'
Me.fileName = file
Dim merror As Boolean = False
Dim isConnectionOpen As Boolean = False
Me._tableName = tableName
Me.connection = New OleDbConnection(Me.ConnectionStringOne)
Me.commandText = "SELECT * FROM " + Me.TableName
Me.command = New OleDbCommand(Me.commandText, Me.connection)
Try
Me.connection.Open()
isConnectionOpen = True
Me.reader = Me.command.ExecuteReader()
Catch ex As Exception
If Not isConnectionOpen Then
Me.connection = Nothing
Me.command = Nothing
Me.connection = New OleDbConnection(Me.ConnectionStringTwo)
Me.command = New OleDbCommand(Me.commandText, Me.connection)
Try
Me.connection.Open()
Me.reader = Me.command.ExecuteReader()
Catch exe As Exception
merror = True
Throw New Exception(exe.Message)
End Try
If merror Then
If Me.connection.State = ConnectionState.Open AndAlso Me.connection IsNot Nothing Then
Me.connection.Close()
End If
Throw ex
End If
Else
If Me.connection.State = ConnectionState.Open AndAlso Me.connection IsNot Nothing Then
Me.connection.Close()
End If
Throw ex
End If
End Try
End Sub
#Region "Parser member"
Public Overloads Overrides Sub Reset()
' throw new NotImplementedException();
End Sub
Public Overloads Overrides Function GetNextRow() As String()
Dim row As New ArrayList()
Dim columnIndex As Integer = 0
If Me.connection.State <> ConnectionState.Closed Then
If Me.reader.Read() Then
For columns As Integer = 0 To Me.reader.FieldCount - 1
Try
row.Add(Me.reader(columnIndex).ToString())
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
columnIndex += 1
Next
End If
End If
If row.Count <> 0 Then
Return DirectCast(row.ToArray(GetType(String)), String())
End If
Return Nothing
End Function
Public Overloads Overrides Sub Close()
Me.reader.Close()
Me.reader = Nothing
Me.connection.Close()
Me.connection = Nothing
End Sub
#End Region
#Region "IDisposable Members"
Private Sub Dispose() Implements IDisposable.Dispose
'throw new NotImplementedException();
If Me.reader IsNot Nothing Then
Me.reader.Close()
Me.reader.Dispose()
End If
If Me.connection IsNot Nothing Then
Me.connection.Close()
Me.connection.Dispose()
End If
End Sub
#End Region
End Class
End Namespace

287
App_Code/Shared/BaseApplicationMenuControl.vb Normal file
View file

@ -0,0 +1,287 @@
Imports BaseClasses.Data
Imports BaseClasses.Utils.StringUtils
Imports BaseClasses.Resources
Namespace Persons.UI
' Typical customizations that may be done in this class include
' - adding custom event handlers
' - overriding base class methods
''' <summary>
''' The superclass (i.e. base class) for all Designer-generated user controls in this application.
''' </summary>
''' <remarks>
''' <para>
''' </para>
''' </remarks>
Public Class BaseApplicationMenuControl
Inherits BaseClasses.Web.UI.BaseMenuControl
' Variable used to prevent infinite loop
Private _modifyRedirectUrlInProgress As Boolean = False
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, False)
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, bEncrypt)
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Const PREFIX_NO_ENCODE As String = "NoUrlEncode:"
If (_modifyRedirectUrlInProgress) Then
Return Nothing
Else
_modifyRedirectUrlInProgress = True
End If
Dim finalRedirectUrl As String = redirectUrl
Dim finalRedirectArgument As String = redirectArgument
If (finalRedirectUrl Is Nothing OrElse finalRedirectUrl.Trim = "") Then
Return ""
ElseIf (finalRedirectUrl.IndexOf("{"c) < 0) Then
'RedirectUrl does not contain any format specifiers
_modifyRedirectUrlInProgress = False
Return finalRedirectUrl
Else
'The old way was to pass separate URL and arguments and use String.Format to
'do the replacement. Example:
' URL: EditProductsRecord?Products={0}
' Argument: PK
'The new way to is pass the arguments directly in the URL. Example:
' URL: EditProductsRecord?Products={PK}
'If the old way is passsed, convert it to the new way.
If (Len(redirectArgument) > 0) Then
Dim arguments() As String = Split(redirectArgument, ",")
Dim i As Integer
For i = 0 To (arguments.Length - 1)
finalRedirectUrl = finalRedirectUrl.Replace("{" & i.ToString & "}", "{" & arguments(i) & "}")
Next
finalRedirectArgument = ""
End If
'First find all the table and record controls in the page.
Dim controlList As ArrayList = GetAllRecordAndTableControls()
If controlList.Count = 0 Then
Return finalRedirectUrl
End If
' Store the controls in a hashtable using the control unique name
' as the key for easy refrence later in the function.
Dim controlIdList As New Hashtable
Dim control As System.Web.UI.Control
For Each control In controlList
controlIdList.Add(control.UniqueID, control)
Next
'Look at all of the expressions in the URL and forward processing
'to the appropriate controls.
'Expressions can be of the form [ControlName:][NoUrlEncode:]Key[:Value]
Dim forwardTo As New ArrayList
Dim remainingUrl As String = finalRedirectUrl
While (remainingUrl.IndexOf("{"c) >= 0) And (remainingUrl.IndexOf("}"c) > 0) And _
(remainingUrl.IndexOf("{"c) < remainingUrl.IndexOf("}"c))
Dim leftIndex As Integer = remainingUrl.IndexOf("{"c)
Dim rightIndex As Integer = remainingUrl.IndexOf("}"c)
Dim expression As String = remainingUrl.Substring(leftIndex + 1, rightIndex - leftIndex - 1)
remainingUrl = remainingUrl.Substring(rightIndex + 1)
Dim prefix As String = Nothing
If (expression.IndexOf(":") > 0) Then
prefix = expression.Substring(0, expression.IndexOf(":"))
End If
If (Not IsNothing(prefix)) AndAlso (prefix.Length > 0) AndAlso _
(Not (InvariantLCase(prefix) = InvariantLCase(PREFIX_NO_ENCODE))) AndAlso _
(Not BaseRecord.IsKnownExpressionPrefix(prefix)) Then
'The prefix is a control name. Add it to the list of controls that
'need to process the URL.
If (controlIdList.Contains(prefix)) And (Not forwardTo.Contains(prefix)) Then
forwardTo.Add(prefix)
End If
End If
End While
'Forward the request to each control in the forwardTo list
Dim containerId As String
For Each containerId In forwardTo
Dim ctl As Control = CType(controlIdList.Item(containerId), Control)
If (Not IsNothing(ctl)) Then
If TypeOf ctl Is BaseApplicationRecordControl Then
finalRedirectUrl = DirectCast(ctl, BaseApplicationRecordControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
ElseIf TypeOf ctl Is BaseApplicationTableControl Then
finalRedirectUrl = DirectCast(ctl, BaseApplicationTableControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
End If
End If
Next
'If there are any unresolved expressions, let the other naming containers
'have a crack at modifying the URL
For Each control In controlList
If (forwardTo.IndexOf(control.ID) < 0) Then
If TypeOf control Is BaseApplicationRecordControl Then
finalRedirectUrl = DirectCast(control, BaseApplicationRecordControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
ElseIf TypeOf control Is BaseApplicationTableControl Then
finalRedirectUrl = DirectCast(control, BaseApplicationTableControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
End If
End If
Next
End If
_modifyRedirectUrlInProgress = False
Return finalRedirectUrl
End Function
Private Function GetAllRecordAndTableControls() As ArrayList
Dim controlList As ArrayList = New ArrayList()
GetAllRecordAndTableControls(Me, controlList)
Return controlList
End Function
Private Sub GetAllRecordAndTableControls(ByVal ctl As Control, ByVal controlList As ArrayList)
If ctl Is Nothing Then
Return
End If
If TypeOf ctl Is BaseApplicationRecordControl OrElse _
TypeOf ctl Is BaseApplicationTableControl Then
controlList.Add(ctl)
End If
Dim nextCtl As Control
For Each nextCtl In ctl.Controls()
GetAllRecordAndTableControls(nextCtl, controlList)
Next
End Sub
#Region " Methods to manage saving and retrieving control values to session. "
Protected Sub Control_SaveControls_Unload(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Unload
If DirectCast(Me.Page, BaseApplicationPage).ShouldSaveControlsToSession Then
Me.SaveControlsToSession()
End If
End Sub
Protected Overridable Sub SaveControlsToSession()
End Sub
Public Overridable Sub SetChartControl(ByVal chartCtrlName As String)
End Sub
Protected Sub Control_ClearControls_PreRender(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.PreRender
Me.ClearControlsFromSession()
End Sub
Protected Overridable Sub ClearControlsFromSession()
End Sub
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal value As String)
SaveToSession(control.UniqueID, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID, defaultValue)
End Function
Public Function GetFromSession(ByVal control As Control) As String
Return GetFromSession(control.UniqueID, Nothing)
End Function
Public Sub RemoveFromSession(ByVal control As Control)
RemoveFromSession(control.UniqueID)
End Sub
Public Function InSession(ByVal control As Control) As Boolean
Return InSession(control.UniqueID)
End Function
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal value As String)
SaveToSession(control.UniqueID & variable, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID & variable, defaultValue)
End Function
Public Sub RemoveFromSession( _
ByVal control As Control, _
ByVal variable As String)
RemoveFromSession(control.UniqueID & variable)
End Sub
Public Function InSession( _
ByVal control As Control, _
ByVal variable As String) As Boolean
Return InSession(control.UniqueID & variable)
End Function
Public Sub SaveToSession( _
ByVal name As String, _
ByVal value As String)
Me.Page.Session()(GetValueKey(name)) = value
End Sub
Public Function GetFromSession( _
ByVal name As String, _
ByVal defaultValue As String) As String
Dim value As String = CType(Me.Page.Session()(GetValueKey(name)), String)
If value Is Nothing OrElse value.Trim() = "" Then
value = defaultValue
End If
Return value
End Function
Public Function GetFromSession(ByVal name As String) As String
Return GetFromSession(name, Nothing)
End Function
Public Sub RemoveFromSession(ByVal name As String)
Me.Page.Session.Remove(GetValueKey(name))
End Sub
Public Function InSession(ByVal name As String) As Boolean
Return (Not Me.Page.Session(GetValueKey(name)) Is Nothing)
End Function
Public Function GetValueKey(ByVal name As String) As String
Return Me.Page.Session.SessionID & Me.Page.AppRelativeVirtualPath & name
End Function
#End Region
Public Function GetResourceValue(ByVal keyVal As String, ByVal appName As String) As String
Return AppResources.GetResourceValue(keyVal, appName)
End Function
Public Function GetResourceValue(ByVal keyVal As String) As String
Return AppResources.GetResourceValue(keyVal, Nothing)
End Function
End Class
End Namespace

1268
App_Code/Shared/BaseApplicationPage.vb Normal file
View file

File diff suppressed because it is too large Load diff

414
App_Code/Shared/BaseApplicationRecordControl.vb Normal file
View file

@ -0,0 +1,414 @@
Imports BaseClasses
Imports BaseClasses.Data
Imports BaseClasses.Utils
Imports BaseClasses.Utils.StringUtils
Namespace Persons.UI
' Typical customizations that may be done in this class include
' - adding custom event handlers
' - overriding base class methods
''' <summary>
''' The superclass (i.e. base class) for all Designer-generated record controls in this application.
''' </summary>
''' <remarks>
''' <para>
''' </para>
''' </remarks>
Public Class BaseApplicationRecordControl
Inherits System.Web.UI.Control
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String) As String
Throw New Exception("This function should be implemented by inherited record control class.")
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Throw New Exception("This function should be implemented by inherited record control class.")
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Throw New Exception("This function should be implemented by inherited record control class.")
End Function
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, rec, False)
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord, ByVal bEncrypt As Boolean) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, rec, bEncrypt)
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord, ByVal bEncrypt As Boolean) As String
Const PREFIX_NO_ENCODE As String = "NoUrlEncode:"
Dim finalRedirectUrl As String = redirectUrl
Dim finalRedirectArgument As String = redirectArgument
If (finalRedirectUrl Is Nothing OrElse finalRedirectUrl.Trim = "") Then
Return finalRedirectUrl
ElseIf (finalRedirectUrl.IndexOf("{"c) < 0) Then
Return finalRedirectUrl
Else
'The old way was to pass separate URL and arguments and use String.Format to
'do the replacement. Example:
' URL: EditProductsRecord?Products={0}
' Argument: PK
'The new way to is pass the arguments directly in the URL. Example:
' URL: EditProductsRecord?Products={PK}
'If the old way is passsed, convert it to the new way.
If (Len(finalRedirectArgument) > 0) Then
Dim arguments() As String = Split(finalRedirectArgument, ",")
Dim i As Integer
For i = 0 To (arguments.Length - 1)
finalRedirectUrl = finalRedirectUrl.Replace("{" & i.ToString & "}", "{" & arguments(i) & "}")
Next
finalRedirectArgument = ""
End If
'Evaluate all of the expressions in the RedirectURL
'Expressions can be of the form [ControlName:][NoUrlEncode:]Key[:Value]
Dim remainingUrl As String = finalRedirectUrl
While (remainingUrl.IndexOf("{"c) >= 0) And (remainingUrl.IndexOf("}"c) > 0) And _
(remainingUrl.IndexOf("{"c) < remainingUrl.IndexOf("}"c))
Dim leftIndex As Integer = remainingUrl.IndexOf("{"c)
Dim rightIndex As Integer = remainingUrl.IndexOf("}"c)
Dim expression As String = remainingUrl.Substring(leftIndex + 1, rightIndex - leftIndex - 1)
Dim origExpression As String = expression
remainingUrl = remainingUrl.Substring(rightIndex + 1)
Dim skip As Boolean = False
Dim returnEmptyStringOnFail As Boolean = False
Dim prefix As String = Nothing
'Check to see if this control must evaluate the expression
If (expression.IndexOf(":") > 0) Then
prefix = expression.Substring(0, expression.IndexOf(":"))
End If
If (Not IsNothing(prefix)) AndAlso (prefix.Length > 0) AndAlso _
(Not (InvariantLCase(prefix) = InvariantLCase(PREFIX_NO_ENCODE))) AndAlso _
(Not BaseRecord.IsKnownExpressionPrefix(prefix)) Then
'Remove the ASCX Prefix
Dim IdString As String = Me.ID
If IdString.StartsWith("_") Then
IdString = IdString.Remove(0, 1)
End If
'The prefix is a control name.
If (prefix = IdString) Then
'This control is responsible for evaluating the expression,
'so if it can't be evaluated then return an empty string.
returnEmptyStringOnFail = True
expression = expression.Substring(expression.IndexOf(":") + 1)
Else
'It's not for this control to evaluate so skip.
skip = True
End If
End If
If (Not skip) Then
Dim bUrlEncode As Boolean = True
If (InvariantLCase(expression).StartsWith(InvariantLCase(PREFIX_NO_ENCODE))) Then
bUrlEncode = False
expression = expression.Substring(PREFIX_NO_ENCODE.Length)
End If
Dim result As Object = Nothing
Try
If (Not IsNothing(rec)) Then
result = rec.EvaluateExpression(expression)
End If
Catch ex As Exception
'Fall through
End Try
If (Not IsNothing(result)) Then
result = result.ToString()
End If
If (IsNothing(result)) Then
If (Not returnEmptyStringOnFail) Then
Return finalRedirectUrl
Else
result = String.Empty
End If
End If
If (bUrlEncode) Then
result = System.Web.HttpUtility.UrlEncode(DirectCast(result, String))
If (IsNothing(result)) Then
result = String.Empty
End If
End If
If (bEncrypt) Then
If Not (IsNothing(result)) Then
result = DirectCast(Me.Page, BaseApplicationPage).Encrypt(DirectCast(result, String))
End If
End If
finalRedirectUrl = finalRedirectUrl.Replace("{" & origExpression & "}", DirectCast(result, String))
End If
End While
End If
'If there are still expressions to evaluate. Forward to the page for further processing.
Return finalRedirectUrl
End Function
''' <summary>
''' Get the Id of the parent table control. We navigate up the chain of
''' controls until we find the table control. Note that the first table
''' control above the record control would be the parent. You cannot have
''' a record control embedded in a different parent control other than its parent.
''' </summary>
''' <returns>The Id of the parent table control.</returns>
Public Overridable Function GetParentTableControlID() As String
Dim parent As BaseApplicationTableControl = Me.GetParentTableControl()
If Not (IsNothing(parent)) Then Return parent.ID
Return ""
End Function
#Region " Methods to manage saving and retrieving control values to session. "
Protected Sub Control_SaveControls_Unload(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Unload
If DirectCast(Me.Page, BaseApplicationPage).ShouldSaveControlsToSession Then
Me.SaveControlsToSession()
End If
End Sub
Protected Overridable Sub SaveControlsToSession()
End Sub
Protected Sub Control_ClearControls_PreRender(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.PreRender
Me.ClearControlsFromSession()
End Sub
Protected Overridable Sub ClearControlsFromSession()
End Sub
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal value As String)
SaveToSession(control.UniqueID, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID, defaultValue)
End Function
Public Function GetFromSession(ByVal control As Control) As String
Return GetFromSession(control.UniqueID, Nothing)
End Function
Public Sub RemoveFromSession(ByVal control As Control)
RemoveFromSession(control.UniqueID)
End Sub
Public Function InSession(ByVal control As Control) As Boolean
Return InSession(control.UniqueID)
End Function
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal value As String)
SaveToSession(control.UniqueID & variable, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID & variable, defaultValue)
End Function
Public Sub RemoveFromSession( _
ByVal control As Control, _
ByVal variable As String)
RemoveFromSession(control.UniqueID & variable)
End Sub
Public Function InSession( _
ByVal control As Control, _
ByVal variable As String) As Boolean
Return InSession(control.UniqueID & variable)
End Function
Public Sub SaveToSession( _
ByVal name As String, _
ByVal value As String)
Me.Page.Session()(GetValueKey(name)) = value
End Sub
Public Function GetFromSession( _
ByVal name As String, _
ByVal defaultValue As String) As String
Dim value As String = CType(Me.Page.Session()(GetValueKey(name)), String)
If value Is Nothing OrElse value.Trim() = "" Then
value = defaultValue
End If
Return value
End Function
Public Function GetFromSession(ByVal name As String) As String
Return GetFromSession(name, Nothing)
End Function
Public Sub RemoveFromSession(ByVal name As String)
Me.Page.Session.Remove(GetValueKey(name))
End Sub
Public Function InSession(ByVal name As String) As Boolean
Return (Not Me.Page.Session(GetValueKey(name)) Is Nothing)
End Function
Public Function GetValueKey(ByVal name As String) As String
Return Me.Page.Session.SessionID & Me.Page.AppRelativeVirtualPath & name
End Function
#End Region
''' <summary>
''' Get the parent table control. We navigate up the chain of
''' controls until we find the table control. Note that the first table
''' control above the record control would be the parent. You cannot have
''' a record control embedded in a different parent control other than its parent.
''' </summary>
''' <returns>The Id of the parent table control.</returns>
Public Overridable Function GetParentTableControl() As BaseApplicationTableControl
Try
Dim parent As Control = Me.Parent
While Not (IsNothing(parent))
If TypeOf parent Is BaseApplicationTableControl Then
Return CType(parent, BaseApplicationTableControl)
End If
parent = parent.Parent
End While
Catch ex As Exception
' Ignore and return Nothing
End Try
Return Nothing
End Function
''' <summary>
''' The row number of this record control within the table control.
''' This function is called as {TableName}TableControlRow.ROWNUM().
''' To make sure all the formula functions are in the same location, we call
''' the ROWNUM function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' The row number is 1 based.
''' </summary>
''' <returns>The row number of this row relative to the other rows in the table control.</returns>
Public Function RowNum() As Decimal
Return FormulaUtils.RowNum(Me.GetParentTableControl(), Me)
End Function
''' <summary>
''' The rank of this field relative to other fields in the table control.
''' This function is called as {TableName}TableControlRow.RANK().
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' Their respecitive ranks will be 4, 3, 1, 2, 5
''' To make sure all the formula functions are in the same location, we call
''' the RANK function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' The rank is 1 based.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The rank of this row relative to the other rows in the table control..</returns>
Public Function Rank(ByVal controlName As String) As Decimal
Return FormulaUtils.Rank(Me.GetParentTableControl(), Me, controlName)
End Function
''' <summary>
''' The running total of the field.
''' This function is called as {TableName}TableControlRow.RUNNINGTOTAL().
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' The respecitive values for running totals will be be 57, 89, 101, 120, 218
''' To make sure all the formula functions are in the same location, we call
''' the RUNNINGTOTAL function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The running total of the row.</returns>
Public Function RunningTotal(ByVal controlName As String) As Decimal
Return FormulaUtils.RunningTotal(Me.GetParentTableControl(), Me, controlName)
End Function
''' <summary>
''' Store the UI data within the current record or row control and return as hashtable
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Overridable Function PreservedUIData() As Hashtable
' This method get the UI data within the current record and return them as Hastable
Dim uiData As New Hashtable
Dim controls() As Control = BaseClasses.Utils.MiscUtils.FindControlsRecursively(Me)
For Each control As Control In controls
If control.ID <> "" AndAlso Not uiData.ContainsKey(control.ID) Then
If control.GetType() Is GetType(TextBox) Then
Dim textbox As TextBox = DirectCast(control, TextBox)
uiData.Add(textbox.ID, textbox.Text)
ElseIf control.GetType() Is GetType(Literal) Then
Dim literal As Literal = DirectCast(control, Literal)
uiData.Add(literal.ID, literal.Text)
ElseIf control.GetType() Is GetType(Label) Then
Dim label As Label = DirectCast(control, Label)
uiData.Add(label.ID, label.Text)
ElseIf control.GetType() Is GetType(CheckBox) Then
Dim checkbox As CheckBox = DirectCast(control, CheckBox)
uiData.Add(checkbox.ID, checkbox.Checked)
ElseIf control.GetType() Is GetType(Button) Then
Dim button As Button = DirectCast(control, Button)
uiData.Add(button.ID, button.Text)
ElseIf control.GetType() Is GetType(LinkButton) Then
Dim linkButton As LinkButton = DirectCast(control, LinkButton)
uiData.Add(linkButton.ID, linkButton.Text)
ElseIf control.GetType() Is GetType(ListBox) Then
Dim listbox As ListBox = DirectCast(control, ListBox)
uiData.Add(listbox.ID, GetValueSelectedPageRequest(listbox))
ElseIf control.GetType() Is GetType(DropDownList) Then
Dim dropdownList As DropDownList = DirectCast(control, DropDownList)
uiData.Add(dropdownList.ID, GetValueSelectedPageRequest(dropdownList))
ElseIf control.GetType() Is GetType(DropDownList) Then
Dim radioButtonList As RadioButtonList = DirectCast(control, RadioButtonList)
uiData.Add(radioButtonList.ID, GetValueSelectedPageRequest(radioButtonList))
ElseIf control.GetType().GetInterface("IDatePagination") IsNot Nothing OrElse _
control.GetType().GetInterface("IDatePaginationMobile") IsNot Nothing Then
' Save the pagination's Interval and FirstStartDate and restore it by these values later
Dim props() As System.Reflection.PropertyInfo = control.GetType().GetProperties()
Dim ht As New Hashtable
For Each prop As System.Reflection.PropertyInfo In props
Dim descriptor As System.ComponentModel.PropertyDescriptor = System.ComponentModel.TypeDescriptor.GetProperties(control.GetType())(prop.Name)
If descriptor.Name = "Interval" Then
ht.Add("Interval", prop.GetValue(control, Nothing).ToString())
ElseIf descriptor.Name = "FirstStartDate" Then
ht.Add("FirstStartDate", prop.GetValue(control, Nothing).ToString())
End If
Next
uiData.Add(control.ID, ht)
End If
End If
Next
Return uiData
End Function
End Class
End Namespace

531
App_Code/Shared/BaseApplicationTableControl.vb Normal file
View file

@ -0,0 +1,531 @@

Imports BaseClasses
Imports BaseClasses.Data
Imports BaseClasses.Utils.StringUtils
Namespace Persons.UI
' Typical customizations that may be done in this class include
' - adding custom event handlers
' - overriding base class methods
''' <summary>
''' The superclass (i.e. base class) for all Designer-generated pages in this application.
''' </summary>
''' <remarks>
''' <para>
''' </para>
''' </remarks>
Public Class BaseApplicationTableControl
Inherits System.Web.UI.Control
''' <summary>
''' The name of the row controls. By convention, "Row" is appended to the
''' end of the name of the table control. So OrdersTableControl will have
''' OrdersTableControlRow controls.
''' </summary>
Public Overridable ReadOnly Property RowName() As String
Get
Return Me.ID & "Row"
End Get
End Property
''' <summary>
''' The name of the repeater controls. By convention, "Repeater" is appended to the
''' end of the name of the table control. So OrdersTableControl will have
''' OrdersTableControlRepeater controls. The Row controls defined above are
''' within the Repeater control.
''' </summary>
Public Overridable ReadOnly Property RepeaterName() As String
Get
Return Me.ID & "Repeater"
End Get
End Property
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String) As String
Throw New Exception("This function should be implemented by inherited table control class.")
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Throw New Exception("This function should be implemented by inherited table control class.")
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Throw New Exception("This function should be implemented by inherited table control class.")
End Function
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, rec, False)
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord, ByVal bEncrypt As Boolean) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, rec, bEncrypt)
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal rec As IRecord, ByVal bEncrypt As Boolean) As String
Const PREFIX_NO_ENCODE As String = "NoUrlEncode:"
Dim finalRedirectUrl As String = redirectUrl
Dim finalRedirectArgument As String = redirectArgument
If (finalRedirectUrl Is Nothing OrElse finalRedirectUrl.Trim = "") Then
Return finalRedirectUrl
ElseIf (finalRedirectUrl.IndexOf("{"c) < 0) Then
Return finalRedirectUrl
Else
'The old way was to pass separate URL and arguments and use String.Format to
'do the replacement. Example:
' URL: EditProductsRecord?Products={0}
' Argument: PK
'The new way to is pass the arguments directly in the URL. Example:
' URL: EditProductsRecord?Products={PK}
'If the old way is passsed, convert it to the new way.
If (Len(finalRedirectArgument) > 0) Then
Dim arguments() As String = Split(finalRedirectArgument, ",")
Dim i As Integer
For i = 0 To (arguments.Length - 1)
finalRedirectUrl = finalRedirectUrl.Replace("{" & i.ToString & "}", "{" & arguments(i) & "}")
Next
finalRedirectArgument = ""
End If
'Evaluate all of the expressions in the RedirectURL
'Expressions can be of the form [ControlName:][NoUrlEncode:]Key[:Value]
Dim remainingUrl As String = finalRedirectUrl
While (remainingUrl.IndexOf("{"c) >= 0) And (remainingUrl.IndexOf("}"c) > 0) And _
(remainingUrl.IndexOf("{"c) < remainingUrl.IndexOf("}"c))
Dim leftIndex As Integer = remainingUrl.IndexOf("{"c)
Dim rightIndex As Integer = remainingUrl.IndexOf("}"c)
Dim expression As String = remainingUrl.Substring(leftIndex + 1, rightIndex - leftIndex - 1)
Dim origExpression As String = expression
remainingUrl = remainingUrl.Substring(rightIndex + 1)
Dim skip As Boolean = False
Dim returnEmptyStringOnFail As Boolean = False
Dim prefix As String = Nothing
'Check to see if this control must evaluate the expression
If (expression.IndexOf(":") > 0) Then
prefix = expression.Substring(0, expression.IndexOf(":"))
End If
If (Not IsNothing(prefix)) AndAlso (prefix.Length > 0) AndAlso _
(Not (InvariantLCase(prefix) = InvariantLCase(PREFIX_NO_ENCODE))) AndAlso _
(Not BaseRecord.IsKnownExpressionPrefix(prefix)) Then
'Remove the ASCX Prefix
Dim IdString As String = Me.ID
If IdString.StartsWith("_") Then
IdString = IdString.Remove(0, 1)
End If
'The prefix is a control name.
If (prefix = IdString) Then
'This control is responsible for evaluating the expression,
'so if it can't be evaluated then return an empty string.
returnEmptyStringOnFail = True
expression = expression.Substring(expression.IndexOf(":") + 1)
Else
'It's not for this control to evaluate so skip.
skip = True
End If
End If
If (Not skip) Then
Dim bUrlEncode As Boolean = True
If (InvariantLCase(expression).StartsWith(InvariantLCase(PREFIX_NO_ENCODE))) Then
bUrlEncode = False
expression = expression.Substring(PREFIX_NO_ENCODE.Length)
End If
Dim result As Object = Nothing
Try
If (Not IsNothing(rec)) Then
result = rec.EvaluateExpression(expression)
End If
Catch ex As Exception
'Fall through
End Try
If (Not IsNothing(result)) Then
result = result.ToString()
End If
If (IsNothing(result)) Then
If (Not returnEmptyStringOnFail) Then
Return finalRedirectUrl
Else
result = String.Empty
End If
End If
If (bUrlEncode) Then
result = System.Web.HttpUtility.UrlEncode(DirectCast(result, String))
If (IsNothing(result)) Then
result = String.Empty
End If
End If
If (bEncrypt) Then
If Not (IsNothing(result)) Then
result = DirectCast(Me.Page, BaseApplicationPage).Encrypt(DirectCast(result, String))
End If
End If
finalRedirectUrl = finalRedirectUrl.Replace("{" & origExpression & "}", DirectCast(result, String))
End If
End While
End If
'If there are still expressions to evaluate. Forward to the page for further processing.
Return finalRedirectUrl
End Function
Public Function AreAnyUrlParametersForMe(ByVal url As String, ByVal arg As String) As Boolean
Const PREFIX_NO_ENCODE As String = "NoUrlEncode:"
Dim finalRedirectUrl As String = url
Dim finalRedirectArgument As String = arg
If (Len(finalRedirectArgument) > 0) Then
Dim arguments() As String = Split(finalRedirectArgument, ",")
Dim i As Integer
For i = 0 To (arguments.Length - 1)
finalRedirectUrl = finalRedirectUrl.Replace("{" & i.ToString & "}", "{" & arguments(i) & "}")
Next
finalRedirectArgument = ""
End If
'Evaluate all of the expressions in the RedirectURL
'Expressions can be of the form [ControlName:][NoUrlEncode:]Key[:Value]
Dim remainingUrl As String = finalRedirectUrl
Dim skip As Boolean = False
While (remainingUrl.IndexOf("{"c) >= 0) And (remainingUrl.IndexOf("}"c) > 0) And _
(remainingUrl.IndexOf("{"c) < remainingUrl.IndexOf("}"c))
Dim leftIndex As Integer = remainingUrl.IndexOf("{"c)
Dim rightIndex As Integer = remainingUrl.IndexOf("}"c)
Dim expression As String = remainingUrl.Substring(leftIndex + 1, rightIndex - leftIndex - 1)
Dim origExpression As String = expression
remainingUrl = remainingUrl.Substring(rightIndex + 1)
Dim returnEmptyStringOnFail As Boolean = False
Dim prefix As String = Nothing
'Check to see if this control must evaluate the expression
If (expression.IndexOf(":") > 0) Then
prefix = expression.Substring(0, expression.IndexOf(":"))
End If
If (Not IsNothing(prefix)) AndAlso (prefix.Length > 0) AndAlso _
(Not (InvariantLCase(prefix) = InvariantLCase(PREFIX_NO_ENCODE))) AndAlso _
(Not BaseRecord.IsKnownExpressionPrefix(prefix)) Then
'The prefix is a control name.
If (prefix = Me.ID) Then
skip = False
Exit While
Else
'It's not for this control to evaluate so skip.
skip = True
End If
End If
End While
If skip Then
Return False
End If
Return True
End Function
#Region " Methods to manage saving and retrieving control values to session. "
Protected Sub Control_SaveControls_Unload(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Unload
If DirectCast(Me.Page, BaseApplicationPage).ShouldSaveControlsToSession Then
Me.SaveControlsToSession()
End If
End Sub
Protected Overridable Sub SaveControlsToSession()
End Sub
Protected Sub Control_ClearControls_PreRender(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.PreRender
Me.ClearControlsFromSession()
End Sub
Protected Overridable Sub ClearControlsFromSession()
End Sub
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal value As String)
SaveToSession(control.UniqueID, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID, defaultValue)
End Function
Public Function GetFromSession(ByVal control As Control) As String
Return GetFromSession(control.UniqueID, Nothing)
End Function
Public Sub RemoveFromSession(ByVal control As Control)
RemoveFromSession(control.UniqueID)
End Sub
Public Function InSession(ByVal control As Control) As Boolean
Return InSession(control.UniqueID)
End Function
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal value As String)
SaveToSession(control.UniqueID & variable, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID & variable, defaultValue)
End Function
Public Sub RemoveFromSession( _
ByVal control As Control, _
ByVal variable As String)
RemoveFromSession(control.UniqueID & variable)
End Sub
Public Function InSession( _
ByVal control As Control, _
ByVal variable As String) As Boolean
Return InSession(control.UniqueID & variable)
End Function
Public Sub SaveToSession( _
ByVal name As String, _
ByVal value As String)
Me.Page.Session()(GetValueKey(name)) = value
End Sub
Public Function GetFromSession( _
ByVal name As String, _
ByVal defaultValue As String) As String
Dim value As String = CType(Me.Page.Session()(GetValueKey(name)), String)
If value Is Nothing OrElse value.Trim() = "" Then
value = defaultValue
End If
Return value
End Function
Public Function GetFromSession(ByVal name As String) As String
Return GetFromSession(name, Nothing)
End Function
Public Sub RemoveFromSession(ByVal name As String)
Me.Page.Session.Remove(GetValueKey(name))
End Sub
Public Function InSession(ByVal name As String) As Boolean
Return (Not Me.Page.Session(GetValueKey(name)) Is Nothing)
End Function
Public Function GetValueKey(ByVal name As String) As String
Return Me.Page.Session.SessionID & Me.Page.AppRelativeVirtualPath & name
End Function
#End Region
''' <summary>
''' This function returns the list of record controls within the table control.
''' There is a more specific GetRecordControls function generated in the
''' derived classes, but in some cases, we do not know the specific type of
''' the table control, so we need to call this method. This is also used by the
''' Formula evaluator to perform Sum, Count and CountA functions.
''' </summary>
Public Function GetBaseRecordControls() As BaseApplicationRecordControl()
Dim recList As ArrayList = New ArrayList()
' First get the repeater inside the Table Control.
Dim rep As System.Web.UI.WebControls.Repeater = CType(Me.FindControl(Me.RepeaterName), System.Web.UI.WebControls.Repeater)
If IsNothing(rep) OrElse IsNothing(rep.Items) Then Return Nothing
' We now go inside the repeater to find all the record controls.
' Note that we only find the first level record controls. We do not
' descend down and find other record controls belonging to tables-inside-table.
Dim repItem As System.Web.UI.WebControls.RepeaterItem
For Each repItem In rep.Items
Dim recControl As BaseApplicationRecordControl = DirectCast(repItem.FindControl(Me.RowName), BaseApplicationRecordControl)
If Not (IsNothing(recControl)) Then recList.Add(recControl)
Next
Return DirectCast(recList.ToArray(GetType(BaseApplicationRecordControl)), BaseApplicationRecordControl())
End Function
''' <summary>
''' Sum the values of the displayed controls. The controlName must be
''' a textbox, label or literal.
''' This function is called as [Products]TableControl.SUM("UnitPrice").
''' To make sure all the formula functions are in the same location, we call
''' the SUM function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Function Sum(ByVal controlName As String) As Decimal
Return FormulaUtils.Sum(Me, controlName)
End Function
''' <summary>
''' Sum the values of the displayed controls. The controlName must be
''' a textbox, label or literal.
''' This function is called as [Products]TableControl.TOTAL("UnitPrice").
''' To make sure all the formula functions are in the same location, we call
''' the TOTAL function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Function Total(ByVal controlName As String) As Decimal
Return FormulaUtils.Total(Me, controlName)
End Function
''' <summary>
''' Finds the maximum among the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.Max("UnitPrice"), not
''' as shown here. The MAX function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The maximum among the values contained in each of the fields.</returns>
Public Function Max(ByVal ctlName As String) As Decimal
Return FormulaUtils.Max(Me, ctlName)
End Function
''' <summary>
''' Finds the minimum among the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.Min("UnitPrice"), not
''' as shown here. The MIN function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The minimum among the values contained in each of the fields.</returns>
Public Function Min(ByVal ctlName As String) As Decimal
Return FormulaUtils.Min(Me, ctlName)
End Function
''' <summary>
''' Count the number of rows in the table control.
''' This function is called as [Products]TableControl.COUNT().
''' To make sure all the formula functions are in the same location, we call
''' the COUNT function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <returns>The total number of rows in the table control.</returns>
Public Function Count(ByVal controlName As String) As Decimal
Return FormulaUtils.Count(Me, controlName)
End Function
''' <summary>
''' Count the number of rows in the table control that are non-blank.
''' This function is called as [Products]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the COUNTA function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function CountA(ByVal controlName As String) As Decimal
Return FormulaUtils.CountA(Me, controlName)
End Function
''' <summary>
''' Mean of the rows in the table control.
''' This function is called as [Product]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the MEAN function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function Mean(ByVal controlName As String) As Decimal
Return FormulaUtils.Mean(Me, controlName)
End Function
''' <summary>
''' Average of the rows in the table control.
''' This function is called as [Product]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the AVERAGE function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function Average(ByVal controlName As String) As Decimal
Return FormulaUtils.Average(Me, controlName)
End Function
''' <summary>
''' Mode of the rows in the table control.
''' This function is called as [Product]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the MODE function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function Mode(ByVal controlName As String) As Decimal
Return FormulaUtils.Mode(Me, controlName)
End Function
''' <summary>
''' Median of the rows in the table control.
''' This function is called as [Product]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the MEDIAN function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function Median(ByVal controlName As String) As Decimal
Return FormulaUtils.Median(Me, controlName)
End Function
''' <summary>
''' Range of the rows in the table control.
''' This function is called as [Product]TableControl.COUNTA().
''' To make sure all the formula functions are in the same location, we call
''' the RANGE function in the FormulaUtils class, which actually does the work
''' and return the value. The function in FormulaUtils will need to know the
''' TableControl, so it is passed as the first instance.
''' </summary>
''' <param name="controlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total number of rows in the table control.</returns>
Public Function Range(ByVal controlName As String) As Decimal
Return FormulaUtils.Range(Me, controlName)
End Function
End Class
End Namespace

383
App_Code/Shared/BaseApplicationUserControl.vb Normal file
View file

@ -0,0 +1,383 @@
Imports BaseClasses.Data
Imports BaseClasses.Utils.StringUtils
Namespace Persons.UI
' Typical customizations that may be done in this class include
' - adding custom event handlers
' - overriding base class methods
''' <summary>
''' The superclass (i.e. base class) for all Designer-generated user controls in this application.
''' </summary>
''' <remarks>
''' <para>
''' </para>
''' </remarks>
Public Class BaseApplicationUserControl
Inherits BaseClasses.Web.UI.BaseUserControl
' Variable used to prevent infinite loop
Private _modifyRedirectUrlInProgress As Boolean = False
''' Allow for migration from earlier versions which did not have url encryption.
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, False)
End Function
Public Overridable Function ModifyRedirectUrl(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Return EvaluateExpressions(redirectUrl, redirectArgument, bEncrypt)
End Function
Public Overridable Function EvaluateExpressions(ByVal redirectUrl As String, ByVal redirectArgument As String, ByVal bEncrypt As Boolean) As String
Const PREFIX_NO_ENCODE As String = "NoUrlEncode:"
If (_modifyRedirectUrlInProgress) Then
Return Nothing
Else
_modifyRedirectUrlInProgress = True
End If
Dim finalRedirectUrl As String = redirectUrl
Dim finalRedirectArgument As String = redirectArgument
If (finalRedirectUrl Is Nothing OrElse finalRedirectUrl.Trim = "") Then
Return ""
ElseIf (finalRedirectUrl.IndexOf("{"c) < 0) Then
'RedirectUrl does not contain any format specifiers
_modifyRedirectUrlInProgress = False
Return finalRedirectUrl
Else
'The old way was to pass separate URL and arguments and use String.Format to
'do the replacement. Example:
' URL: EditProductsRecord?Products={0}
' Argument: PK
'The new way to is pass the arguments directly in the URL. Example:
' URL: EditProductsRecord?Products={PK}
'If the old way is passsed, convert it to the new way.
If (Len(redirectArgument) > 0) Then
Dim arguments() As String = Split(redirectArgument, ",")
Dim i As Integer
For i = 0 To (arguments.Length - 1)
finalRedirectUrl = finalRedirectUrl.Replace("{" & i.ToString & "}", "{" & arguments(i) & "}")
Next
finalRedirectArgument = ""
End If
'First find all the table and record controls in the page.
Dim controlList As ArrayList = GetAllRecordAndTableControls()
If controlList.Count = 0 Then
Return finalRedirectUrl
End If
' Store the controls in a hashtable using the control unique name
' as the key for easy refrence later in the function.
Dim controlIdList As New Hashtable
Dim control As System.Web.UI.Control
Dim found As Boolean = False
For Each control In controlList
Dim uID As String = control.UniqueID
Dim pageContentIndex As Integer = uID.IndexOf("$PageContent$")
If pageContentIndex > 0 Then
If found = False Then
'Remove all controls without $PageContent$ prefix, because this page is used with Master Page
'and these entries are irrelevant
controlIdList.Clear()
End If
found = True
End If
If found Then
'If we found that Master Page is used for this page construction than disregard all controls
'without $PageContent$ prefix
If pageContentIndex > 0 Then
uID = uID.Substring(pageContentIndex + "$PageContent$".Length)
controlIdList.Add(uID, control)
End If
Else
'No Master Page presense found so far
controlIdList.Add(uID, control)
End If
Next
'Look at all of the expressions in the URL and forward processing
'to the appropriate controls.
'Expressions can be of the form [ControlName:][NoUrlEncode:]Key[:Value]
Dim forwardTo As New ArrayList
Dim remainingUrl As String = finalRedirectUrl
While (remainingUrl.IndexOf("{"c) >= 0) And (remainingUrl.IndexOf("}"c) > 0) And _
(remainingUrl.IndexOf("{"c) < remainingUrl.IndexOf("}"c))
Dim leftIndex As Integer = remainingUrl.IndexOf("{"c)
Dim rightIndex As Integer = remainingUrl.IndexOf("}"c)
Dim expression As String = remainingUrl.Substring(leftIndex + 1, rightIndex - leftIndex - 1)
remainingUrl = remainingUrl.Substring(rightIndex + 1)
Dim prefix As String = Nothing
If (expression.IndexOf(":") > 0) Then
prefix = expression.Substring(0, expression.IndexOf(":"))
End If
If (Not IsNothing(prefix)) AndAlso (prefix.Length > 0) AndAlso _
(Not (InvariantLCase(prefix) = InvariantLCase(PREFIX_NO_ENCODE))) AndAlso _
(Not BaseRecord.IsKnownExpressionPrefix(prefix)) Then
'The prefix is a control name. Add it to the list of controls that
'need to process the URL.
If (controlIdList.Contains(prefix)) And (Not forwardTo.Contains(prefix)) Then
forwardTo.Add(prefix)
End If
End If
End While
'Forward the request to each control in the forwardTo list
Dim containerId As String
For Each containerId In forwardTo
Dim ctl As Control = CType(controlIdList.Item(containerId), Control)
If (Not IsNothing(ctl)) Then
If TypeOf ctl Is BaseApplicationRecordControl Then
finalRedirectUrl = DirectCast(ctl, BaseApplicationRecordControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
ElseIf TypeOf ctl Is BaseApplicationTableControl Then
finalRedirectUrl = DirectCast(ctl, BaseApplicationTableControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
End If
End If
Next
'If there are any unresolved expressions, let the other naming containers
'have a crack at modifying the URL
For Each control In controlList
If (forwardTo.IndexOf(control.ID) < 0) Then
If TypeOf control Is BaseApplicationRecordControl Then
finalRedirectUrl = DirectCast(control, BaseApplicationRecordControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
ElseIf TypeOf control Is BaseApplicationTableControl Then
finalRedirectUrl = DirectCast(control, BaseApplicationTableControl).EvaluateExpressions(finalRedirectUrl, finalRedirectArgument, bEncrypt)
End If
End If
Next
End If
_modifyRedirectUrlInProgress = False
Return finalRedirectUrl
End Function
Private Function GetAllRecordAndTableControls() As ArrayList
Dim controlList As ArrayList = New ArrayList()
GetAllRecordAndTableControls(Me, controlList)
Return controlList
End Function
Private Sub GetAllRecordAndTableControls(ByVal ctl As Control, ByVal controlList As ArrayList)
If ctl Is Nothing Then
Return
End If
If TypeOf ctl Is BaseApplicationRecordControl OrElse _
TypeOf ctl Is BaseApplicationTableControl Then
controlList.Add(ctl)
End If
Dim nextCtl As Control
For Each nextCtl In ctl.Controls()
GetAllRecordAndTableControls(nextCtl, controlList)
Next
End Sub
Public Function GetResourceValue(ByVal keyVal As String, ByVal appName As String) As String
Try
Dim resObj As Object = GetGlobalResourceObject(appName, keyVal)
If Not resObj Is Nothing Then
Return resObj.ToString()
End If
Return ""
Catch
Return ""
End Try
End Function
Public Function GetResourceValue(ByVal keyVal As String) As String
Try
Dim appname As String = BaseClasses.Configuration.ApplicationSettings.Current.GetAppSetting(BaseClasses.Configuration.ApplicationSettings.ConfigurationKey.ApplicationName)
Dim resObj As Object = GetGlobalResourceObject(appname, keyVal)
If Not resObj Is Nothing Then
Return resObj.ToString()
End If
Return ""
Catch
Return ""
End Try
End Function
''' -----------------------------------------------------------------------------
''' <summary>
''' Register Control buttonCtrl with ScriptManager to perform traditional postback instead of default async postback
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' [sramarao] 3/2007 Created
''' </history>
''' -----------------------------------------------------------------------------
Public Sub RegisterPostBackTrigger(ByVal buttonCtrl As System.Web.UI.Control, ByVal updatePanelCtrl As System.Web.UI.Control)
Try
' Get current ScriptManager
Dim scriptMgr As ScriptManager = ScriptManager.GetCurrent(Me.Page)
' If Scriptmanager not preset return.
If scriptMgr Is Nothing Then
Return
End If
' If buttonCtrl is not surrounded by an UpdatePanel then return.
Dim CurrentUpdatePanel As System.Web.UI.UpdatePanel = CType(updatePanelCtrl, UpdatePanel)
If CurrentUpdatePanel Is Nothing Then
Return
End If
If buttonCtrl Is Nothing Then
Return
End If
scriptMgr.RegisterPostBackControl(buttonCtrl)
Catch ex As Exception
Throw ex
End Try
End Sub
Public Sub RegisterPostBackTrigger(ByVal buttonCtrl As System.Web.UI.Control)
Try
' Get current ScriptManager
Dim scriptMgr As ScriptManager = ScriptManager.GetCurrent(Me.Page)
' If Scriptmanager not preset return.
If scriptMgr Is Nothing Then
Return
End If
If buttonCtrl Is Nothing Then
Return
End If
scriptMgr.RegisterPostBackControl(buttonCtrl)
Catch ex As Exception
Throw ex
End Try
End Sub
Public Overridable Sub SaveData()
End Sub
Public Overridable Sub SetChartControl(ByVal chartCtrlName As String)
End Sub
#Region " Methods to manage saving and retrieving control values to session. "
Protected Sub Control_SaveControls_Unload(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Unload
If DirectCast(Me.Page, BaseApplicationPage).ShouldSaveControlsToSession Then
Me.SaveControlsToSession()
End If
End Sub
Protected Overridable Sub SaveControlsToSession()
End Sub
Protected Sub Control_ClearControls_PreRender(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.PreRender
Me.ClearControlsFromSession()
End Sub
Protected Overridable Sub ClearControlsFromSession()
End Sub
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal value As String)
SaveToSession(control.UniqueID, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID, defaultValue)
End Function
Public Function GetFromSession(ByVal control As Control) As String
Return GetFromSession(control.UniqueID, Nothing)
End Function
Public Sub RemoveFromSession(ByVal control As Control)
RemoveFromSession(control.UniqueID)
End Sub
Public Function InSession(ByVal control As Control) As Boolean
Return InSession(control.UniqueID)
End Function
Public Sub SaveToSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal value As String)
SaveToSession(control.UniqueID & variable, value)
End Sub
Public Function GetFromSession( _
ByVal control As Control, _
ByVal variable As String, _
ByVal defaultValue As String) As String
Return GetFromSession(control.UniqueID & variable, defaultValue)
End Function
Public Sub RemoveFromSession( _
ByVal control As Control, _
ByVal variable As String)
RemoveFromSession(control.UniqueID & variable)
End Sub
Public Function InSession( _
ByVal control As Control, _
ByVal variable As String) As Boolean
Return InSession(control.UniqueID & variable)
End Function
Public Sub SaveToSession( _
ByVal name As String, _
ByVal value As String)
Me.Page.Session()(GetValueKey(name)) = value
End Sub
Public Function GetFromSession( _
ByVal name As String, _
ByVal defaultValue As String) As String
Dim value As String = CType(Me.Page.Session()(GetValueKey(name)), String)
If value Is Nothing OrElse value.Trim() = "" Then
value = defaultValue
End If
Return value
End Function
Public Function GetFromSession(ByVal name As String) As String
Return GetFromSession(name, Nothing)
End Function
Public Sub RemoveFromSession(ByVal name As String)
Me.Page.Session.Remove(GetValueKey(name))
End Sub
Public Function InSession(ByVal name As String) As Boolean
Return (Not Me.Page.Session(GetValueKey(name)) Is Nothing)
End Function
Public Function GetValueKey(ByVal name As String) As String
Return Me.Page.Session.SessionID & Me.Page.AppRelativeVirtualPath & name
End Function
#End Region
End Class
End Namespace

45
App_Code/Shared/CalendarExtendarClass.vb Normal file
View file

@ -0,0 +1,45 @@
Imports System
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.HtmlControls
Imports System.Web.UI.WebControls
Imports AjaxControlToolkit
Namespace Persons
''' <summary>
''' Summary description for CalendarExtendarClass
''' </summary>
Public Class CalendarExtendarClass
Inherits AjaxControlToolkit.CalendarExtender
'
' Add constructor logic here
'
Public Sub New()
End Sub
Protected Overloads Overrides Sub OnLoad(ByVal e As EventArgs)
Dim textBox As TextBox = DirectCast(MyBase.TargetControl, TextBox)
If Me.IsLanguageDefaultRTL Then
If Not Me.Page.IsPostBack Then
If textBox.Text = String.Empty Then
DirectCast(MyBase.TargetControl, TextBox).Text = DateTime.Today.ToString(MyBase.Format)
End If
End If
End If
MyBase.OnLoad(e)
End Sub
Public ReadOnly Property IsLanguageDefaultRTL() As Boolean
Get
If String.Compare(Me.Page.Culture, "Arabic (Saudi Arabia)", StringComparison.InvariantCulture) = 0 OrElse String.Compare(Me.Page.Culture, "Thai(Thailand)", StringComparison.InvariantCulture) = 0 OrElse String.Compare(Me.Page.Culture, "Divehi (Maldives)", StringComparison.InvariantCulture) = 0 OrElse String.Compare(Me.Page.Culture, "Persian (Iran)", StringComparison.InvariantCulture) = 0 Then
Return True
Else
Return False
End If
End Get
End Property
End Class
End Namespace

217
App_Code/Shared/CsvParser.vb Normal file
View file

@ -0,0 +1,217 @@
 Imports System
Imports System.Data
Imports System.Configuration
Imports System.ComponentModel
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports System.Text
Imports System.IO
Imports System.Collections
Namespace Persons.UI
''' <summary>
''' Summary description for CsvParser: Parses CSV file and returns one row at a time.
''' Since the code is the same for CSV or TAB, this class is used for parsing both types of files.
''' </summary>
Public Class CsvParser
Inherits Parser
Private sr As StreamReader = Nothing
Private csvStrm As CsvStream = Nothing
Private fileName As String = Nothing
Private separator As Char = System.Globalization.CultureInfo.CurrentUICulture.TextInfo.ListSeparator(0)
Public Sub New(ByVal fName As String)
MyBase.New
'
' Add constructor logic here
'
fileName = fName
separator = System.Globalization.CultureInfo.CurrentUICulture.TextInfo.ListSeparator(0)
Reset()
End Sub
Public Sub New(ByVal fName As String, ByVal fSeparator As Char)
MyBase.New()
'
' Add constructor logic here
'
fileName = fName
separator = fSeparator
Reset()
End Sub
' Resets resourses
Public Overrides Sub Reset()
If (Not (fileName) Is Nothing) Then
sr = New StreamReader(fileName)
csvStrm = New CsvStream(sr, separator)
End If
End Sub
' Gets one row at a time.
Public Overrides Function GetNextRow() As String()
Return csvStrm.GetNextRow
End Function
Public Overrides Sub Close()
csvStrm.Close()
End Sub
' CsvStream is the helper class which parses the file.
Private Class CsvStream
Implements IDisposable
Private stream As TextReader
Private EOS As Boolean = False
Private EOL As Boolean = False
Private buffer() As Char = New Char((4096) - 1) {}
Private pos As Integer = 0
Private length As Integer = 0
Private separator As Char = System.Globalization.CultureInfo.CurrentUICulture.TextInfo.ListSeparator(0)
Public Sub New(ByVal s As TextReader, ByVal fSeparator As Char)
MyBase.New()
stream = s
separator = fSeparator
End Sub
Public Function GetNextRow() As String()
Dim row As ArrayList = New ArrayList
While True
Dim item As String = GetNextItem
If (item Is Nothing) Then
If (row.Count = 0) Then
Return Nothing
Else
If (row(row.Count - 1).ToString = "") Then
row.RemoveAt((row.Count - 1))
End If
If (row.Count <> 0) Then
Return CType(row.ToArray(GetType(System.String)), String())
End If
End If
Else
row.Add(item)
End If
End While
Return Nothing
End Function
Public Sub Close()
If stream IsNot Nothing Then
Me.Dispose()
End If
End Sub
Public Function GetNextItem() As String
If EOL Then
' previous item was last in line, start new line
EOL = False
Return Nothing
End If
Dim quoted As Boolean = False
Dim predata As Boolean = True
Dim postdata As Boolean = False
Dim item As New StringBuilder()
While True
Dim c As Char = GetNextChar(True)
If EOS Then
Return IIf(item.Length > 0, item.ToString(), Nothing)
End If
If (postdata OrElse Not quoted) AndAlso c = separator Then
Return item.ToString()
' end of item, return
End If
If (predata OrElse postdata OrElse Not quoted) AndAlso (c = Chr(10) OrElse c = Chr(13)) Then
' we are at the end of the line, eat newline characters and exit
EOL = True
If c = Chr(13) AndAlso GetNextChar(False) = Chr(10) Then
GetNextChar(True)
' new line sequence is 0D0A
End If
Return item.ToString()
End If
If predata AndAlso c = " "c Then
Continue While
' whitespace preceeding data, discard
End If
If predata AndAlso (c = """"c OrElse c = "'"c) Then
' quoted data is starting
quoted = True
predata = False
Continue While
End If
If predata Then
' data is starting without quotes
predata = False
item.Append(c)
Continue While
End If
If (c = """"c OrElse c = "'"c) AndAlso quoted Then
If GetNextChar(False) = """"c Then
item.Append(GetNextChar(True))
Else
postdata = True
' double quotes within quoted string means add a quote
' end-quote reached
End If
Continue While
End If
' all cases covered, character must be data
item.Append(c)
End While
Return Nothing
End Function
Public Function GetNextChar(ByVal eat As Boolean) As Char
If (pos >= length) Then
length = stream.ReadBlock(buffer, 0, buffer.Length)
If (length = 0) Then
EOS = True
Return Microsoft.VisualBasic.ChrW(92)
End If
pos = 0
End If
If eat Then
pos = pos + 1
Return buffer(pos - 1)
Else
Return buffer(pos)
End If
End Function
Public Sub Dispose() Implements IDisposable.Dispose
If stream IsNot Nothing Then
stream.Close()
stream.Dispose()
stream = Nothing
End If
End Sub
End Class
End Class
End Namespace

143
App_Code/Shared/CustomEditor.vb Normal file
View file

@ -0,0 +1,143 @@
Imports AjaxControlToolkit.HTMLEditor
Imports System
Imports System.Collections
Imports System.Collections.ObjectModel
'This class is used by Edit Table pages
Namespace Persons.UI
Public Class CustomEditor
Inherits Editor
Dim fontName As New AjaxControlToolkit.HTMLEditor.ToolbarButton.FontName()
Dim fontSize As New AjaxControlToolkit.HTMLEditor.ToolbarButton.FontSize()
''' <summary>
''' Disables the tabbing for the FontName and FontSize dropdown list
''' When user tabs from other control to the editor, it should ignore FontName and FontSize dropdown list
''' and takes the cursor directly inside the editor textbox
''' </summary>
Protected Overrides Sub OnPreRender(ByVal e As EventArgs)
MyBase.OnPreRender(e)
fontName.IgnoreTab = True
fontSize.IgnoreTab = True
End Sub
''' <summary>
''' This method is responsible for adding buttons on the TopToolbar of the editor
''' Remove or Add the buttons provided by AjaxControlToolkit
''' </summary>
Protected Overrides Sub FillTopToolbar()
Dim options As Collection(Of AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption)
Dim [option] As AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Undo())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Redo())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Bold())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Italic())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Underline())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.FixedBackColor())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.BackColorSelector())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.FixedForeColor())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.ForeColorSelector())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.OrderedList())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.BulletedList())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyCenter())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyFull())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyLeft())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyRight())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(fontName)
options = fontName.Options
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "arial,helvetica,sans-serif"
[option].Text = "Arial"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "courier new,courier,monospace"
[option].Text = "Courier New"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "georgia,times new roman,times,serif"
[option].Text = "Georgia"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "tahoma,arial,helvetica,sans-serif"
[option].Text = "Tahoma"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "times new roman,times,serif"
[option].Text = "Times New Roman"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "verdana,arial,helvetica,sans-serif"
[option].Text = "Verdana"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "impact"
[option].Text = "Impact"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "wingdings"
[option].Text = "WingDings"
options.Add([option])
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(fontSize)
options = fontSize.Options
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "8pt"
[option].Text = "1 ( 8 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "10pt"
[option].Text = "2 (10 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "12pt"
[option].Text = "3 (12 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "14pt"
[option].Text = "4 (14 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "18pt"
[option].Text = "5 (18 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "24pt"
[option].Text = "6 (24 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "36pt"
[option].Text = "7 (36 pt)"
options.Add([option])
End Sub
''' <summary>
''' This method is responsible for adding buttons on the BottomToolbar of the editor
''' Remove or Add the buttons provided by AjaxControlToolkit
''' </summary>
Protected Overrides Sub FillBottomToolbar()
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.DesignMode())
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.PreviewMode())
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HtmlMode())
End Sub
End Class
End Namespace

13
App_Code/Shared/Data.vb Normal file
View file

@ -0,0 +1,13 @@
Namespace Persons.Data
Public Class DataPlaceHolder
End Class
End Namespace
Namespace Persons.Business
Public Class BusinessPlaceHolder
End Class
End Namespace

166
App_Code/Shared/ExcelParser.vb Normal file
View file

@ -0,0 +1,166 @@
Imports System
Imports System.Data
Imports System.Data.OleDb
Imports System.Configuration
Imports System.Text
Imports System.IO
Imports System.Collections
Namespace Persons.UI
''' <summary>
''' Summary description for ExcelParser
''' </summary>
Public Class ExcelParser
Inherits Parser
Implements IDisposable
#Region "Private Member"
Private m_fileName As String = String.Empty
Private commandText As String = String.Empty
Private command As OleDbCommand = Nothing
Private m_connection As OleDbConnection = Nothing
Private reader As OleDbDataReader = Nothing
Private m_connectionString As String = String.Empty
#End Region
#Region "Properties"
Public Property Connection() As OleDbConnection
Get
Return m_connection
End Get
Set(ByVal value As OleDbConnection)
m_connection = value
End Set
End Property
Public Property FileName() As String
Get
Return m_fileName
End Get
Set(ByVal value As String)
m_fileName = value
End Set
End Property
Friend ReadOnly Property ConnectionStringOne() As String
Get
Me.m_connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" + "Data Source=" + Me.fileName + ";" + "Extended Properties=""Excel 12.0;HDR=No;IMEX=1"""
Return Me.m_connectionString
End Get
End Property
Friend ReadOnly Property ConnectionStringTwo() As String
Get
Me.m_connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" + "Data Source=" + Me.fileName + ";" + "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
Return Me.m_connectionString
End Get
End Property
#End Region
Public Sub New(ByVal file As String, ByVal sheetName As String)
'
' Add constructor logic here
'
Me.fileName = file
Dim merror As Boolean = False
Dim isConnectionOpen As Boolean = False
Me.connection = New OleDbConnection(Me.ConnectionStringOne)
Me.commandText = "SELECT * FROM [" + sheetName + "$]"
Me.command = New OleDbCommand(Me.commandText, Me.connection)
Try
Me.connection.Open()
isConnectionOpen = True
Me.reader = Me.command.ExecuteReader()
Catch ex As Exception
If Not isConnectionOpen Then
Me.connection = Nothing
Me.command = Nothing
Me.connection = New OleDbConnection(Me.ConnectionStringTwo)
Me.command = New OleDbCommand(Me.commandText, Me.connection)
Try
Me.connection.Open()
Me.reader = Me.command.ExecuteReader()
Catch exe As Exception
merror = True
Throw New Exception(exe.Message)
End Try
If merror Then
If Me.connection.State = ConnectionState.Open AndAlso Me.connection IsNot Nothing Then
Me.connection.Close()
End If
Throw ex
End If
Else
If Me.connection.State = ConnectionState.Open AndAlso Me.connection IsNot Nothing Then
Me.connection.Close()
End If
Throw ex
End If
End Try
End Sub
#Region "Parser member"
Public Overloads Overrides Sub Reset()
' throw new NotImplementedException();
End Sub
Public Overloads Overrides Function GetNextRow() As String()
Dim row As New ArrayList()
Dim columnIndex As Integer = 0
If Me.m_connection.State <> ConnectionState.Closed Then
If Me.reader.Read() Then
For columns As Integer = 0 To Me.reader.FieldCount - 1
Try
row.Add(Me.reader(columnIndex).ToString())
Catch ex As Exception
Throw New Exception(ex.Message)
End Try
columnIndex += 1
Next
End If
End If
If row.Count <> 0 Then
Return DirectCast(row.ToArray(GetType(String)), String())
End If
Return Nothing
End Function
Public Overloads Overrides Sub Close()
Me.reader.Close()
Me.reader = Nothing
Me.m_connection.Close()
Me.m_connection = Nothing
End Sub
#End Region
#Region "IDisposable Members"
Private Sub Dispose() Implements IDisposable.Dispose
'throw new NotImplementedException();
If Me.reader IsNot Nothing Then
Me.reader.Close()
Me.reader.Dispose()
End If
If Me.m_connection IsNot Nothing Then
Me.m_connection.Close()
Me.m_connection.Dispose()
End If
End Sub
#End Region
End Class
End Namespace

1197
App_Code/Shared/ExportData.vb Normal file
View file

File diff suppressed because it is too large Load diff

224
App_Code/Shared/FormulaEvaluator.vb Normal file
View file

@ -0,0 +1,224 @@
Imports Microsoft.VisualBasic
Imports System.IO
Imports BaseClasses.Data
Imports Ciloci.Flee
Imports Persons.UI
Imports Persons.Data
Namespace Persons
''' <summary>
''' The FormulaEvaluator class evaluates a formula passed to the Evaluate function.
''' You must set the DataSource and Page variables as part of this.
''' </summary>
''' <remarks></remarks>
Public Class FormulaEvaluator
Inherits BaseFormulaEvaluator
''' <summary>
''' Record control (or row) from which this evaluator is called. Could be Nothing
''' if called from the data access layer.
''' </summary>
Private _callingControl As Control = Nothing
Public Property CallingControl() As Control
Get
Return _callingControl
End Get
Set(ByVal value As Control)
_callingControl = value
End Set
End Property
''' <summary>
''' Create a new evaluator and prepare for evaluation.
''' </summary>
Public Sub New(Optional ByVal mainObj As Object = Nothing)
' pass mainObj to contructor so that formula like = mainObj.<functionName> can be evaluated
If mainObj Is Nothing Then
_evaluator = New ExpressionContext()
Else
_evaluator = New ExpressionContext(mainObj)
End If
' The order of adding types is important. First we add our own
' formula functions, followed by the generic types.
Evaluator.Imports.AddType(GetType(BaseFormulaUtils))
Evaluator.Imports.AddType(GetType(FormulaUtils))
' ADVANCED. For advanced usage, generic types can also be imported into
' the formula evaluator. This is done by adding types of some generic types
' such as Math, DateTime, Convert, and String. For example, if you add the
' Convert type, you can then use Convert.ToDecimal("string"). The second
' parameter to the AddType is the namespace that will be used in the formula.
' These functions expect a certain type. For example, Math functions expect
' a Double for the most part. If you pass a string, they will throw an exception.
' As such, we have written separate functions in FormulaUtils that are more
' loosely-typed than the standard libraries available here.
' Examples:
Evaluator.Imports.AddType(GetType(Math), "Math")
Evaluator.Imports.AddType(GetType(DateTime), "DateTime")
Evaluator.Imports.AddType(GetType(Convert), "Convert")
Evaluator.Imports.AddType(GetType(String), "String")
' We want a loosely-typed evaluation language - so do not
' type-check any variables.
Evaluator.Options.Checked = False
' Our policy is to always treat real numbers as Decimal instead of
' Double or Single to make it consistent across the entire
' evaluator.
Evaluator.Options.RealLiteralDataType = RealLiteralDataType.Decimal
' The variable event handler handles the variables based on the DataSource.
AddHandler _evaluator.Variables.ResolveVariableType, AddressOf variables_ResolveVariableType
AddHandler _evaluator.Variables.ResolveVariableValue, AddressOf variables_ResolveVariableValue
End Sub
''' <summary>
''' Evaluate the expression passed in as the string
''' </summary>
''' <param name="expression">The input whose absolute value is to be found.</param>
''' <returns>The result of the evaluation. Can we be any data type including string, datetime, decimal, etc.</returns>
Public Overrides Function Evaluate(ByVal expression As String) As Object
If IsNothing(expression) Then Return Nothing
If expression = "" Then Return ""
' Strip of the = in the front of the forumula - the Expression evaluator
' does not need it. Also, make sure to trim the result to remove any
' spaces in the front and the back.
expression = expression.TrimStart(New Char() {"="c, " "c}).Trim()
' Add all realted controls of this control. This includes the calling control, its children and parents.
AddRelatedControlVariables()
' If there are any exceptions when parsing or evaluating, they are
' thrown so that the end user can see the error. As such, there is no
' Try-Catch block here.
Try
Dim eDynamic As IDynamicExpression = _evaluator.CompileDynamic(expression)
Return eDynamic.Evaluate()
Catch ex As Exception
Return "ERROR: " & ex.Message
End Try
End Function
#Region "Private functions"
''' <summary>
''' Adds related record and table controls.
''' This has to navigate up to the page level and add any table or record controls.
''' And we have to navigate within to add any record/table controls.
''' And we have to go sideways to also add any controls.
''' Finally we have to add the page control.
''' This allows the expression to use any record or table control on the page
''' as long as it is accessible without being in a repeater.
''' </summary>
Private Sub AddRelatedControlVariables()
If IsNothing(CallingControl) Then Return
Try
' STEP 1: Our strategy is to first add the current control and
' all of its parents. This way, we maintain the full context of where
' we are. For example, if you are in a row within a table, within another row
' that is within another table, then by going up the hierarchy looking for parents
' will preserve all of the context.
' Later in Step 2 we will go through the other branches.
Dim ctl As Control = CallingControl
While Not (IsNothing(ctl))
If TypeOf ctl Is BaseApplicationRecordControl OrElse TypeOf ctl Is BaseApplicationTableControl Then
AddControlAndChildren(ctl)
End If
' Navigate up.
ctl = ctl.Parent
End While
' STEP 2: Go through the other branches on the page and add all other table and
' record controls on the page.
AddControlAndChildren(CallingControl.Page)
' STEP 3: Add more variable for ASCX control.
AddVariableNameWithoutUnderscore()
' STEP 4: Finally add the Page itself.
Evaluator.Variables.Add("Page", CallingControl.Page)
Catch ex As Exception
' Ignore and continue in case of a problem.
End Try
End Sub
''' <summary>
''' Add this control and all child controls of the given control.
''' We only add the Record and Table Controls. No other controls need
''' to be added.
''' This function is smart enough not to add or descend down a control
''' that was previously added by checking whether the Id is already contained
''' in the Evaluator variables. This avoids unnecessary traversal.
''' This function is called recursively to add any child controls.
''' </summary>
Private Sub AddControlAndChildren(ByVal ctl As Control)
' We quit immediately if a control is already in the list of variables,
' because we have convered that branch already.
Try
If IsNothing(ctl) Then Return
If Not (IsNothing(ctl.ID)) AndAlso Evaluator.Variables.ContainsKey(ctl.ID) Then Return
' If this is a record or table control, add it.
If TypeOf ctl Is BaseApplicationRecordControl OrElse TypeOf ctl Is BaseApplicationTableControl Then
If Not (IsNothing(ctl.ID)) Then
Evaluator.Variables.Add(ctl.ID, ctl)
End If
End If
For Each child As Control In ctl.Controls
' We do not want to go into a repeater because there will be multiple rows.
' So we will call AddChildControls only for those controls that are NOT repeaters.
If Not (TypeOf child Is System.Web.UI.WebControls.Repeater) Then
AddControlAndChildren(child)
End If
Next
Catch ex As Exception
' Ignore - we do not want to give an exception if we cannot add all variables.
End Try
End Sub
''' <summary>
''' If the current is not ASPX page but ASCX controls, the controls in this ASCX control has id starting with underscore.
''' To avoid confusion in formula, we also define variable name without underscore.
''' </summary>
''' <remarks></remarks>
Private Sub AddVariableNameWithoutUnderscore()
Dim vars As New Collections.Generic.Dictionary(Of String, Object)
Dim enumerator As Collections.Generic.IEnumerator(Of Collections.Generic.KeyValuePair(Of String, Object)) = Me.Evaluator.Variables.GetEnumerator()
While enumerator.MoveNext
If enumerator.Current.Key.StartsWith("_") Then
Dim varNameWitoutUnderscore As String = enumerator.Current.Key.Substring(1)
If Not Me.Evaluator.Variables.ContainsKey(varNameWitoutUnderscore) Then
vars.Add(varNameWitoutUnderscore, enumerator.Current.Value)
End If
End If
End While
Dim enumerator2 As Collections.Generic.Dictionary(Of String, Object).Enumerator = vars.GetEnumerator()
While enumerator2.MoveNext
Me.Evaluator.Variables.Add(enumerator2.Current.Key, enumerator2.Current.Value)
End While
End Sub
#End Region
End Class
End Namespace

550
App_Code/Shared/FormulaUtils.vb Normal file
View file

@ -0,0 +1,550 @@
Option Strict On
Imports Microsoft.VisualBasic
Imports System.IO
Imports BaseClasses
Imports BaseClasses.Data
Imports BaseClasses.Utils
Imports Persons.UI
Imports Persons.Data
Namespace Persons
''' <summary>
''' The FormulaUtils class contains a set of functions that are available
''' in the Formula editor. You can specify any of these functions after
''' the = sign.
''' For example, you can say:
''' = IsEven(32)
''' These functions throw an exception on an error. The formula evaluator
''' catches this exception and returns the error string to the user interface.
'''
''' All of the functions operate as a Decimal. The Decimal data type is better
''' then Double or Single since it provides a more accurate value as compared to
''' Double, and a larger value as compared to a Single. All integers, doubles, etc.
''' are converted to Decimals as part of these functions.
'''
''' Function names are not case sensitive. So you can use ROUND, Round, round, etc.
'''
''' </summary>
''' <remarks></remarks>
Public Class FormulaUtils
Inherits BaseFormulaUtils
#Region "Table Control-level functions"
''' <summary>
''' Sum the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.SUM("UnitPrice"), not
''' as shown here. The SUM function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Overloads Shared Function Sum(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim total As Decimal = 0
For Each item As Object In GetSortedValues(tableControl, ctlName)
total += CDec(item)
Next
Return total
End Function
''' <summary>
''' Sum the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.TOTAL("UnitPrice"), not
''' as shown here. The TOTAL function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Overloads Shared Function Total(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim sum As Decimal = 0
For Each item As Object In GetSortedValues(tableControl, ctlName)
sum += CDec(item)
Next
Return sum
End Function
''' <summary>
''' Finds the maximum among the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.Max("UnitPrice"), not
''' as shown here. The MAX function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The maximum among the values contained in each of the fields.</returns>
Public Overloads Shared Function Max(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim maxDecimal As Decimal = Decimal.MinValue
For Each item As Object In GetSortedValues(tableControl, ctlName)
maxDecimal = Math.Max(maxDecimal, CDec(item))
Next
Return maxDecimal
End Function
''' <summary>
''' Finds the minimum among the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' This function should be called as [Products]TableControl.Min("UnitPrice"), not
''' as shown here. The MIN function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The minimum among the values contained in each of the fields.</returns>
Public Overloads Shared Function Min(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim minDecimal As Decimal = Decimal.MaxValue
For Each item As Object In GetSortedValues(tableControl, ctlName)
minDecimal = Math.Min(minDecimal, CDec(item))
Next
Return minDecimal
End Function
''' <summary>
''' Count the number of rows in this table control.
''' This function should be called as [Products]TableControl.COUNT(), not
''' as shown here. The COUNT function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The count of the number of rows.</returns>
Public Overloads Shared Function Count(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Integer
Try
Return tableControl.GetBaseRecordControls().Length()
Catch ex As Exception
' If there is an error getting the length, we simply fall through and return 0.
End Try
Return 0
End Function
''' <summary>
''' Count the number of rows in this table control that actually contain
''' a decimal value (as opposed to be NULL or invalid value)
''' This function should be called as [Products]TableControl.COUNTA("UnitPrice"), not
''' as shown here. The COUNTA function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The count of the number of rows.</returns>
Public Shared Function CountA(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Integer
Dim recCtl As BaseApplicationRecordControl
Dim totalRows As Integer = 0
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
Dim ctl As Control
' The control itself may be embedded in sub-panels, so we need to use
' FindControlRecursively starting from the recCtl.
ctl = MiscUtils.FindControlRecursively(recCtl, ctlName)
If Not (IsNothing(ctl)) Then
' Add the row if this contains a valid number.
Dim val As String = Nothing
' Get the value from the textbox, label or literal
If TypeOf ctl Is System.Web.UI.WebControls.TextBox Then
val = CType(ctl, TextBox).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Label Then
val = CType(ctl, Label).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Literal Then
val = CType(ctl, Literal).Text
End If
Try
If Not (IsNothing(val)) AndAlso val.Trim.Length > 0 Then
totalRows += 1
End If
Catch ex As Exception
' Ignore exception - since this is only returning the
' rows that contain a valid value. Other rows with a
' NULL value or an invalid value will not be counted.
End Try
End If
Next
Return totalRows
End Function
''' <summary>
''' Calulates the Mean (Average) of the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' We could have implemented this as a call to SUM()/COUNT(), but decided to do it this way
''' for efficiency.
''' This function should be called as [Products]TableControl.MEAN("UnitPrice"), not
''' as shown here. The MEAN function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Shared Function Mean(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim recCtl As BaseApplicationRecordControl
Dim total As Decimal = 0
Dim numRows As Integer = 0
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
Dim ctl As Control
' The control itself may be embedded in sub-panels, so we need to use
' FindControlRecursively starting from the recCtl.
ctl = MiscUtils.FindControlRecursively(recCtl, ctlName)
If Not (IsNothing(ctl)) Then
Dim val As String = Nothing
' Get the value from the textbox, label or literal
If TypeOf ctl Is System.Web.UI.WebControls.TextBox Then
val = CType(ctl, TextBox).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Label Then
val = CType(ctl, Label).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Literal Then
val = CType(ctl, Literal).Text
End If
Try
' If the value is not a valid number, ignore it.
total += ParseDecimal(val)
Catch ex As Exception
' Ignore exception.
End Try
' Mean is calculated based on the number of rows, NOT on
' the number of non-NULL values. So in this way, it is based on
' COUNT and not on COUNTA.
numRows += 1
End If
Next
Return (total / numRows)
End Function
''' <summary>
''' Calulates the Average of the values of the displayed controls. The ctlName must be
''' a textbox, label or literal.
''' We could have implemented this as a call to SUM()/COUNT(), but decided to do it this way
''' for efficiency.
''' This function should be called as [Products]TableControl.AVERAGE("UnitPrice"), not
''' as shown here. The AVERAGE function in the BaseApplicationTableControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The total of adding the value contained in each of the fields.</returns>
Public Overloads Shared Function Average(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Return Mean(tableControl, ctlName)
End Function
''' <summary>
''' Return the Mode of this control.
''' This function should be called as [Products]TableControl.MODE("UnitPrice"), not
''' as shown here. The MODE function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' Say there are 5 rows and they contain 57, 57, 12, 57, 98.
''' The Mode is 57 as it is the number which repeats the maximum number of times.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The row number of the recordControl passed in. 0 if this is not a correct row number. </returns>
Public Shared Function Mode(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim rankedArray As ArrayList = GetSortedValues(tableControl, ctlName)
Dim num As Decimal = 0
Dim modeVal As Decimal = 0
Dim count As Integer = 0
Dim max As Integer = 0
' Because this is a sorted array, we can
For Each item As Object In rankedArray
If num <> CDec(item) Then
num = CDec(item)
count = 1
Else
count += 1
End If
If count > max Then
max = count
modeVal = num
End If
Next
Return modeVal
End Function
''' <summary>
''' Return the Median of this control.
''' This function should be called as [Products]TableControl.MEDIAN("UnitPrice"), not
''' as shown here. The MEDIAN function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' The order is 12, 19, 32, 57, 98 - so the Median is 32.
''' If the number of numbers is even, the Median is the average of the two middle numbers.
''' Say there are 6 rows and they contain 57, 32, 12, 19, 98, 121
''' The order is 12, 19, 32, 57, 98, 121 - so the two numbers in the mid are 32 and 57.
''' So the median is (32 + 57) / 2 = 89/2 = 44.5
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The row number of the recordControl passed in. 0 if this is not a correct row number. </returns>
Public Shared Function Median(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim rankedArray As ArrayList = GetSortedValues(tableControl, ctlName)
' If there are 0 elements, then there is no median.
If rankedArray.Count = 0 Then Return 0
Dim halfPoint As Integer = CInt(Math.Floor(rankedArray.Count / 2))
Dim medianValue As Decimal = 0
If rankedArray.Count Mod 2 = 0 Then
medianValue = (CDec(rankedArray.Item(halfPoint - 1)) + CDec(rankedArray(halfPoint))) / 2
Else
' Odd numbered items. So
medianValue = CDec(rankedArray.Item(halfPoint))
End If
Return medianValue
End Function
''' <summary>
''' Return the Range of this control.
''' This function should be called as [Products]TableControl.RANGE("UnitPrice"), not
''' as shown here. The RANGE function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' The lowest is 12, highest is 98, so the range is 98-12 = 86
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The row number of the recordControl passed in. 0 if this is not a correct row number. </returns>
Public Shared Function Range(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As Decimal
Dim rankedArray As ArrayList = GetSortedValues(tableControl, ctlName)
' If there are 0 or 1 elements, then there is no range.
If rankedArray.Count <= 1 Then Return 0
' Take the difference between the largest and the smallest.
Return CDec(rankedArray.Item(rankedArray.Count - 1)) - CDec(rankedArray.Item(0))
End Function
#End Region
#Region "Record Control-level functions"
''' <summary>
''' Return the row number of this record control.
''' This function should be called as [Products]TableControlRow.ROWNUM(), not
''' as shown here. The ROWNUM function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="recordControl">The record control whose row number is being determined. Row numbers are 1-based.</param>
''' <returns>The row number of the recordControl passed in. 0 if this is not a correct row number. </returns>
Public Shared Function RowNum(ByVal tableControl As BaseApplicationTableControl, ByVal recordControl As BaseApplicationRecordControl) As Integer
Dim recCtl As BaseApplicationRecordControl
Dim rowNumber As Integer = 1
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
If Object.ReferenceEquals(recCtl, recordControl) Then
' We found the row.
Return rowNumber
End If
rowNumber += 1
Next
Return 0
End Function
''' <summary>
''' Return the Rank of this control.
''' This function should be called as [Products]TableControlRow.RANK("UnitPrice"), not
''' as shown here. The RANK function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' Their respecitive ranks will be 4, 3, 1, 2, 5
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="recordControl">The record control whose tank is being determined. Rank numbers are 1-based.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The row number of the recordControl passed in. 0 if this is not a correct row number. </returns>
Public Shared Function Rank(ByVal tableControl As BaseApplicationTableControl, ByVal recordControl As BaseApplicationRecordControl, ByVal ctlName As String) As Integer
Dim recCtl As BaseApplicationRecordControl
Dim rankedArray As ArrayList = New ArrayList()
Dim lookFor As Decimal = 0
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
Dim ctl As Control
' The control itself may be embedded in sub-panels, so we need to use
' FindControlRecursively starting from the recCtl.
ctl = MiscUtils.FindControlRecursively(recCtl, ctlName)
If Not (IsNothing(ctl)) Then
Dim textVal As String = Nothing
Dim val As Decimal = 0
' Get the value from the textbox, label or literal
If TypeOf ctl Is System.Web.UI.WebControls.TextBox Then
textVal = CType(ctl, TextBox).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Label Then
textVal = CType(ctl, Label).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Literal Then
textVal = CType(ctl, Literal).Text
End If
Try
' If the value is not a valid number, ignore it.
val = ParseDecimal(textVal)
rankedArray.Add(val)
' Save the value that we need to look for to determine the rank
If Object.ReferenceEquals(recCtl, recordControl) Then
lookFor = val
End If
Catch ex As Exception
' Ignore exception.
End Try
End If
Next
' Sort the array now.
rankedArray.Sort()
' Rank is always 1 based in our case. So we need to add one to the
' location returned by IndexOf
Return rankedArray.IndexOf(lookFor) + 1
End Function
''' <summary>
''' Return the running total of the control.
''' This function should be called as [Products]TableControlRow.RUNNINGTOTAL("UnitPrice"), not
''' as shown here. The RUNNINGTOTAL function in the BaseApplicationRecordControl will call this
''' function to actually perform the work - so that we can keep all of the formula
''' functions together in one place.
''' Say there are 5 rows and they contain 57, 32, 12, 19, 98.
''' Their respecitive running totals will be 57, 89, 101, 120, 218
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="recordControl">The record control whose running total is being determined.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>The running total of the recordControl passed in.</returns>
Public Shared Function RunningTotal(ByVal tableControl As BaseApplicationTableControl, ByVal recordControl As BaseApplicationRecordControl, ByVal ctlName As String) As Decimal
Dim recCtl As BaseApplicationRecordControl
Dim lookFor As Decimal = 0
Dim total As Decimal = 0
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
Dim ctl As Control
' The control itself may be embedded in sub-panels, so we need to use
' FindControlRecursively starting from the recCtl.
ctl = MiscUtils.FindControlRecursively(recCtl, ctlName)
If Not (IsNothing(ctl)) Then
Dim textVal As String = Nothing
Dim val As Decimal = 0
' Get the value from the textbox, label or literal
If TypeOf ctl Is System.Web.UI.WebControls.TextBox Then
textVal = CType(ctl, TextBox).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Label Then
textVal = CType(ctl, Label).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Literal Then
textVal = CType(ctl, Literal).Text
End If
Try
' If the value is not a valid number, ignore it.
val = ParseDecimal(textVal)
total = val + total
' If the row till which we are finding the running total, return the total till that row
If Object.ReferenceEquals(recCtl, recordControl) Then
Return total
End If
Catch ex As Exception
' Ignore exception.
End Try
End If
Next
Return total
End Function
#End Region
#Region "Private"
''' <summary>
''' GetSortedValues is a private function that returns the list of sorted values of
''' the given control name. This is used by Rank, Median, Average, Mode, etc.
''' </summary>
''' <param name="tableControl">The table control instance.</param>
''' <param name="ctlName">The string name of the UI control (e.g., "UnitPrice") </param>
''' <returns>A sorted array of values for the given control. </returns>
Private Shared Function GetSortedValues(ByVal tableControl As BaseApplicationTableControl, ByVal ctlName As String) As ArrayList
Dim recCtl As BaseApplicationRecordControl
Dim rankedArray As ArrayList = New ArrayList()
' Get all of the record controls within this table control.
For Each recCtl In tableControl.GetBaseRecordControls()
Dim ctl As Control
' The control itself may be embedded in sub-panels, so we need to use
' FindControlRecursively starting from the recCtl.
ctl = MiscUtils.FindControlRecursively(recCtl, ctlName)
If Not (IsNothing(ctl)) AndAlso ctl.Visible Then
Dim textVal As String = Nothing
Dim val As Decimal = 0
' Get the value from the textbox, label or literal
If TypeOf ctl Is System.Web.UI.WebControls.TextBox Then
textVal = CType(ctl, TextBox).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Label Then
textVal = CType(ctl, Label).Text
ElseIf TypeOf ctl Is System.Web.UI.WebControls.Literal Then
textVal = CType(ctl, Literal).Text
End If
Try
' If the value is not a valid number, ignore it.
val = ParseDecimal(textVal)
rankedArray.Add(val)
Catch ex As Exception
' Ignore exception.
End Try
End If
Next
' Sort the array now.
rankedArray.Sort()
Return rankedArray
End Function
#End Region
End Class
End Namespace

200
App_Code/Shared/FvLlsHyperLink.vb Normal file
View file

@ -0,0 +1,200 @@
'
'
' Typical customizations that may be done in this class include
' - adding custom event handlers
' - overriding base class methods
Imports System.ComponentModel
Namespace Persons
''' <summary>
''' Renders a hyperlink that displays the app's page in a popup window.
''' </summary>
''' <remarks>
''' Unlike a regular HyperLink, this control's NavigateUrl is ReadOnly and derived automatically at runtime.
''' <para>
''' </para>
''' </remarks>
Public Class FvLlsHyperLink
Inherits BaseClasses.Web.UI.WebControls.PopupWindowHyperLink
Public Sub New()
MyBase.New()
Me.WindowFeatures = "width=600, height=400, resizable, scrollbars"
Me.WindowName = "llswin"
Me.ImageUrl = "~/Images/LargeListSelector.gif"
'Me.Style.Add("vertical-align", "middle")
Me.CssClass = "llslink"
Me.ToolTip = "More"
End Sub
'Shadow the NavigateUrl Property to return a runtime-derived url and to make it ReadOnly.
<Editor("System.Web.UI.Design.UrlEditor, System.Design, Version=1.0.3300.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a", GetType(System.Drawing.Design.UITypeEditor)), _
Category("Navigation"), _
DefaultValue(""), _
Description("HyperLink_NavigateUrl"), _
Bindable(False)> _
Public Shadows ReadOnly Property NavigateUrl() As String
Get
Return Me.DeriveNavigateUrl()
End Get
'Set(ByVal value As String)
' ViewState("NavigateUrl") = value
'End Set
End Property
Private _ControlToUpdate As String = ""
<Bindable(True), Category("Behavior"), DefaultValue("")> Public Property ControlToUpdate() As String
Get
Return Me._ControlToUpdate
End Get
Set(ByVal value As String)
Me._ControlToUpdate = value
End Set
End Property
Private _MinListItems As Integer = 100
<Bindable(True), Category("Behavior"), DefaultValue("100"), _
Description("The minimum number of items that must be in the ControlToUpdate for this control to be visible.")> _
Public Property MinListItems() As Integer
Get
Return Me._MinListItems
End Get
Set(ByVal value As Integer)
If (value < 0) Then
value = 0
End If
Me._MinListItems = value
End Set
End Property
Private _Table As String = ""
<Bindable(True), Category("Behavior"), DefaultValue("")> Public Property Table() As String
Get
Return Me._Table
End Get
Set(ByVal value As String)
Me._Table = value
End Set
End Property
Private _Field As String = ""
<Bindable(True), Category("Behavior"), DefaultValue("")> Public Property Field() As String
Get
Return Me._Field
End Get
Set(ByVal value As String)
Me._Field = value
End Set
End Property
Private _DisplayField As String = ""
<Bindable(True), Category("Behavior"), DefaultValue("")> Public Property DisplayField() As String
Get
Return Me._DisplayField
End Get
Set(ByVal value As String)
Me._DisplayField = value
End Set
End Property
Private _Formula As String = ""
<Bindable(True), Category("Behavior"), DefaultValue("")> Public Property Formula() As String
Get
Return Me._Formula
End Get
Set(ByVal value As String)
Me._Formula = value
End Set
End Property
Public Function GetControlToUpdate() As Control
If (Len(Me.ControlToUpdate) > 0) Then
Return Me.NamingContainer.FindControl(Me.ControlToUpdate)
End If
Return Nothing
End Function
Protected Function DeriveNavigateUrl() As String
Dim c As Control = Me.GetControlToUpdate()
Dim tableName As String = Me.Table
Dim fieldName As String = Me.Field
Dim displayFieldName As String = Me.DisplayField
Dim formula As String = Me.Formula
If (IsNothing(displayFieldName)) Then
displayFieldName = fieldName
End If
' encrypt all the fields
tableName = CType(Me.Page, Persons.UI.BaseApplicationPage).Encrypt(tableName)
fieldName = CType(Me.Page, Persons.UI.BaseApplicationPage).Encrypt(fieldName)
displayFieldName = CType(Me.Page, Persons.UI.BaseApplicationPage).Encrypt(displayFieldName)
formula = CType(Me.Page, Persons.UI.BaseApplicationPage).Encrypt(formula)
Return String.Format( _
"~/Shared/LargeListSelector.aspx?Table={0}&Field={1}&DisplayField={2}&Target={3}&Formula={4}&usnh=n", _
HttpUtility.UrlEncode(tableName), _
HttpUtility.UrlEncode(fieldName), _
HttpUtility.UrlEncode(displayFieldName), _
HttpUtility.UrlEncode(c.ClientID), _
HttpUtility.UrlEncode(formula))
End Function
Protected Overrides Sub Render(ByVal writer As System.Web.UI.HtmlTextWriter)
If (Me.MinListItems > 0) Then
'Make this control invisible if the ControlToUpdate is a list with < Me.MinListItems items.
Dim c As Control = Me.GetControlToUpdate()
If Not IsNothing(c) AndAlso Not c.Visible Then
Return
End If
If (TypeOf (c) Is System.Web.UI.WebControls.ListControl) Then
Dim lc As System.Web.UI.WebControls.ListControl = CType(c, System.Web.UI.WebControls.ListControl)
Dim listItemCount As Integer = lc.Items.Count
'Me.Visible = (listItemCount >= Me.MinListItems)
If (Not listItemCount >= Me.MinListItems) Then
Return 'Don't render the control
End If
End If
End If
'Set the inherited NavigateUrl property's value to the shadow's (derived) value
Dim baseNavUrl As String = MyBase.NavigateUrl
MyBase.NavigateUrl = Me.NavigateUrl
MyBase.Render(writer)
'Un-set the inherited NavigateUrl property to the original value
MyBase.NavigateUrl = baseNavUrl
End Sub
Protected Overrides Sub LoadViewState(ByVal savedState As Object)
MyBase.LoadViewState(savedState)
Me._ControlToUpdate = CStr(Me.ViewState.Item("ControlToUpdate"))
Me._MinListItems = CInt(Me.ViewState.Item("MinListItems"))
Me._Table = CStr(Me.ViewState.Item("Table"))
Me._Field = CStr(Me.ViewState.Item("Field"))
Me._DisplayField = CStr(Me.ViewState.Item("DisplayField"))
Me._Formula = CStr(Me.ViewState.Item("Formula"))
End Sub
Protected Overrides Function SaveViewState() As Object
Me.ViewState.Item("ControlToUpdate") = Me._ControlToUpdate
Me.ViewState.Item("MinListItems") = Me._MinListItems
Me.ViewState.Item("Table") = Me._Table
Me.ViewState.Item("Field") = Me._Field
Me.ViewState.Item("DisplayField") = Me._DisplayField
Me.ViewState.Item("Formula") = Me._Formula
Return MyBase.SaveViewState()
End Function
End Class
End Namespace

174
App_Code/Shared/HTMLEditor.vb Normal file
View file

@ -0,0 +1,174 @@
Imports AjaxControlToolkit.HTMLEditor
Imports System
Imports System.Collections
Imports System.Collections.ObjectModel
'This class is used by Add/Edit Record pages
Namespace Persons.UI
Public Class HTMLEditor
Inherits Editor
Dim fontName As New AjaxControlToolkit.HTMLEditor.ToolbarButton.FontName()
Dim fontSize As New AjaxControlToolkit.HTMLEditor.ToolbarButton.FontSize()
''' <summary>
''' Disables the tabbing for the FontName and FontSize dropdown list
''' When user tabs from other control to the editor, it should ignore FontName and FontSize dropdown list
''' and takes the cursor directly inside the editor textbox
''' </summary>
Protected Overrides Sub OnPreRender(ByVal e As EventArgs)
MyBase.OnPreRender(e)
fontName.IgnoreTab = True
fontSize.IgnoreTab = True
End Sub
''' <summary>
''' This method is responsible for adding buttons on the TopToolbar of the editor
''' Remove or Add the buttons provided by AjaxControlToolkit
''' </summary>
Protected Overrides Sub FillTopToolbar()
Dim options As Collection(Of AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption)
Dim [option] As AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Undo())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Redo())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Bold())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Italic())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Underline())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.StrikeThrough())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.SubScript())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.SuperScript())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.FixedBackColor())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.BackColorSelector())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.BackColorClear())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.FixedForeColor())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.ForeColorSelector())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.ForeColorClear())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.OrderedList())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.BulletedList())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Paragraph())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyCenter())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyFull())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyLeft())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.JustifyRight())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.RemoveAlignment())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.IncreaseIndent())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.DecreaseIndent())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.InsertLink())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.RemoveLink())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.InsertHR())
' Uncomment this section of code to add more buttons to the editor.
' These buttons are commented out because of compatibility issues within the browser
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Cut())
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Copy())
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Paste())
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.PasteText())
'TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.PasteWord())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Ltr())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.Rtl())
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(fontName)
options = fontName.Options
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "arial,helvetica,sans-serif"
[option].Text = "Arial"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "courier new,courier,monospace"
[option].Text = "Courier New"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "georgia,times new roman,times,serif"
[option].Text = "Georgia"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "tahoma,arial,helvetica,sans-serif"
[option].Text = "Tahoma"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "times new roman,times,serif"
[option].Text = "Times New Roman"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "verdana,arial,helvetica,sans-serif"
[option].Text = "Verdana"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "impact"
[option].Text = "Impact"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "wingdings"
[option].Text = "WingDings"
options.Add([option])
TopToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HorizontalSeparator())
TopToolbar.Buttons.Add(fontSize)
options = fontSize.Options
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "8pt"
[option].Text = "1 ( 8 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "10pt"
[option].Text = "2 (10 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "12pt"
[option].Text = "3 (12 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "14pt"
[option].Text = "4 (14 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "18pt"
[option].Text = "5 (18 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "24pt"
[option].Text = "6 (24 pt)"
options.Add([option])
[option] = New AjaxControlToolkit.HTMLEditor.ToolbarButton.SelectOption()
[option].Value = "36pt"
[option].Text = "7 (36 pt)"
options.Add([option])
End Sub
''' <summary>
''' This method is responsible for adding buttons on the BottomToolbar of the editor
''' Remove or Add the buttons provided by AjaxControlToolkit
''' </summary>
Protected Overrides Sub FillBottomToolbar()
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.DesignMode())
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.PreviewMode())
BottomToolbar.Buttons.Add(New AjaxControlToolkit.HTMLEditor.ToolbarButton.HtmlMode())
End Sub
End Class
End Namespace

46
App_Code/Shared/IDatePagination.vb Normal file
View file

@ -0,0 +1,46 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IDatePagination
#Region "Interface Properties"
ReadOnly Property Day() As System.Web.UI.WebControls.LinkButton
ReadOnly Property Day1() As System.Web.UI.WebControls.Literal
ReadOnly Property Month() As System.Web.UI.WebControls.LinkButton
ReadOnly Property Month1() As System.Web.UI.WebControls.Literal
ReadOnly Property NextInterval() As IThemeButton
ReadOnly Property NextPageInterval() As IThemeButton
ReadOnly Property PageTitle() As System.Web.UI.WebControls.Literal
ReadOnly Property PreviousInterval() As IThemeButton
ReadOnly Property PreviousPageInterval() As IThemeButton
ReadOnly Property Quarter() As System.Web.UI.WebControls.LinkButton
ReadOnly Property Quarter1() As System.Web.UI.WebControls.Literal
ReadOnly Property StartDate1() As System.Web.UI.WebControls.Literal
ReadOnly Property Week() As System.Web.UI.WebControls.LinkButton
ReadOnly Property Week1() As System.Web.UI.WebControls.Literal
ReadOnly Property Year() As System.Web.UI.WebControls.LinkButton
ReadOnly Property Year1() As System.Web.UI.WebControls.Literal
Property Visible() as Boolean
Property Interval() As String
Sub ProcessPreviousPeriod()
Sub ProcessPreviousPagePeriod(ByVal periodsShown As Integer)
Sub ProcessNextPeriod()
Sub ProcessNextPagePeriod(ByVal periodsShown As Integer)
Sub SetPeriodsShown(ByVal periodsShown As Integer)
Property FirstStartDate() As String
#End Region
End Interface
End Namespace

24
App_Code/Shared/IIncludeComponent.vb Normal file
View file

@ -0,0 +1,24 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IIncludeComponent
#Region "Interface Properties"
Property Visible() as Boolean
Sub SaveData()
#End Region
End Interface
End Namespace

23
App_Code/Shared/IMenu_Item.vb Normal file
View file

@ -0,0 +1,23 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IMenu_Item
#Region "Interface Properties"
ReadOnly Property Button() As System.Web.UI.WebControls.LinkButton
Property Visible() as Boolean
#End Region
End Interface
End Namespace

23
App_Code/Shared/IMenu_ItemVertical.vb Normal file
View file

@ -0,0 +1,23 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IMenu_ItemVertical
#Region "Interface Properties"
ReadOnly Property Button() As System.Web.UI.WebControls.LinkButton
Property Visible() as Boolean
#End Region
End Interface
End Namespace

23
App_Code/Shared/IMenu_Item_Highlighted.vb Normal file
View file

@ -0,0 +1,23 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IMenu_Item_Highlighted
#Region "Interface Properties"
ReadOnly Property Button() As System.Web.UI.WebControls.LinkButton
Property Visible() as Boolean
#End Region
End Interface
End Namespace

23
App_Code/Shared/IMenu_Item_HighlightedVertical.vb Normal file
View file

@ -0,0 +1,23 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IMenu_Item_HighlightedVertical
#Region "Interface Properties"
ReadOnly Property Button() As System.Web.UI.WebControls.LinkButton
Property Visible() as Boolean
#End Region
End Interface
End Namespace

31
App_Code/Shared/IPagination.vb Normal file
View file

@ -0,0 +1,31 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IPagination
#Region "Interface Properties"
ReadOnly Property CurrentPage() As System.Web.UI.WebControls.TextBox
ReadOnly Property FirstPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property LastPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property NextPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property PageSize() As System.Web.UI.WebControls.TextBox
ReadOnly Property PageSizeButton() As System.Web.UI.WebControls.LinkButton
ReadOnly Property PreviousPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property TotalItems() As System.Web.UI.WebControls.Label
ReadOnly Property TotalPages() As System.Web.UI.WebControls.Label
Property Visible() as Boolean
#End Region
End Interface
End Namespace

30
App_Code/Shared/IPaginationMedium.vb Normal file
View file

@ -0,0 +1,30 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IPaginationMedium
#Region "Interface Properties"
ReadOnly Property CurrentPage() As System.Web.UI.WebControls.TextBox
ReadOnly Property FirstPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property LastPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property NextPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property PageSize() As System.Web.UI.WebControls.TextBox
ReadOnly Property PageSizeButton() As System.Web.UI.WebControls.LinkButton
ReadOnly Property PreviousPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property TotalPages() As System.Web.UI.WebControls.Label
Property Visible() as Boolean
#End Region
End Interface
End Namespace

29
App_Code/Shared/IPaginationShort.vb Normal file
View file

@ -0,0 +1,29 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IPaginationShort
#Region "Interface Properties"
ReadOnly Property CurrentPage() As System.Web.UI.WebControls.TextBox
ReadOnly Property FirstPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property LastPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property NextPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property PageSizeButton() As System.Web.UI.WebControls.LinkButton
ReadOnly Property PreviousPage() As System.Web.UI.WebControls.ImageButton
ReadOnly Property TotalPages() As System.Web.UI.WebControls.Label
Property Visible() as Boolean
#End Region
End Interface
End Namespace

23
App_Code/Shared/IThemeButton.vb Normal file
View file

@ -0,0 +1,23 @@

Imports Microsoft.VisualBasic
Imports BaseClasses.Utils.DbUtils
Namespace Persons.UI
Public Interface IThemeButton
#Region "Interface Properties"
ReadOnly Property Button() As System.Web.UI.WebControls.LinkButton
Property Visible() as Boolean
#End Region
End Interface
End Namespace

344
App_Code/Shared/ImportDataItems.vb Normal file
View file

@ -0,0 +1,344 @@

Imports System
Imports System.Data
Imports System.IO
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports System.Collections
Imports BaseClasses
Imports BaseClasses.Utils
Imports BaseClasses.Data
Imports BaseClasses.Data.SqlProvider
Imports BaseClasses.Web.UI.WebControls
Namespace Persons.UI
''' <summary>
''' Summary description for ImportDataItems
''' </summary>
Public Class ImportDataItems
Dim NumberOfRecordImported As Long = 0
Dim RowCount As Long = 1
Dim ColumnCount As Integer = 1
Private Const SEPARATOR As String = ", "
#Region "Properties"
''' <summary>
''' The path of the file from which data is to be retrieved for import.
''' </summary>
Private _fPath As String
Public Property FilePath() As String
Get
Return _fPath
End Get
Set(ByVal value As String)
_fPath = value
End Set
End Property
' <summary>
' Type of the file to be imported
' </summary>
Private _fType As Parser.FileTypes
Public Property FileType() As Parser.FileTypes
Get
Return _fType
End Get
Set(ByVal value As Parser.FileTypes)
_fType = value
End Set
End Property
''' <summary>
''' The database table to which the records from CSV file has to be imported.
''' </summary>
Private _tbl As BaseTable
Private Property DBTable() As BaseTable
Get
Return Me._tbl
End Get
Set(ByVal value As BaseTable)
Me._tbl = value
End Set
End Property
''' <summary>
''' Stores the list of column names for which the data from CSV file is to be imported to database table..
''' </summary>
Private _columnNameList As ArrayList
Private Property ColumnNameList() As ArrayList
Get
Return Me._columnNameList
End Get
Set(ByVal value As ArrayList)
Me._columnNameList = value
End Set
End Property
''' <summary>
''' Stores the list of checkboxes which indicate whether corresponding column should be imported or not.
''' </summary>
Private _cbxList As ArrayList
Private Property ImportList() As ArrayList
Get
Return Me._cbxList
End Get
Set(ByVal value As ArrayList)
Me._cbxList = value
End Set
End Property
#End Region
#Region "Constructor"
Public Sub New(ByVal path As String, ByVal type As Parser.FileTypes, ByVal bTable As BaseTable, ByVal ddListSelected As ArrayList, ByVal chkBoxList As ArrayList)
MyBase.New()
'
' Add constructor logic here
'
Me.DBTable = bTable
Me.ColumnNameList = ddListSelected
Me.ImportList = chkBoxList
Me.FilePath = path
Me.FileType = type
End Sub
#End Region
#Region "Methods"
Private Sub AddSkippedRecordToList(ByRef recordsList As Generic.List(Of BaseClasses.Utils.SkippedLine), _
ByVal RowCount As Long, ByVal rowValues() As String, ByVal exMsg As String)
If Not exMsg Is Nothing AndAlso Not exMsg.Trim = "" Then
exMsg = exMsg.Replace("'", "\'")
End If
Dim skippedRecord As BaseClasses.Utils.SkippedLine = New BaseClasses.Utils.SkippedLine("", exMsg, RowCount)
For Each rv As String In rowValues
If Not rv Is Nothing AndAlso rv.Trim <> "" Then skippedRecord.LineContent &= rv & SEPARATOR
Next
If skippedRecord.LineContent.EndsWith(", ") Then
skippedRecord.LineContent = skippedRecord.LineContent.Substring(0, skippedRecord.LineContent.Length - 2)
End If
recordsList.Add(skippedRecord)
End Sub
''' <summary>
''' Reads rows of values for CSV file and import it to Database.
''' </summary>
Public Function ImportRecords(ByVal isImportFirstRowChecked As Boolean, ByVal isResolvedForeignKeysChecked As Boolean) As BaseClasses.Utils.ImportedResults
Dim success As Boolean = False
Dim parsr As Parser = Nothing
Dim results As BaseClasses.Utils.ImportedResults = New BaseClasses.Utils.ImportedResults
Try
If ((Me.FilePath Is Nothing) _
OrElse ((Me.DBTable Is Nothing) _
OrElse ((Me.ColumnNameList Is Nothing) _
OrElse (Me.ImportList Is Nothing)))) Then
Return results
End If
DbUtils.StartTransaction()
parsr = Parser.GetParser(Me.FilePath, Me.FileType)
Dim rowValues() As String = parsr.GetNextRow
' get the first row
If (Not isImportFirstRowChecked _
AndAlso (Not (rowValues) Is Nothing)) Then
Try
DoImport(rowValues, isResolvedForeignKeysChecked)
RowCount += 1
Catch ex As Exception
results.NumberOfSkipped += 1
Me.AddSkippedRecordToList(results.ListOfSkipped, RowCount + results.NumberOfSkipped, rowValues, ex.Message)
End Try
End If
While (Not (rowValues) Is Nothing)
rowValues = parsr.GetNextRow
If (Not (rowValues) Is Nothing) Then
Try
DoImport(rowValues, isResolvedForeignKeysChecked)
RowCount += 1
Catch ex As Exception
results.NumberOfSkipped += 1
Me.AddSkippedRecordToList(results.ListOfSkipped, RowCount + results.NumberOfSkipped, rowValues, ex.Message)
End Try
End If
End While
DbUtils.CommitTransaction()
parsr.Close()
success = True
' turn on success only when all the rows are imported ie, saved into database.
Catch e As Exception
DbUtils.RollBackTransaction()
results.NumberOfImported = 0
parsr.Close()
Dim errorMsg As String = e.Message
If File.Exists(Me.FilePath) Then
File.Delete(Me.FilePath)
End If
errorMsg = String.Format("- " & errorMsg & Environment.NewLine & "- Import error occurred at Row = {0},Column = {1}", RowCount, ColumnCount)
Throw New Exception(errorMsg)
Finally
DbUtils.EndTransaction()
If (File.Exists(Me.FilePath)) Then
File.Delete(Me.FilePath)
End If
End Try
results.NumberOfImported = NumberOfRecordImported
Return results
End Function
''' <summary>
''' Creates a database record and calls UpdateColumnValuesInRecord to set the record values.
''' </summary>
Private Sub DoImport(ByVal rowValues() As String, ByVal isResolvedForeignKeysChecked As Boolean)
Dim r As IRecord
r = Me.DBTable.CreateRecord
If (UpdateColumnValuesInRecord(rowValues, r, isResolvedForeignKeysChecked)) Then
r.Save()
NumberOfRecordImported = NumberOfRecordImported + 1
End If
End Sub
''' <summary>
''' Sets a database record values with values retrieved from CSV file.
''' </summary>
''' <param name="rowValues"></param>
''' <param name="record"></param>
Private Function UpdateColumnValuesInRecord(ByVal rowValues() As String, ByVal record As IRecord, ByVal isResolvedForeignKeysChecked As Boolean) As Boolean
Dim j As Integer = 0
Dim isRecordUpdated As Boolean = False
ColumnCount = 1
For Each data As String In rowValues
ColumnCount = ColumnCount + 1
If j > Me.ImportList.Count - 1 Then
Return isRecordUpdated
End If
Try
If ((Me.ColumnNameList(j).ToString <> "") _
AndAlso CType(Me.ImportList(j), CheckBox).Checked) Then
Dim fkColumn As ForeignKey = Nothing
Dim currentColumn As BaseColumn = Me.DBTable.TableDefinition.ColumnList.GetByAnyName(CType(Me.ColumnNameList(j), String))
If isResolvedForeignKeysChecked Then
fkColumn = Me.DBTable.TableDefinition.GetForeignKeyByColumnName(currentColumn.InternalName)
End If
Dim colValue As String = ""
' Check if the foreign key has DFKA. If so, then check the calue from csv file agains the DFKA column in the parent/foreign key table.
' If a match is found retrieve its ID and set that as value to be insterted in the current table where you are adding records.
If (Not (fkColumn) Is Nothing) Then
Dim originalTableDef As TableDefinition = fkColumn.PrimaryKeyTableDefinition
Dim originalBaseTable As BaseTable = originalTableDef.CreateBaseTable
Dim wc As WhereClause = Nothing
Dim records As ArrayList = New ArrayList
Dim pkColumn As BaseColumn = CType(originalTableDef.PrimaryKey.Columns(0), BaseColumn)
'Index is zero because we handle only those tables which has single PK column not composite keys.
If ((Not (fkColumn.PrimaryKeyDisplayColumns) Is Nothing) _
AndAlso (fkColumn.PrimaryKeyDisplayColumns <> "") AndAlso (Not fkColumn.PrimaryKeyDisplayColumns.Trim().StartsWith("="))) Then
wc = New WhereClause(originalTableDef.ColumnList.GetByAnyName(fkColumn.PrimaryKeyDisplayColumns), BaseFilter.ComparisonOperator.EqualsTo, data)
ElseIf ((Not (fkColumn.PrimaryKeyDisplayColumns) Is Nothing) _
AndAlso (fkColumn.PrimaryKeyDisplayColumns <> "") AndAlso (fkColumn.PrimaryKeyDisplayColumns.Trim().StartsWith("="))) Then
Dim primaryKeyDisplay As String = GetDFKA(fkColumn)
If Not IsNothing(primaryKeyDisplay) Then
wc = New WhereClause(originalTableDef.ColumnList.GetByAnyName(primaryKeyDisplay), BaseFilter.ComparisonOperator.EqualsTo, data)
Else
wc = New WhereClause(pkColumn, BaseFilter.ComparisonOperator.EqualsTo, data)
End If
Else
' if the foreign key does not have DFKA then just check in the foreign key table if the id exists. If not create a record with the specified ID
' before adding to current table
wc = New WhereClause(pkColumn, BaseFilter.ComparisonOperator.EqualsTo, data)
End If
Dim join As BaseClasses.Data.BaseFilter = Nothing
records = originalBaseTable.GetRecordList(join, wc.GetFilter, Nothing, Nothing, 0, 100)
If (records.Count > 0) Then
' take the first record and retrieve its ID.
Dim rec As BaseRecord = CType(records(0), BaseRecord)
colValue = rec.GetValue(pkColumn).ToString
Else
' IF there is not match found then you have to create a record in the foreign key table with DFKA value and then retreive its ID
If ((Not (data) Is Nothing) _
And (data <> "")) Then
Dim tempRec As IRecord
If ((Not (fkColumn.PrimaryKeyDisplayColumns) Is Nothing) _
AndAlso (fkColumn.PrimaryKeyDisplayColumns <> "") AndAlso (Not fkColumn.PrimaryKeyDisplayColumns.Trim().StartsWith("="))) Then
tempRec = originalBaseTable.CreateRecord
Dim tableDef As TableDefinition = originalBaseTable.TableDefinition
For Each newCol As BaseColumn In tableDef.Columns
If fkColumn.PrimaryKeyDisplayColumns = newCol.InternalName Then
tempRec.SetValue(data, newCol.UniqueName)
End If
Next
Else
tempRec = originalBaseTable.CreateRecord(data)
End If
tempRec.Save()
colValue = tempRec.GetValue(pkColumn).ToString
End If
'colValue = data
End If
Else
colValue = data
End If
' set the table row's column for value
record.SetValue(colValue, currentColumn.UniqueName)
isRecordUpdated = True
End If
j = (j + 1)
Catch ex As Exception
Throw New Exception(ex.InnerException.Message)
End Try
Next
Return isRecordUpdated
End Function
Public Shared Function GetDFKA(ByVal fkColumn As ForeignKey) As String 'ByVal rec As BaseRecord,
Dim isDFKA As Boolean = False
If fkColumn Is Nothing Then
Return Nothing
End If
Dim _DFKA As String = fkColumn.PrimaryKeyDisplayColumns
' if the formula is in the format of "= <Primary table>.<Field name>, then pull out the data from the rec object instead of doing formula evaluation
Dim tableCodeName As String = fkColumn.PrimaryKeyTableDefinition.TableCodeName
Dim column As String = _DFKA.Trim("="c).Trim()
If column.StartsWith(tableCodeName & ".", StringComparison.InvariantCultureIgnoreCase) Then
column = column.Substring(tableCodeName.Length + 1)
End If
For Each c As BaseColumn In fkColumn.PrimaryKeyTableDefinition.Columns
If column = c.CodeName Then
isDFKA = True
Exit For
End If
Next
If isDFKA Then
Return column
Else
Return Nothing
End If
End Function
#End Region
End Class
End Namespace

1225
App_Code/Shared/LargeListSelector.Controls.vb Normal file
View file

File diff suppressed because it is too large Load diff

27
App_Code/Shared/MenuXmlSiteMapProvider.vb Normal file
View file

@ -0,0 +1,27 @@
Imports System
Imports System.Web
Imports BaseClasses.Utils
Imports BaseClasses.Configuration
Namespace Persons.UI
''' <summary>
''' Summary description for MenuXmlSiteMapProvider
''' This integrates site map provider with role based security.
''' </summary>
Public Class MenuXmlSiteMapProvider
Inherits XmlSiteMapProvider
' Check the logged in user against the role asigned for the current menu.
' Returns true if logged user belongs to the role. If not then false is returned.
Public Overrides Function IsAccessibleToUser(ByVal context As HttpContext, ByVal node As SiteMapNode) As Boolean
If (node.Roles.Count = 0) Then
Return True
Else
Return BaseClasses.Utils.SecurityControls.IsUserInRole(context, node.Roles)
End If
End Function
End Class
End Namespace

85
App_Code/Shared/Parser.vb Normal file
View file

@ -0,0 +1,85 @@
 Imports System
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports System.Text
Imports System.IO
Namespace Persons.UI
''' <summary>
''' Summary description for Parser: Parser for files like csv, excel etc.
''' </summary>
Public MustInherit Class Parser
' The type of file. ie, extension of the file.
Public Enum FileTypes
CSV
XLS
XLSX
MDB
ACCDB
TAB
End Enum
' Constructor
Public Sub New()
MyBase.New
End Sub
' Reset resources
Public MustOverride Sub Reset()
' Get one record at a time
Public MustOverride Function GetNextRow() As String()
'Close parser and dispose parser object
Public MustOverride Sub Close()
' Generic function to get instance of parser class based on file type.
Public Shared Function GetParser(ByVal filePath As String, ByVal type As FileTypes) As Parser
Dim parsr As Parser = Nothing
Select Case (type)
Case FileTypes.CSV
parsr = New CsvParser(filePath, System.Globalization.CultureInfo.CurrentUICulture.TextInfo.ListSeparator(0))
Case FileTypes.TAB
parsr = New CsvParser(filePath, vbTab)
Case FileTypes.XLS
Try
parsr = New ExcelParser(filePath, HttpContext.Current.Session("SheetName").ToString())
Catch e As Exception
Throw New Exception(e.Message)
End Try
Case FileTypes.XLSX
Try
parsr = New ExcelParser(filePath, HttpContext.Current.Session("SheetName").ToString())
Catch e As Exception
Throw New Exception(e.Message)
End Try
Case FileTypes.MDB
Try
parsr = New AccessParser(filePath, HttpContext.Current.Session("TableName").ToString())
Catch e As Exception
Throw New Exception(e.Message)
End Try
Exit Select
Case FileTypes.ACCDB
Try
parsr = New AccessParser(filePath, HttpContext.Current.Session("TableName").ToString())
Catch e As Exception
Throw New Exception(e.Message)
End Try
Exit Select
End Select
Return parsr
End Function
End Class
End Namespace

165
App_Code/Shared/SignInState.vb Normal file
View file

@ -0,0 +1,165 @@
Imports Persons.Data
Namespace Persons.UI
Public Class SignInConstants
Public Const UserName As String = "SIS_UserName"
Public Const Password As String = "SIS_Password"
Public Const OriginalUserName As String = "SIS_OriginalUserName"
Public Const OriginalPassword As String = "SIS_OriginalPassword"
Public Const OriginalRememberUser As String = "SIS_OriginalRememberUser"
Public Const OriginalRememberPassword As String = "SIS_OriginalRememberPassword"
Public Const IsUNToRemember As String = "SIS_IsUNToRemember"
Public Const IsPassToRemember As String = "SIS_IsPassToRemember"
Public Const IsCancelled As String = "SIS_IsCancelled"
Public Const IsAutoLogin As String = "SIS_IsAutoLogin"
Public Const LoginPassword As String = "SIS_LoginPassword"
End Class
Public Class SignInState
Private Session As System.Web.SessionState.HttpSessionState
Public Property UserName() As String
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.UserName), String)
If (s Is Nothing) Then
Return ""
End If
Return s
End Get
Set(ByVal value As String)
Me.Session.Item(SignInConstants.UserName) = value
End Set
End Property
Public Property Password() As String
Get
Dim CheckCrypto As Crypto = New Crypto(Crypto.Providers.DES)
Dim key As String = BaseClasses.Configuration.ApplicationSettings.Current.CookieEncryptionKey
Dim s As String = CType(Me.Session.Item(SignInConstants.Password), String)
If (s Is Nothing OrElse s.Trim = "") Then
Return ""
End If
Return CheckCrypto.Decrypt(s, key, System.Text.Encoding.Unicode, False)
End Get
Set(ByVal value As String)
Dim CheckCrypto As Crypto = New Crypto(Crypto.Providers.DES)
Dim key As String = BaseClasses.Configuration.ApplicationSettings.Current.CookieEncryptionKey
Me.Session.Item(SignInConstants.Password) = CheckCrypto.Encrypt(value, key, System.Text.Encoding.Unicode, False)
End Set
End Property
Public Property LoginPassword() As String
Get
Dim CheckCrypto As Crypto = New Crypto(Crypto.Providers.DES)
Dim key As String = BaseClasses.Configuration.ApplicationSettings.Current.CookieEncryptionKey
Dim s As String = CType(Me.Session.Item(SignInConstants.LoginPassword), String)
If (s Is Nothing OrElse s.Trim = "") Then
Return ""
End If
Return CheckCrypto.Decrypt(s, key, System.Text.Encoding.Unicode, False)
End Get
Set(ByVal value As String)
Dim CheckCrypto As Crypto = New Crypto(Crypto.Providers.DES)
Dim key As String = BaseClasses.Configuration.ApplicationSettings.Current.CookieEncryptionKey
Me.Session.Item(SignInConstants.LoginPassword) = CheckCrypto.Encrypt(value, key, System.Text.Encoding.Unicode, False)
End Set
End Property
Public Property OriginalUserName() As String
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.OriginalUserName), String)
If (s Is Nothing) Then
Return ""
End If
Return s
End Get
Set(ByVal value As String)
Me.Session.Item(SignInConstants.OriginalUserName) = value
End Set
End Property
Public Property OriginalPassword() As String
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.OriginalPassword), String)
If (s Is Nothing) Then
Return ""
End If
Return s
End Get
Set(ByVal value As String)
Me.Session.Item(SignInConstants.OriginalPassword) = value
End Set
End Property
Public Property OriginalRememberUser() As String
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.OriginalRememberUser), String)
If (s Is Nothing) Then
Return ""
End If
Return s
End Get
Set(ByVal value As String)
Me.Session.Item(SignInConstants.OriginalRememberUser) = value
End Set
End Property
Public Property OriginalRememberPassword() As String
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.OriginalRememberPassword), String)
If (s Is Nothing) Then
Return ""
End If
Return s
End Get
Set(ByVal value As String)
Me.Session.Item(SignInConstants.OriginalRememberPassword) = value
End Set
End Property
Public Property IsUNToRemember() As Boolean
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.IsUNToRemember), String)
If (s Is Nothing) Then
Return False
End If
Return Boolean.Parse(s)
End Get
Set(ByVal value As Boolean)
Me.Session.Item(SignInConstants.IsUNToRemember) = value.ToString
End Set
End Property
Public Property IsPassToRemember() As Boolean
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.IsPassToRemember), String)
If (s Is Nothing) Then
Return False
End If
Return Boolean.Parse(s)
End Get
Set(ByVal value As Boolean)
Me.Session.Item(SignInConstants.IsPassToRemember) = value.ToString
End Set
End Property
Public Property IsCancelled() As Boolean
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.IsCancelled), String)
If (s Is Nothing) Then
Return False
End If
Return Boolean.Parse(s)
End Get
Set(ByVal value As Boolean)
Me.Session.Item(SignInConstants.IsCancelled) = value.ToString
End Set
End Property
Public Property IsAutoLogin() As Boolean
Get
Dim s As String = CType(Me.Session.Item(SignInConstants.IsAutoLogin), String)
If (s Is Nothing) Then
Return True
End If
Return Boolean.Parse(s)
End Get
Set(ByVal value As Boolean)
Me.Session.Item(SignInConstants.IsAutoLogin) = value.ToString
End Set
End Property
Public Sub New()
Me.Session = HttpContext.Current.Session
End Sub
End Class
End Namespace