home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1998 February
/
CHIP_2_98.iso
/
software
/
pelne
/
optionp
/
iis4_07.cab
/
Employee.cls
< prev
next >
Wrap
Text File
|
1997-11-01
|
19KB
|
528 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Employee"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Function AddNew(ByVal strFileDSN As String, ByVal strNTUserName As String, _
ByVal intBenefitYear As Integer, ByVal lngQualifierId As Long, _
ByVal datQualifierDate As Date)
' Define transaction context for Microsoft Transaction Server(MTS)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
' Execute Insert statment to add record to database. All of the methods in
' the Employee class interact with the database through query strings.
' Methods in the BenefitList class use stored procedures. Both ways are
' demonstrated, but Stored Procedures usually run faster.
Dim lngEmployeeId As Integer
Dim strSQL As String
Dim rst As New ADOR.Recordset
' Create the Employee record. We need to create the corresponding record in
' EmployeeDependent, so use @@identity to retrieve the EmployeeId added to
' Employee.
strSQL = "SET NOCOUNT ON " & _
"INSERT INTO Employee " & _
"(NTUserName) " & _
"VALUES ('" & SQLEncode(strNTUserName) & " ')" & _
"SELECT @@IDENTITY " & _
"SET NOCOUNT OFF"
' "rst.CursorLocation = adUseClient" would put the cursor work on the client of
' the SQLServer (in this case the Web server), which would mean less work for
' the database. Not used here because adUseClient requires Remote Data
' Service (RDS), which may not be loaded on the Web server.
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN
' This will be the EmployeeId, returned by @@identity
lngEmployeeId = rst(0)
' When calling other methods in the same class, you can call them without
' "objContext.CreateInstance"
AddEmployeeDependent strFileDSN, lngEmployeeId
NewBenefits strFileDSN, lngEmployeeId, intBenefitYear
' This method is in another class, so have to "objContext.CreateInstance"
' Note that should not CreateObject in this circumstance, because if
' CreateObject, will get a NEW transaction that cannot see the work
' done in this (calling) transaction
Dim BenefitList As Object
Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
BenefitList.AddQualifier strFileDSN, lngEmployeeId, _
lngQualifierId, datQualifierDate
' Tell MTS the work by this method is now commitable
objContext.SetComplete
Exit Function
ErrorHandler:
' This code is required to get real error messages back
If Not rst Is Nothing Then Set rst = Nothing
' Tell MTS to abort the work done by this method, which will reverse all
' the work done by this method, and as far back up the line as defined
' by the calling level transaction contexts.
objContext.SetAbort
Err.Raise Err.Number, "Employee.AddNew()", Err.Description
End Function
Function Update(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
ByVal lngDependentId As Long, _
ByVal strFirstName As String, ByVal strLastName As String, _
ByVal strMiddleName As String, ByVal strKnownAs As String, _
ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
ByVal datDependentBirthdate As Date, ByVal strAddress1 As String, _
ByVal strAddress2 As String, ByVal strCity As String, _
ByVal strState As String, ByVal strPostCode As String, _
ByVal strCountry As String, ByVal strHomePhone As String, _
ByVal strBusinessPhone As String, ByVal strFax As String, _
ByVal strEmail As String, ByVal lngExemptions As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
' If date beyond permissible range entered, substitute today's date
If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
datDependentBirthdate = Date
End If
Dim strSQL As String
Dim cnn As New ADODB.Connection
cnn.Open "FileDSN=" & strFileDSN
strSQL = "UPDATE Employee " & _
"SET KnownAs = '" & SQLEncode(strKnownAs) & "', " & _
"Address1 = '" & SQLEncode(strAddress1) & "', " & _
"Address2 = '" & SQLEncode(strAddress2) & "', " & _
"City = '" & SQLEncode(strCity) & "', " & _
"State = '" & SQLEncode(strState) & "', " & _
"PostCode = '" & SQLEncode(strPostCode) & "', " & _
"Country = '" & SQLEncode(strCountry) & "' ," & _
"HomePhone = '" & SQLEncode(strHomePhone) & "', " & _
"BusinessPhone = '" & SQLEncode(strBusinessPhone) & "', " & _
"Fax = '" & SQLEncode(strFax) & "', " & _
"Email = '" & SQLEncode(strEmail) & "', " & _
"Exemptions = " & lngExemptions & " " & _
"WHERE EmployeeId = " & lngEmployeeId
cnn.Execute (strSQL)
strSQL = "UPDATE Dependent " & _
"SET FirstName = '" & SQLEncode(strFirstName) & "', " & _
"LastName = '" & SQLEncode(strLastName) & "', " & _
"MiddleName = '" & SQLEncode(strMiddleName) & "', " & _
"DependentBirthdate = '" & datDependentBirthdate & "', " & _
"DependentGenderId = " & lngDependentGenderId & ", " & _
"DependentSSN = '" & SQLEncode(strDependentSSN) & "' " & _
"WHERE DependentId = " & lngDependentId
cnn.Execute (strSQL)
objContext.SetComplete
Exit Function
ErrorHandler:
If Not cnn Is Nothing Then Set cnn = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.Update()", Err.Description
End Function
Private Function SQLEncode(str As String) As String
Dim vntPosition As Variant
If IsNull(str) Or str = "" Then
Else
vntPosition = InStr(str, "'")
Do While vntPosition <> 0
str = Mid(str, 1, vntPosition - 1) & "`'`" & Mid(str, vntPosition + 1)
vntPosition = InStr(vntPosition + 2, str, "'")
Loop
End If
SQLEncode = str
End Function
Function LookupEmployee(ByVal strFileDSN As String, ByVal strLogonUser As String)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADOR.Recordset
strSQL = "SELECT e.EmployeeId " & _
"FROM Employee e " & _
"WHERE e.NTUserName = '" & SQLEncode(strLogonUser) & "'"
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
Set LookupEmployee = rst
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.LookupEmployee()", Err.Description
End Function
Function GetForID(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADOR.Recordset
strSQL = "SELECT d.DependentId, d.FirstName, d.LastName, d.MiddleName, e.KnownAs, " & _
"e.NTUserName, d.DependentSSN, d.DependentGenderId, " & _
"d.DependentBirthdate, e.Address1, e.Address2, " & _
"e.City, e.State, e.PostCode, e.Country, e.HomePhone, " & _
"e.BusinessPhone, e.Fax, e.Email, e.PeriodEarnings, " & _
"e.Exemptions " & _
"FROM Employee e " & _
"LEFT OUTER JOIN EmployeeDependent ed ON ed.EmployeeId = e.EmployeeId " & _
" AND DependentTypeId = 1 " & _
"LEFT OUTER JOIN Dependent d ON d.DependentId = ed.DependentId " & _
"WHERE e.EmployeeID = " & lngEmployeeId
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
Set GetForID = rst
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.GetForID()", Err.Description
End Function
Function NewBenefits(ByVal strFileDSN As String, ByVal lngEmployeeId As String, _
ByVal intBenefitYear As Integer)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADOR.Recordset
strSQL = "SELECT b.BenefitId " & _
"FROM Benefit b " & _
"WHERE b.BenefitYear = " & intBenefitYear
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN
' This method is in another class, so have to "objContext.CreateInstance"
' Note that should not CreateObject in this circumstance, because if
' CreateObject, will get a NEW transaction that cannot see the work
' done in this (calling) transaction
If Not rst.EOF Then
Dim BenefitList As Object
Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
Do Until rst.EOF
BenefitList.AddBenefit strFileDSN, lngEmployeeId, rst("BenefitId")
rst.MoveNext
Loop
End If
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.NewBenefits()", Err.Description
End Function
Function AddDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
ByVal lngDependentTypeId As Long, ByVal strFirstName As String, _
ByVal strLastName As String, ByVal strMiddleName As String, _
ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
ByVal datDependentBirthdate As Date)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
' If date beyond permissible range entered, substitute today's date
If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
datDependentBirthdate = Date
End If
Dim lngDependentId As Integer
Dim strSQL As String
Dim rst As New ADOR.Recordset
' Create the Dependent record. We need to create the corresponding
' record in EmployeeDependent, so use @@identity to retrieve the
' DependentId added to Dependent.
strSQL = "SET NOCOUNT ON " & _
"INSERT INTO Dependent " & _
"(LastName, FirstName, MiddleName, " & _
"DependentBirthdate, DependentGenderId, " & _
"DependentSSN) " & _
"VALUES (" & _
"'" & SQLEncode(strLastName) & "', " & _
"'" & SQLEncode(strFirstName) & "', " & _
"'" & SQLEncode(strMiddleName) & "', " & _
"'" & datDependentBirthdate & "', " & _
lngDependentGenderId & ", " & _
"'" & SQLEncode(strDependentSSN) & "'" & _
")" & _
"SELECT @@IDENTITY " & _
"SET NOCOUNT OFF"
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN
lngDependentId = rst(0)
Dim cnn As New ADODB.Connection
cnn.Open "FileDSN=" & strFileDSN
strSQL = "INSERT INTO EmployeeDependent " & _
"(EmployeeId, DependentId, DependentTypeId) " & _
"VALUES (" & _
lngEmployeeId & ", " & _
lngDependentId & ", " & _
lngDependentTypeId & _
")"
cnn.Execute (strSQL)
' Add record to EmployeeBenefitDependent for every benefit in EmployeeBenefit
Dim rst2 As New ADOR.Recordset
strSQL = "SELECT eb.BenefitId " & _
"FROM EmployeeBenefit eb " & _
"WHERE eb.EmployeeId = " & lngEmployeeId
rst2.CursorLocation = adUseServer
rst2.Open strSQL, "FILEDSN=" & strFileDSN
' This method is in another class, so have to "objContext.CreateInstance"
' Note that should not CreateObject in this circumstance, because if
' CreateObject, will get a NEW transaction that cannot see the work
' done in this (calling) transaction
If Not rst2.EOF Then
Dim BenefitList As Object
Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
Do Until rst2.EOF
BenefitList.AddEBD strFileDSN, lngEmployeeId, rst2("BenefitId"), _
lngDependentId, lngDependentTypeId
rst2.MoveNext
Loop
End If
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
If Not cnn Is Nothing Then Set cnn = Nothing
If Not rst2 Is Nothing Then Set rst2 = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.AddDependent()", Err.Description
End Function
Function AddEmployeeDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
' Create the Dependent record. We need to create the corresponding record in
' EmployeeDependent, so use @@identity to retrieve the DependentId added to
' Dependent.
Dim strSQL As String, lngDependentId As Integer
Dim rst As New ADOR.Recordset
strSQL = "SET NOCOUNT ON " & _
"INSERT Dependent DEFAULT VALUES " & _
"SELECT @@IDENTITY " & _
"SET NOCOUNT OFF"
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN
lngDependentId = rst(0)
Dim cnn As New ADODB.Connection
cnn.Open "FileDSN=" & strFileDSN
strSQL = "INSERT INTO EmployeeDependent " & _
"(EmployeeId, DependentId, DependentTypeId) " & _
"VALUES (" & _
lngEmployeeId & ", " & _
lngDependentId & ", " & _
1 & _
")"
cnn.Execute (strSQL)
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
If Not cnn Is Nothing Then Set cnn = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.AddEmployeeDependent()", Err.Description
End Function
Function GetDependents(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADOR.Recordset
strSQL = "SELECT d.DependentId, dt.DependentTypeLabel, d.LastName, d.FirstName, " & _
"d.MiddleName, d.DependentBirthdate, d.DependentGenderId, d.DependentSSN " & _
"FROM EmployeeDependent ed " & _
"LEFT OUTER JOIN Dependent d ON d.DependentId = ed.DependentId " & _
"LEFT OUTER JOIN DependentType dt ON dt.DependentTypeId = ed.DependentTypeId " & _
"WHERE ed.EmployeeId = " & lngEmployeeId & _
" AND ed.DependentStatusId = 1 " & _
" AND ed.DependentTypeId <> 1 " & _
"ORDER BY dt.DependentTypeRank"
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
Set GetDependents = rst
objContext.SetComplete
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.GetDependents()", Err.Description
End Function
Function UpdateDependent(ByVal strFileDSN As String, ByVal lngDependentId As Long, _
ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
ByVal datDependentBirthdate As Date)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
' If date beyond permissible range entered, substitute today's date
If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
datDependentBirthdate = Date
End If
Dim strSQL As String
Dim cnn As New ADODB.Connection
cnn.Open "FileDSN=" & strFileDSN
strSQL = "UPDATE Dependent " & _
"SET DependentBirthdate = '" & datDependentBirthdate & "', " & _
"DependentGenderId = " & lngDependentGenderId & ", " & _
"DependentSSN = '" & strDependentSSN & "' " & _
"WHERE DependentId = " & lngDependentId
cnn.Execute (strSQL)
objContext.SetComplete
Exit Function
ErrorHandler:
If Not cnn Is Nothing Then Set cnn = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.UpdateDependent()", Err.Description
End Function
Function RemoveDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
ByVal lngDependentId As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim cnn As New ADODB.Connection
cnn.Open "FileDSN=" & strFileDSN
' DependentStatusId = 3 means the record status is "Delete".
strSQL = "UPDATE EmployeeDependent " & _
"SET DependentStatusId = 3 " & _
"WHERE EmployeeId = " & lngEmployeeId & _
" AND DependentId = " & lngDependentId
cnn.Execute (strSQL)
' EBDStatusId = 3 means the record status is "Delete".
strSQL = "UPDATE EmployeeBenefitDependent " & _
"SET EBDStatusId = 3 " & _
"WHERE EmployeeId = " & lngEmployeeId & _
" AND DependentId = " & lngDependentId
cnn.Execute (strSQL)
objContext.SetComplete
Exit Function
ErrorHandler:
If Not cnn Is Nothing Then Set cnn = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Employee.RemoveDependent()", Err.Description
End Function