Option Compare Binary
Option Infer On
'Option Strict On
'Option Explicit On
' *********************************************************************************
' Author Rob Stephens
' A.K.A. RobTexas
' Email robstephens@sbcglobal.net
'
' Thanks to Michael Washington for his blog:
' WCF RIA Service: Combining Two Tables
' *********************************************************************************
' *********************************************************************************
' Provides the WCF - RIA services used in the PeopleTrac LightSwitch application
' *********************************************************************************
Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.ComponentModel.DataAnnotations
Imports System.Linq
Imports System.ServiceModel.DomainServices.Hosting
Imports System.ServiceModel.DomainServices.Server
Imports System.Data.EntityClient
Imports System.Web.Configuration
Imports PeopleTrac_WCF_RIA.ApplicationData.Implementation
Imports System.Data.SqlClient
' *********************************************************************************
' PeopleToMail provides the WCF_RIA entity containing names and addresses of
' people to be included in the planned mailing.
'
' *********************************************************************************
Public Class PeopleToMail
<Key()> Public Property ID As Integer
Public Property Salutation As String
Public Property FirstName As String
Public Property LastName As String
Public Property NameSuffix As String
Public Property Company As String
Public Property Address1 As String
Public Property Address2 As String
Public Property State As String
Public Property Zip As String
Public Property MailListName As String
Public Property MailCodeName As String
Public Property IsSecondary As Boolean
End Class
' *********************************************************************************
' PeopleCountByMailcode provides the WCF_RIA entity that returns the number of
' people currently in the database - by Mail Code.
' *********************************************************************************
Public Class PeopleCountByMailcode
<Key()> Public Property ID As Integer
Public Property MailCodeName As String
Public Property MailCode As Integer
Public Property PeopleCount As Integer
End Class
' *********************************************************************************
' PeopleCountByMailcode provides the WCF_RIA entity that returns the number of
' people currently in the database - by Zip.
' *********************************************************************************
Public Class PeopleCountByZip
<Key()> Public Property ID As Integer
Public Property ZipCode As String
Public Property PeopleCount As Integer
End Class
' *********************************************************************************
' MatchResults provides the WCF_RIA entity that returns the number of
' people currently in the database - by Match Result.
' *********************************************************************************
Public Class MatchResults
<Key()> Public Property ID As Integer
Public Property MatchResult As String
Public Property Count As Integer
End Class
' *********************************************************************************
' UpdateResults provides the WCF_RIA entity that returns results of SQL
' operations performed by executing raw SQL Commands.
' *********************************************************************************
Public Class UpdateResults
<Key()> Public Property ID As Integer
Public Property StartTime As Date
Public Property EndTime As Date
Public Property Result As String
End Class
Public Class WCF_RIA_Service
Inherits DomainService
#Region "Database connection"
Private m_context As ApplicationDataObjectContext
Dim connString As String = System.Web.Configuration.WebConfigurationManager.ConnectionStrings("_IntrinsicData").ConnectionString
Dim builder As New EntityConnectionStringBuilder()
Public ReadOnly Property Context As ApplicationDataObjectContext
Get
If Me.m_context Is Nothing Then
builder.Metadata = "res://*/ApplicationData.csdl|res://*/ApplicationData.ssdl|res://*/ApplicationData.msl"
builder.Provider = "System.Data.SqlClient"
builder.ProviderConnectionString = connString
Me.m_context = New ApplicationDataObjectContext(builder.ConnectionString)
End If
Return Me.m_context
End Get
End Property
#End Region
Private Property myquery As Object
' *********************************************************************************
' GetPeopleToMail is the default query for PeopleToMail
' In order to identify the correct people, three tables must be joined:
' People
' MailLists
' MailCodes
' Each person can only have one mail code. However, a mail code can be included in
' multiple mail lists. So it is possible for a person to me returned multiple
' times.
' The ID's of the returned records are calculated using the Mail List ID to ensure
' uniqueness.
' *********************************************************************************
<Query(IsDefault:=True)> _
Public Function GetPeopleToMail() As IQueryable(Of PeopleToMail)
Dim colMailToPrimary As IQueryable(Of PeopleToMail)
colMailToPrimary = From p In Me.Context.People
Join m In Me.Context.MailListCodes
On p.Person_MailCode Equals m.MailListCode_MailCode
Join l In Me.Context.MailLists On m.MailListCode_MailList Equals l.Id
Join c In Me.Context.MailCodes On p.Person_MailCode Equals c.Id
Select New PeopleToMail With
{.ID = p.Id + (m.Id + 100000),
.Salutation = p.Salutation,
.FirstName = p.FirstName,
.LastName = p.LastName,
.NameSuffix = p.NameSuffix,
.Company = p.Company,
.Address1 = p.Address1,
.Address2 = p.Address2,
.State = p.State,
.Zip = p.Zip,
.MailListName = l.MailListName,
.MailCodeName = c.MailCodeName,
.IsSecondary = p.SecondaryContactFlag}
Return colMailToPrimary
End Function
' *********************************************************************************
' GetPeopleToMailSelected is an alternative query for PeopleToMail
' In order to identify the correct people, three tables must be joined:
' People
' MailLists
' MailCodes
' The MailListName parameter will restrict the output to a specific mail list.
' This should mean that all people are unique, but the ID calculation from above
' is left in place to make sure.
' The IncludeSecondaries provides the ability to include or exclude secondary
' people. These are people that live at the same address as another, and have
' indicated they only want a single mailing.
' The IncludeExternals parameter provides the ability to include any list that was
' been brought into the External List table. Note that this is not the same as
' the Import list.
' The External List contains people you want to mail to this time, but you don't
' want to add to your database. Most often a list of people you got from another
' organization
' *********************************************************************************
<Query()> _
Public Function GetPeopleToMailSelected(MailListName As String, IncludeSecondaries As Nullable(Of Boolean), IncludeExternals As Nullable(Of Boolean)) As IQueryable(Of PeopleToMail)
Dim colMailToPrimary As IQueryable(Of PeopleToMail)
Dim colMailToPrimary2 As IQueryable(Of PeopleToMail)
colMailToPrimary = From p In Me.Context.People
Join m In Me.Context.MailListCodes
On p.Person_MailCode Equals m.MailListCode_MailCode
Join l In Me.Context.MailLists On m.MailListCode_MailList Equals l.Id
Join c In Me.Context.MailCodes On p.Person_MailCode Equals c.Id
Where l.MailListName = MailListName
Select New PeopleToMail With
{.ID = p.Id + (m.Id + 100000),
.Salutation = p.Salutation,
.FirstName = p.FirstName,
.LastName = p.LastName,
.NameSuffix = p.NameSuffix,
.Company = p.Company,
.Address1 = p.Address1,
.Address2 = p.Address2,
.State = p.State,
.Zip = p.Zip,
.MailListName = l.MailListName,
.MailCodeName = c.MailCodeName,
.IsSecondary = p.SecondaryContactFlag}
If IncludeSecondaries = False Then
colMailToPrimary = From p In colMailToPrimary
Where p.IsSecondary = False
Select New PeopleToMail With
{.ID = p.ID,
.Salutation = p.Salutation,
.FirstName = p.FirstName,
.LastName = p.LastName,
.NameSuffix = p.NameSuffix,
.Company = p.Company,
.Address1 = p.Address1,
.Address2 = p.Address2,
.State = p.State,
.Zip = p.Zip,
.MailListName = p.MailListName,
.MailCodeName = p.MailCodeName,
.IsSecondary = p.IsSecondary}
End If
colMailToPrimary2 = From pe In Me.Context.ExternalMailPersons
Where pe.MatchesExistingPerson = False
Select New PeopleToMail With
{.ID = pe.Id * -1,
.Salutation = pe.Salutation,
.FirstName = pe.FirstName,
.LastName = pe.LastName,
.NameSuffix = pe.NameSuffix,
.Company = pe.Company,
.Address1 = pe.Address1,
.Address2 = pe.Address2,
.State = pe.State,
.Zip = pe.Zip,
.MailListName = "External",
.MailCodeName = "External",
.IsSecondary = False}
If IncludeExternals = True Then
If colMailToPrimary2.Count > 0 Then
Return colMailToPrimary.Union(colMailToPrimary2)
Else
Return colMailToPrimary
End If
Else
Return colMailToPrimary
End If
End Function
' *********************************************************************************
' GetPeopleCountByMailCode
' GetPeopleCountByZip
' GetMatchCounts
' Are the default queries to return the appropriate counts
' *********************************************************************************
<Query(IsDefault:=True)> _
Public Function GetPeopleCountByMailcode() As IQueryable(Of PeopleCountByMailcode)
Dim colToReturn As IQueryable(Of PeopleCountByMailcode)
Dim colToBuild As IQueryable(Of PeopleCountByMailcode)
colToBuild = From p In Me.Context.People
Group p By p.Person_MailCode Into g = Group
Select New PeopleCountByMailcode With
{.ID = 0,
.MailCode = Person_MailCode,
.PeopleCount = g.Count,
.MailCodeName = ""}
colToReturn = From ps In colToBuild
Join mc In Me.Context.MailCodes On ps.MailCode Equals mc.Id
Select New PeopleCountByMailcode With
{.ID = mc.Id,
.MailCode = mc.Id,
.PeopleCount = ps.PeopleCount,
.MailCodeName = mc.MailCodeName}
Return colToReturn
End Function
<Query(IsDefault:=True)> _
Public Function GetPeopleCountByZip() As IQueryable(Of PeopleCountByZip)
Dim colToBuild As IQueryable(Of PeopleCountByZip)
Dim colToReturn As IQueryable(Of PeopleCountByZip)
Dim colToReturnS As IQueryable(Of PeopleCountByZip)
colToBuild = From p In Me.Context.People
Select New PeopleCountByZip With
{.ID = p.Id,
.PeopleCount = 0,
.ZipCode = p.Zip.Substring(0, 5)}
colToReturn = From ps In colToBuild
Group ps By ps.ZipCode Into g = Group
Select New PeopleCountByZip With
{.ID = g.Max(Function(p3) p3.ID),
.PeopleCount = g.Count,
.ZipCode = ZipCode}
colToReturnS = From pss In colToReturn
Order By pss.PeopleCount Descending
Select New PeopleCountByZip With
{.ID = pss.ID,
.PeopleCount = pss.PeopleCount,
.ZipCode = pss.ZipCode}
Return colToReturnS
End Function
<Query(IsDefault:=True)> _
Public Function GetMatchCounts() As IQueryable(Of MatchResults)
Dim colToReturn1 As IQueryable(Of MatchResults)
colToReturn1 = From ps In Me.Context.ImportPersons
Group ps By ps.MatchResult Into g = Group
Select New MatchResults With
{.ID = g.Max(Function(p3) p3.Id),
.MatchResult = MatchResult,
.Count = g.Count}
Return colToReturn1
End Function
' *********************************************************************************
' GetUpdateResults is the default query for UpdateResults
' It actually does not get used, rather it satifies the requirement that each
' WCF_RIA entity must have a default query that requires no parameters.
' If it looks like it does nothing - that's true.
' *********************************************************************************
<Query(IsDefault:=True)>
Public Function GetUpdateResults() As IEnumerable(Of UpdateResults)
Dim myResults As New List(Of UpdateResults)
Dim wrkResult As New UpdateResults
wrkResult.StartTime = Now
wrkResult.EndTime = Now
wrkResult.ID = 1
wrkResult.Result = "No Action"
myResults.Add(wrkResult)
Dim rtnResults As IEnumerable(Of UpdateResults) = From r In myResults
Return rtnResults
End Function
' *********************************************************************************
' PerformUpdate is an alternative query for UpdateResults that will handle the
' updates of imported people to the database.
' The UpdateAction parameter identifies the action to be performed.
' The actions currently supported are:
' Update the people table with new people (Imports)
' Update the addresses of people currently on the database (AddressChange)
' Add subscription information (Subscriptions)
' Add Donations (Donations)
' The returned results identify if the operation was successful.
' Note that the calling modules must take care of ensuring that these updates are
' performed in the correct sequence and subjected to checks on success.
'
' *********************************************************************************
Public Function PerformUpdate(UpdateAction As String) As UpdateResults
Dim myResults As New UpdateResults
myResults.StartTime = Now
myResults.ID = 1
myResults.Result = "Started"
Select Case UpdateAction
Case "Imports"
myResults = UpdateImports()
Case "AddressChange"
myResults = UpdateAddresses()
Case "Subscriptions"
myResults = UpdateSubs()
Case "Donations"
myResults = UpdateDonations()
End Select
myResults.EndTime = Now
Return myResults
End Function
Private Function UpdateImports() As UpdateResults
Dim myResults As New UpdateResults
myResults.StartTime = Now
myResults.ID = 1
myResults.Result = "OK"
Dim myCommand As String = "INSERT INTO People " &
"(LastName, FirstName, Salutation, NameSuffix, Address1, Address2, City, State, Zip, Email, HomePhone, MobilPhone, BusinessPhone, Company, Person_MailCode) " &
"SELECT LastName, FirstName, Salutation, NameSuffix, Address1, Address2, City, State, Zip, Email, HomePhone, MobilPhone, BusinessPhone, Company, ImportPerson_MailCode " &
"FROM ImportPersons " &
"WHERE (MatchesExistingPerson = 0)"
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex As Exception
myResults.Result = ex.Message
End Try
If myResults.Result = "OK" Then
myCommand = "UPDATE ImportPersons " &
"SET MatchesExistingPerson = 1, BestPrimaryMatchID = People.Id " &
"FROM ImportPersons " &
"INNER JOIN People ON ImportPersons.LastName = People.LastName AND ImportPersons.Address1 = People.Address1 AND ImportPersons.Zip = People.Zip " &
" WHERE(ImportPersons.MatchesExistingPerson = 0)"
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex As Exception
myResults.Result = ex.Message
End Try
End If
myResults.EndTime = Now
Return myResults
End Function
Private Function UpdateAddresses() As UpdateResults
Dim myResults As New UpdateResults
myResults.StartTime = Now
myResults.ID = 1
myResults.Result = "OK"
Dim myCommand As String = "UPDATE People " &
"SET Address1 = ImportPersons.Address1, Address2 = ImportPersons.Address2, City = ImportPersons.City, Zip = ImportPersons.Zip " &
"FROM People INNER JOIN " &
"ImportPersons ON People.Id = ImportPersons.BestPrimaryMatchID " &
"WHERE ImportPersons.UpdateAddress = 1 "
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex As Exception
myResults.Result = ex.Message
End Try
myResults.EndTime = Now
Return myResults
End Function
Private Function UpdateSubs() As UpdateResults
Dim myResults As New UpdateResults
myResults.StartTime = Now
myResults.ID = 1
myResults.Result = "OK"
Dim myCommand As String = "INSERT INTO Subscriptions " &
"(Subscription_Person, Subscription_Season, RefNumber, SubscriptionDate) " &
"SELECT ImportPersons.BestPrimaryMatchID, ImportPersons.ImportPerson_Season, 0 AS RefNumber, getdate() AS DateToday " &
"FROM ImportPersons " &
"LEFT OUTER JOIN Subscriptions AS Subscriptions_1 ON ImportPersons.ImportPerson_Season = Subscriptions_1.Subscription_Season " &
"AND ImportPersons.BestPrimaryMatchID = Subscriptions_1.Subscription_Person " &
"WHERE(Subscriptions_1.Subscription_Person Is NULL) And (Subscriptions_1.Subscription_Season Is NULL)"
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex As Exception
myResults.Result = ex.Message
End Try
If myResults.Result = "OK" Then
myCommand = "UPDATE ImportPersons " &
"SET SubscriptionID = Subscriptions.Id " &
"FROM ImportPersons " &
"INNER JOIN Subscriptions ON ImportPersons.BestPrimaryMatchID = Subscriptions.Subscription_Person " &
"AND ImportPersons.ImportPerson_Season = Subscriptions.Subscription_Season"
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex1 As Exception
myResults.Result = ex1.Message
End Try
If myResults.Result = "OK" Then
myCommand = "INSERT INTO SubscriptionDetails " &
"(SubscriptionDetail_Subscription, SubscriptionDetail_SubscriptionType, Quantity) " &
"SELECT ImportPersons.SubscriptionID, ImportPersons.ImportPerson_SubscriptionType, ImportPersons.SubscriptionQty " &
"FROM ImportPersons " &
"LEFT OUTER JOIN SubscriptionDetails AS SubscriptionDetails_1 ON ImportPersons.SubscriptionID = SubscriptionDetails_1.SubscriptionDetail_Subscription " &
"WHERE (SubscriptionDetails_1.SubscriptionDetail_Subscription IS NULL)"
Try
myResults.Result = ExecuteSQLCommand(myCommand)
Catch ex2 As Exception
myResults.Result = ex2.Message
End Try
End If
End If
myResults.EndTime = Now
Return myResults
End Function
Private Function UpdateDonations() As UpdateResults
Dim myResults As New UpdateResults
myResults.StartTime = Now
myResults.ID = 1
myResults.Result = "OK"
'TODO Add code to support season donations
'Dim myCommand As String = ""
' myResults.Result = ExecuteSQLCommand(myCommand)
myResults.EndTime = Now
Return myResults
End Function
Private Function ExecuteSQLCommand(ByVal CommandAsString As String) As String
ExecuteSQLCommand = "OK"
Try
Me.Context.ExecuteStoreCommand(CommandAsString)
Catch ex As Exception
ExecuteSQLCommand = ex.Message
End Try
End Function
Protected Overrides Function Count(Of T)(query As IQueryable(Of T)) As Integer
Return query.Count()
End Function
End Class
Submit an article or tip