giovedì 16 ottobre 2008

Select Distinct su DataSet in Vb.Net

Le funzioni sotto riportate permettono di effettuare da codice una query con "Select Distinct" su un DataSet.

FieldNames è un array di string con in campi su cui fare la select distinct.



Public Function SelectDistinct(ByVal SourceTable As DataTable, _
    ByVal ParamArray FieldNames() As String) As DataTable

    Dim lastValues() As Object
    Dim newTable As DataTable

    If FieldNames Is Nothing OrElse FieldNames.Length = 0 Then
        Throw New ArgumentNullException("FieldNames")
    End If

    lastValues = New Object(FieldNames.Length - 1) {}
    newTable = New DataTable

    For Each field As String In FieldNames
        newTable.Columns.Add(field, SourceTable.Columns(field).DataType)
    Next

    For Each Row As DataRow In SourceTable.Select("", String.Join(", ", FieldNames))
        If Not fieldValuesAreEqual(lastValues, Row, FieldNames) Then
            newTable.Rows.Add(createRowClone(Row, newTable.NewRow(), FieldNames))
            setLastValues(lastValues, Row, FieldNames)
        End If
    Next

    Return newTable
End Function



Private Function fieldValuesAreEqual(ByVal lastValues() As Object, _
    ByVal currentRow As DataRow, ByVal fieldNames() As String) As Boolean

    Dim areEqual As Boolean = True

    For i As Integer = 0 To fieldNames.Length - 1
        If lastValues(i) Is Nothing OrElse Not lastValues(i).Equals(currentRow(fieldNames(i))) Then
            areEqual = False
            Exit For
        End If
    Next

    Return areEqual
End Function



Private Function createRowClone(ByVal sourceRow As DataRow, _
    ByVal newRow As DataRow, ByVal fieldNames() As String) As DataRow

    For Each field As String In fieldNames
        newRow(field) = sourceRow(field)
    Next

    Return newRow
End Function



Private Shared Sub setLastValues(ByVal lastValues() As Object, _
    ByVal sourceRow As DataRow, ByVal fieldNames() As String)

    For i As Integer = 0 To fieldNames.Length - 1
        lastValues(i) = sourceRow(fieldNames(i))
    Next
End Sub

Nessun commento: