| Current Path : G:/PleskVhosts/mpcdp.in/cmamp.mpcdp.in/cdpp3/App_Code/ |
Windows NT SG2NWVPWEB022 10.0 build 17763 (Windows Server 2016) i586 |
| Current File : G:/PleskVhosts/mpcdp.in/cmamp.mpcdp.in/cdpp3/App_Code/DataSetHelpe.vb |
Imports System.Collections.Generic
Imports System.Text
Imports System.Configuration
Imports System.Data
Public Class DataSetHelper
Private ds As DataSet
Private m_FieldInfo As System.Collections.ArrayList
Private m_FieldList As String
Private GroupByFieldInfo As System.Collections.ArrayList
Private GroupByFieldList As String
Public Sub New(ByRef DataSet As DataSet)
ds = DataSet
End Sub
Public Sub New()
ds = Nothing
End Sub
Private Sub ParseFieldList(ByVal FieldList As String, ByVal AllowRelation As Boolean)
'
' * This code parses FieldList into FieldInfo objects and then
' * adds them to the m_FieldInfo private member
' *
' * FieldList systax: [relationname.]fieldname[ alias], ...
'
If m_FieldList = FieldList Then
Return
End If
m_FieldInfo = New System.Collections.ArrayList()
m_FieldList = FieldList
Dim Field As FieldInfo
Dim FieldParts As String()
Dim Fields As String() = FieldList.Split(","c)
Dim i As Integer
For i = 0 To Fields.Length - 1
Field = New FieldInfo()
'parse FieldAlias
FieldParts = Fields(i).Trim().Split(" "c)
Select Case FieldParts.Length
Case 1
'to be set at the end of the loop
Exit Select
Case 2
Field.FieldAlias = FieldParts(1)
Exit Select
Case Else
Throw New Exception("Too many spaces in field definition: '" & Fields(i) & "'.")
End Select
'parse FieldName and RelationName
FieldParts = FieldParts(0).Split("."c)
Select Case FieldParts.Length
Case 1
Field.FieldName = FieldParts(0)
Exit Select
Case 2
If AllowRelation = False Then
Throw New Exception("Relation specifiers not permitted in field list: '" & Fields(i) & "'.")
End If
Field.RelationName = FieldParts(0).Trim()
Field.FieldName = FieldParts(1).Trim()
Exit Select
Case Else
Throw New Exception("Invalid field definition: " & Fields(i) & "'.")
End Select
If Field.FieldAlias Is Nothing Then
Field.FieldAlias = Field.FieldName
End If
m_FieldInfo.Add(Field)
Next
End Sub
Private Sub ParseGroupByFieldList(ByVal FieldList As String)
'
' * Parses FieldList into FieldInfo objects and adds them to the GroupByFieldInfo private member
' *
' * FieldList syntax: fieldname[ alias]|operatorname(fieldname)[ alias],...
' *
' * Supported Operators: count,sum,max,min,first,last,avg
'
If GroupByFieldList = FieldList Then
Return
End If
GroupByFieldInfo = New System.Collections.ArrayList()
Dim Field As FieldInfo
Dim FieldParts As String()
Dim Fields As String() = FieldList.Split(","c)
For i As Integer = 0 To Fields.Length - 1
Field = New FieldInfo()
'Parse FieldAlias
FieldParts = Fields(i).Trim().Split(" "c)
Select Case FieldParts.Length
Case 1
'to be set at the end of the loop
Exit Select
Case 2
Field.FieldAlias = FieldParts(1)
Exit Select
Case Else
Throw New ArgumentException("Too many spaces in field definition: '" & Fields(i) & "'.")
End Select
'Parse FieldName and Aggregate
FieldParts = FieldParts(0).Split("("c)
Select Case FieldParts.Length
Case 1
Field.FieldName = FieldParts(0)
Exit Select
Case 2
Field.Aggregate = FieldParts(0).Trim().ToLower()
'we're doing a case-sensitive comparison later
Field.FieldName = FieldParts(1).Trim(" "c, ")"c)
Exit Select
Case Else
Throw New ArgumentException("Invalid field definition: '" & Fields(i) & "'.")
End Select
If Field.FieldAlias Is Nothing Then
If Field.Aggregate Is Nothing Then
Field.FieldAlias = Field.FieldName
Else
Field.FieldAlias = Field.Aggregate & "of" & Field.FieldName
End If
End If
GroupByFieldInfo.Add(Field)
Next
GroupByFieldList = FieldList
End Sub
Private Function CreateGroupByTable(ByVal TableName As String, ByVal SourceTable As DataTable, ByVal FieldList As String) As DataTable
'
' * Creates a table based on aggregates of fields of another table
' *
' * RowFilter affects rows before GroupBy operation. No "Having" support
' * though this can be emulated by subsequent filtering of the table that results
' *
' * FieldList syntax: fieldname[ alias]|aggregatefunction(fieldname)[ alias], ...
'
If FieldList Is Nothing Then
'return CreateTable(TableName, SourceTable);
Throw New ArgumentException("You must specify at least one field in the field list.")
Else
Dim dt As New DataTable(TableName)
ParseGroupByFieldList(FieldList)
For Each Field As FieldInfo In GroupByFieldInfo
Dim dc As DataColumn = SourceTable.Columns(Field.FieldName)
If Field.Aggregate Is Nothing Then
dt.Columns.Add(Field.FieldAlias, dc.DataType, dc.Expression)
Else
dt.Columns.Add(Field.FieldAlias, dc.DataType)
End If
Next
If ds IsNot Nothing Then
ds.Tables.Add(dt)
End If
Return dt
End If
End Function
Private Sub InsertGroupByInto(ByVal DestTable As DataTable, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal GroupBy As String)
InsertGroupByInto(DestTable, SourceTable, FieldList, "", GroupBy, New String() {""})
End Sub
Private Sub InsertGroupByInto(ByVal DestTable As DataTable, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal RowFilter As String, ByVal GroupBy As String, ByVal MergeDataForColumns As String())
'
' * Copies the selected rows and columns from SourceTable and inserts them into DestTable
' * FieldList has same format as CreateGroupByTable
'
If FieldList Is Nothing Then
Throw New ArgumentException("You must specify at least one field in the field list.")
End If
ParseGroupByFieldList(FieldList)
'parse field list
ParseFieldList(GroupBy, False)
'parse field names to Group By into an arraylist
Dim Rows As DataRow() = SourceTable.[Select](RowFilter, GroupBy)
Dim LastSourceRow As DataRow = Nothing, DestRow As DataRow = Nothing
Dim SameRow As Boolean
Dim RowCount As Integer = 0
For Each SourceRow As DataRow In Rows
SameRow = False
If LastSourceRow IsNot Nothing Then
SameRow = True
For Each Field As FieldInfo In m_FieldInfo
If Not ColumnEqual(LastSourceRow(Field.FieldName), SourceRow(Field.FieldName)) Then
SameRow = False
Exit For
End If
Next
If Not SameRow Then
DestTable.Rows.Add(DestRow)
End If
End If
If Not SameRow Then
DestRow = DestTable.NewRow()
RowCount = 0
End If
RowCount += 1
For Each Field As FieldInfo In GroupByFieldInfo
Select Case Field.Aggregate
'this test is case-sensitive
'implicit last
'implicit last
Case Nothing, "", "last"
Dim go As Boolean = False
'checking if current field matches the fields in ColumnsToMegre
For i As Integer = 0 To MergeDataForColumns.Length - 1
If Field.FieldAlias.Equals(MergeDataForColumns(i)) Then
go = True
Exit For
End If
Next
If go AndAlso DestRow(Field.FieldAlias).ToString().Length > 0 Then
If Not DestRow(Field.FieldAlias).ToString().Contains(SourceRow(Field.FieldName).ToString()) Then
DestRow(Field.FieldAlias) = Convert.ToString(DestRow(Field.FieldAlias)) & ", " & Convert.ToString(SourceRow(Field.FieldName))
End If
Else
DestRow(Field.FieldAlias) = SourceRow(Field.FieldName)
End If
Exit Select
Case "first"
If RowCount = 1 Then
DestRow(Field.FieldAlias) = SourceRow(Field.FieldName)
End If
Exit Select
Case "count"
DestRow(Field.FieldAlias) = RowCount
Exit Select
Case "sum"
DestRow(Field.FieldAlias) = Add(DestRow(Field.FieldAlias), SourceRow(Field.FieldName))
Exit Select
Case "avg"
DestRow(Field.FieldAlias) = Avg(DestRow(Field.FieldAlias), SourceRow(Field.FieldName))
Exit Select
Case "max"
DestRow(Field.FieldAlias) = Max(DestRow(Field.FieldAlias), SourceRow(Field.FieldName))
Exit Select
Case "min"
If RowCount = 1 Then
DestRow(Field.FieldAlias) = SourceRow(Field.FieldName)
Else
DestRow(Field.FieldAlias) = Min(DestRow(Field.FieldAlias), SourceRow(Field.FieldName))
End If
Exit Select
End Select
Next
LastSourceRow = SourceRow
Next
If DestRow IsNot Nothing Then
DestTable.Rows.Add(DestRow)
End If
End Sub
Private Function LocateFieldInfoByName(ByVal FieldList As System.Collections.ArrayList, ByVal Name As String) As FieldInfo
'Looks up a FieldInfo record based on FieldName
For Each Field As FieldInfo In FieldList
If Field.FieldName = Name Then
Return Field
End If
Next
Return Nothing
End Function
Private Function ColumnEqual(ByVal a As Object, ByVal b As Object) As Boolean
'
' * Compares two values to see if they are equal. Also compares DBNULL.Value.
' *
' * Note: If your DataTable contains object fields, you must extend this
' * function to handle them in a meaningful way if you intend to group on them.
'
If (TypeOf a Is DBNull) AndAlso (TypeOf b Is DBNull) Then
Return True
End If
'both are null
If (TypeOf a Is DBNull) OrElse (TypeOf b Is DBNull) Then
Return False
End If
'only one is null
Return (a.Equals(b))
'value type standard comparison
'return (a == b); //value type standard comparison
End Function
Public Function MinAndMax(ByVal dataTable As DataTable, ByVal columnName As String) As Object()
Dim objs As Object() = New Object(1) {}
If dataTable.Rows.Count > 0 Then
Dim drs As DataRow() = dataTable.[Select]("1=1", columnName)
objs(0) = drs(0)(columnName).ToString()
objs(1) = drs(drs.Length - 1)(columnName).ToString()
Return objs
End If
Return Nothing
End Function
Public Function Min(ByVal dataTable As DataTable, ByVal columnName As String) As Object
If dataTable.Rows.Count > 0 Then
Dim drs As DataRow() = dataTable.[Select]("1=1", columnName)
Return drs(0)(columnName).ToString()
End If
Return Nothing
End Function
Public Function Min(ByVal a As Object, ByVal b As Object) As Object
'Returns MIN of two values - DBNull is less than all others
If (TypeOf a Is DBNull) OrElse (TypeOf b Is DBNull) Then
Return DBNull.Value
End If
Dim dtA As DateTime
Dim dblA As Double = 0
If DateTime.TryParse(a.ToString(), dtA) Then
Dim dtB As DateTime
If DateTime.TryParse(a.ToString(), dtB) Then
If dtA < dtB Then
Return a
Else
Return b
End If
Else
Return DBNull.Value
End If
ElseIf Double.TryParse(a.ToString(), dblA) Then
Dim dblB As Double = 0
If Double.TryParse(b.ToString(), dblB) Then
If dblA < dblB Then
Return a
Else
Return b
End If
Else
Return DBNull.Value
End If
Else
If DirectCast(a, IComparable).CompareTo(b) = -1 Then
Return a
Else
Return b
End If
End If
End Function
Public Function Max(ByVal dataTable As DataTable, ByVal columnName As String) As Object
If dataTable.Rows.Count > 0 Then
Dim drs As DataRow() = dataTable.[Select]("1=1", columnName & " DESC")
Return drs(0)(columnName).ToString()
End If
Return Nothing
End Function
Public Function Max(ByVal a As Object, ByVal b As Object) As Object
'Returns Max of two values - DBNull is less than all others
If TypeOf a Is DBNull Then
Return b
End If
If TypeOf b Is DBNull Then
Return a
End If
Dim dtA As DateTime
Dim dblA As Double = 0
If DateTime.TryParse(a.ToString(), dtA) Then
Dim dtB As DateTime
If DateTime.TryParse(a.ToString(), dtB) Then
If dtA > dtB Then
Return a
Else
Return b
End If
Else
Return DBNull.Value
End If
ElseIf Double.TryParse(a.ToString(), dblA) Then
Dim dblB As Double = 0
If Double.TryParse(b.ToString(), dblB) Then
If dblA > dblB Then
Return a
Else
Return b
End If
Else
Return DBNull.Value
End If
Else
If DirectCast(a, IComparable).CompareTo(b) = 1 Then
Return a
Else
Return b
End If
End If
End Function
Public Function Add(ByVal a As Object, ByVal b As Object) As Object
'Adds two values - if one is DBNull, then returns the other
If TypeOf a Is DBNull Then
Return b
End If
If TypeOf b Is DBNull Then
Return a
End If
Return (Convert.ToDecimal(a) + Convert.ToDecimal(b))
End Function
Public Function Avg(ByVal a As Object, ByVal b As Object) As Object
'Averages two values - if one is DBNull, then returns the other
'
' if (a is DBNull)
' return b;
' if (b is DBNull)
' return a;
'
Dim dblA As Double = 0.0
Dim dblB As Double = 0.0
Double.TryParse(a.ToString(), dblA)
Double.TryParse(b.ToString(), dblB)
Return ((Convert.ToDouble(dblA) + Convert.ToDouble(dblB)) / 2)
End Function
Public Function SelectGroupByInto(ByVal TableName As String, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal RowFilter As String, ByVal GroupBy As String) As DataTable
' Usage: SelectGroupByInto("dtNewEmployee", dtEmployee, "Sum(salary) Sum_Salary, Emp_ID, Avg(salary) Avg_Salary", "dept_id=12", "Emp_ID");
' * The result datatable will be automatically sorted in asc order by column(s) provided in GroupBy parameter.
'
Return SelectGroupByInto(TableName, SourceTable, FieldList, RowFilter, GroupBy, New String(-1) {})
End Function
Public Function SelectGroupByInto(ByVal TableName As String, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal RowFilter As String, ByVal GroupBy As String, ByVal MergeDataForColumns As String()) As DataTable
'
' * Selects data from one DataTable to another and performs various aggregate functions
' * along the way. See InsertGroupByInto and ParseGroupByFieldList for supported aggregate functions.
'
Dim dt As DataTable = CreateGroupByTable(TableName, SourceTable, FieldList)
InsertGroupByInto(dt, SourceTable, FieldList, RowFilter, GroupBy, MergeDataForColumns)
Return dt
End Function
Private Class FieldInfo
Public RelationName As String
Public FieldName As String
'source table field name
Public FieldAlias As String
'destination table field name
Public Aggregate As String
End Class
Public Function RemoveDuplicates(ByVal table As DataTable, ByVal keyColumns As List(Of String)) As DataTable
Dim uniquenessDict As New Dictionary(Of String, String)(table.Rows.Count)
Dim sb As StringBuilder = Nothing
Dim rowIndex As Integer = 0
Dim row As DataRow
Dim rows As DataRowCollection = table.Copy().Rows
While rowIndex < rows.Count
row = rows(rowIndex)
sb = New StringBuilder()
For Each colname As String In keyColumns
sb.Append((row(colname).ToString()))
Next
If uniquenessDict.ContainsKey(sb.ToString()) Then
rows.Remove(row)
Else
uniquenessDict.Add(sb.ToString(), String.Empty)
rowIndex += 1
End If
End While
'while end
Dim dtUnique As DataTable = table.Clone()
For Each dr As DataRow In rows
dtUnique.ImportRow(dr)
Next
Return dtUnique
End Function
Private Function CreateJoinTable(ByVal TableName As String, ByVal SourceTable As DataTable, ByVal FieldList As String) As DataTable
'
' * Creates a table based on fields of another table and related parent tables
' *
' * FieldList syntax: [relationname.]fieldname[ alias][,[relationname.]fieldname[ alias]]...
'
If FieldList Is Nothing Then
'return CreateTable(TableName, SourceTable);
Throw New ArgumentException("You must specify at least one field in the field list.")
Else
Dim dt As New DataTable(TableName)
ParseFieldList(FieldList, True)
For Each Field As FieldInfo In m_FieldInfo
If Field.RelationName Is Nothing Then
Dim dc As DataColumn = SourceTable.Columns(Field.FieldName)
dt.Columns.Add(dc.ColumnName, dc.DataType, dc.Expression)
Else
Dim dc As DataColumn = SourceTable.ParentRelations(Field.RelationName).ParentTable.Columns(Field.FieldName)
dt.Columns.Add(dc.ColumnName, dc.DataType, dc.Expression)
End If
Next
If ds IsNot Nothing Then
ds.Tables.Add(dt)
End If
Return dt
End If
End Function
Private Sub InsertJoinInto(ByVal DestTable As DataTable, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal RowFilter As String, ByVal Sort As String)
'
' * Copies the selected rows and columns from SourceTable and inserts them into DestTable
' * FieldList has same format as CreatejoinTable
'
If FieldList Is Nothing Then
'InsertInto(DestTable, SourceTable, RowFilter, Sort);
Throw New ArgumentException("You must specify at least one field in the field list.")
Else
ParseFieldList(FieldList, True)
Dim Rows As DataRow() = SourceTable.[Select](RowFilter, Sort)
For Each SourceRow As DataRow In Rows
Dim DestRow As DataRow = DestTable.NewRow()
For Each Field As FieldInfo In m_FieldInfo
If Field.RelationName Is Nothing Then
DestRow(Field.FieldName) = SourceRow(Field.FieldName)
Else
Dim ParentRow As DataRow = SourceRow.GetParentRow(Field.RelationName)
DestRow(Field.FieldName) = ParentRow(Field.FieldName)
End If
Next
DestTable.Rows.Add(DestRow)
Next
End If
End Sub
Public Function SelectJoinInto(ByVal TableName As String, ByVal SourceTable As DataTable, ByVal FieldList As String, ByVal RowFilter As String, ByVal Sort As String) As DataTable
'
' * Selects sorted, filtered values from one DataTable to another.
' * Allows you to specify relationname.fieldname in the FieldList to include fields from
' * a parent table. The Sort and Filter only apply to the base table and not to related tables.
'
Dim dt As DataTable = CreateJoinTable(TableName, SourceTable, FieldList)
InsertJoinInto(dt, SourceTable, FieldList, RowFilter, Sort)
Return dt
End Function
End Class