home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 February / CHIP_2_98.iso / software / pelne / optionp / iis4_07.cab / Employee.cls < prev    next >
Text File  |  1997-11-01  |  19KB  |  528 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Employee"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Function AddNew(ByVal strFileDSN As String, ByVal strNTUserName As String, _
  13.     ByVal intBenefitYear As Integer, ByVal lngQualifierId As Long, _
  14.     ByVal datQualifierDate As Date)
  15.  
  16.     ' Define transaction context for Microsoft Transaction Server(MTS)
  17.     Dim objContext As ObjectContext
  18.     Set objContext = GetObjectContext
  19.     
  20.     On Error GoTo ErrorHandler
  21.     
  22.     ' Execute Insert statment to add record to database. All of the methods in
  23.     '   the Employee class interact with the database through query strings.
  24.     '   Methods in the BenefitList class use stored procedures. Both ways are
  25.     '   demonstrated, but Stored Procedures usually run faster.
  26.     Dim lngEmployeeId As Integer
  27.     Dim strSQL As String
  28.     Dim rst As New ADOR.Recordset
  29.     
  30.     ' Create the Employee record. We need to create the corresponding record in
  31.     '  EmployeeDependent, so use @@identity to retrieve the EmployeeId added to
  32.     '  Employee.
  33.     strSQL = "SET NOCOUNT ON " & _
  34.                 "INSERT INTO Employee " & _
  35.                     "(NTUserName) " & _
  36.                     "VALUES ('" & SQLEncode(strNTUserName) & " ')" & _
  37.                     "SELECT @@IDENTITY " & _
  38.                 "SET NOCOUNT OFF"
  39.  
  40.     ' "rst.CursorLocation = adUseClient" would put the cursor work on the client of
  41.     '   the SQLServer (in this case the Web server), which would mean less work for
  42.     '   the database. Not used here because adUseClient requires Remote Data
  43.     '   Service (RDS), which may not be loaded on the Web server.
  44.     rst.CursorLocation = adUseServer
  45.     rst.Open strSQL, "FILEDSN=" & strFileDSN
  46.     
  47.     ' This will be the EmployeeId, returned by @@identity
  48.     lngEmployeeId = rst(0)
  49.  
  50.     ' When calling other methods in the same class, you can call them without
  51.     '   "objContext.CreateInstance"
  52.     AddEmployeeDependent strFileDSN, lngEmployeeId
  53.  
  54.     NewBenefits strFileDSN, lngEmployeeId, intBenefitYear
  55.  
  56.     ' This method is in another class, so have to "objContext.CreateInstance"
  57.     '   Note that should not CreateObject in this circumstance, because if
  58.     '   CreateObject, will get a NEW transaction that cannot see the work
  59.     '   done in this (calling) transaction
  60.     Dim BenefitList As Object
  61.     Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
  62.     BenefitList.AddQualifier strFileDSN, lngEmployeeId, _
  63.         lngQualifierId, datQualifierDate
  64.                 
  65.     ' Tell MTS the work by this method is now commitable
  66.     objContext.SetComplete
  67.     Exit Function
  68.     
  69. ErrorHandler:
  70.     ' This code is required to get real error messages back
  71.     If Not rst Is Nothing Then Set rst = Nothing
  72.  
  73.     ' Tell MTS to abort the work done by this method, which will reverse all
  74.     '   the work done by this method, and as far back up the line as defined
  75.     '   by the calling level transaction contexts.
  76.     objContext.SetAbort
  77.     Err.Raise Err.Number, "Employee.AddNew()", Err.Description
  78.  
  79. End Function
  80.  
  81. Function Update(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
  82.      ByVal lngDependentId As Long, _
  83.      ByVal strFirstName As String, ByVal strLastName As String, _
  84.      ByVal strMiddleName As String, ByVal strKnownAs As String, _
  85.      ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
  86.      ByVal datDependentBirthdate As Date, ByVal strAddress1 As String, _
  87.      ByVal strAddress2 As String, ByVal strCity As String, _
  88.      ByVal strState As String, ByVal strPostCode As String, _
  89.      ByVal strCountry As String, ByVal strHomePhone As String, _
  90.      ByVal strBusinessPhone As String, ByVal strFax As String, _
  91.      ByVal strEmail As String, ByVal lngExemptions As Long)
  92.  
  93.     Dim objContext As ObjectContext
  94.     Set objContext = GetObjectContext
  95.     
  96.     On Error GoTo ErrorHandler
  97.     
  98.     ' If date beyond permissible range entered, substitute today's date
  99.     If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
  100.       datDependentBirthdate = Date
  101.     End If
  102.     
  103.     Dim strSQL As String
  104.     Dim cnn As New ADODB.Connection
  105.             
  106.     cnn.Open "FileDSN=" & strFileDSN
  107.             
  108.     strSQL = "UPDATE Employee " & _
  109.         "SET KnownAs = '" & SQLEncode(strKnownAs) & "', " & _
  110.             "Address1 = '" & SQLEncode(strAddress1) & "', " & _
  111.             "Address2 = '" & SQLEncode(strAddress2) & "', " & _
  112.             "City = '" & SQLEncode(strCity) & "', " & _
  113.             "State = '" & SQLEncode(strState) & "', " & _
  114.             "PostCode = '" & SQLEncode(strPostCode) & "', " & _
  115.             "Country = '" & SQLEncode(strCountry) & "' ," & _
  116.             "HomePhone = '" & SQLEncode(strHomePhone) & "', " & _
  117.             "BusinessPhone = '" & SQLEncode(strBusinessPhone) & "', " & _
  118.             "Fax = '" & SQLEncode(strFax) & "', " & _
  119.             "Email = '" & SQLEncode(strEmail) & "', " & _
  120.             "Exemptions = " & lngExemptions & " " & _
  121.         "WHERE EmployeeId = " & lngEmployeeId
  122.                                 
  123.     cnn.Execute (strSQL)
  124.                                 
  125.     strSQL = "UPDATE Dependent " & _
  126.         "SET FirstName = '" & SQLEncode(strFirstName) & "', " & _
  127.             "LastName = '" & SQLEncode(strLastName) & "', " & _
  128.             "MiddleName = '" & SQLEncode(strMiddleName) & "', " & _
  129.             "DependentBirthdate = '" & datDependentBirthdate & "', " & _
  130.             "DependentGenderId = " & lngDependentGenderId & ", " & _
  131.             "DependentSSN = '" & SQLEncode(strDependentSSN) & "' " & _
  132.         "WHERE DependentId = " & lngDependentId
  133.  
  134.     cnn.Execute (strSQL)
  135.                                 
  136.     objContext.SetComplete
  137.     Exit Function
  138.     
  139. ErrorHandler:
  140.     If Not cnn Is Nothing Then Set cnn = Nothing
  141.  
  142.     objContext.SetAbort
  143.     Err.Raise Err.Number, "Employee.Update()", Err.Description
  144.  
  145. End Function
  146.  
  147. Private Function SQLEncode(str As String) As String
  148.  
  149.     Dim vntPosition As Variant
  150.     
  151.     If IsNull(str) Or str = "" Then
  152.  
  153.     Else
  154.         vntPosition = InStr(str, "'")
  155.         Do While vntPosition <> 0
  156.             str = Mid(str, 1, vntPosition - 1) & "`'`" & Mid(str, vntPosition + 1)
  157.             vntPosition = InStr(vntPosition + 2, str, "'")
  158.         Loop
  159.     End If
  160.     SQLEncode = str
  161.     
  162. End Function
  163.  
  164. Function LookupEmployee(ByVal strFileDSN As String, ByVal strLogonUser As String)
  165.     
  166.     Dim objContext As ObjectContext
  167.     Set objContext = GetObjectContext
  168.     
  169.     On Error GoTo ErrorHandler
  170.     
  171.     Dim strSQL As String
  172.     Dim rst As New ADOR.Recordset
  173.  
  174.     strSQL = "SELECT e.EmployeeId " & _
  175.       "FROM Employee e " & _
  176.       "WHERE e.NTUserName = '" & SQLEncode(strLogonUser) & "'"
  177.  
  178.     rst.CursorLocation = adUseServer
  179.     rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
  180.     Set LookupEmployee = rst
  181.         
  182.     objContext.SetComplete
  183.     Exit Function
  184.     
  185. ErrorHandler:
  186.     If Not rst Is Nothing Then Set rst = Nothing
  187.  
  188.     objContext.SetAbort
  189.     Err.Raise Err.Number, "Employee.LookupEmployee()", Err.Description
  190.  
  191. End Function
  192.  
  193. Function GetForID(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
  194.     
  195.     Dim objContext As ObjectContext
  196.     Set objContext = GetObjectContext
  197.     
  198.     On Error GoTo ErrorHandler
  199.     
  200.     Dim strSQL As String
  201.     Dim rst As New ADOR.Recordset
  202.      
  203.     strSQL = "SELECT d.DependentId, d.FirstName, d.LastName, d.MiddleName, e.KnownAs, " & _
  204.       "e.NTUserName, d.DependentSSN, d.DependentGenderId, " & _
  205.       "d.DependentBirthdate, e.Address1, e.Address2, " & _
  206.       "e.City, e.State, e.PostCode, e.Country, e.HomePhone, " & _
  207.       "e.BusinessPhone, e.Fax, e.Email, e.PeriodEarnings, " & _
  208.       "e.Exemptions " & _
  209.       "FROM Employee e " & _
  210.       "LEFT OUTER JOIN EmployeeDependent ed ON ed.EmployeeId = e.EmployeeId " & _
  211.       " AND DependentTypeId = 1 " & _
  212.       "LEFT OUTER JOIN Dependent d ON d.DependentId = ed.DependentId " & _
  213.       "WHERE e.EmployeeID = " & lngEmployeeId
  214.         
  215.     rst.CursorLocation = adUseServer
  216.     rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
  217.     Set GetForID = rst
  218.     
  219.     objContext.SetComplete
  220.     Exit Function
  221.     
  222. ErrorHandler:
  223.     If Not rst Is Nothing Then Set rst = Nothing
  224.  
  225.     objContext.SetAbort
  226.     Err.Raise Err.Number, "Employee.GetForID()", Err.Description
  227.  
  228. End Function
  229.  
  230. Function NewBenefits(ByVal strFileDSN As String, ByVal lngEmployeeId As String, _
  231.     ByVal intBenefitYear As Integer)
  232.  
  233.     Dim objContext As ObjectContext
  234.     Set objContext = GetObjectContext
  235.  
  236.     On Error GoTo ErrorHandler
  237.  
  238.     Dim strSQL As String
  239.     Dim rst As New ADOR.Recordset
  240.  
  241.     strSQL = "SELECT b.BenefitId " & _
  242.       "FROM Benefit b " & _
  243.       "WHERE b.BenefitYear = " & intBenefitYear
  244.  
  245.     rst.CursorLocation = adUseServer
  246.     rst.Open strSQL, "FILEDSN=" & strFileDSN
  247.  
  248.     ' This method is in another class, so have to "objContext.CreateInstance"
  249.     '   Note that should not CreateObject in this circumstance, because if
  250.     '   CreateObject, will get a NEW transaction that cannot see the work
  251.     '   done in this (calling) transaction
  252.     If Not rst.EOF Then
  253.         Dim BenefitList As Object
  254.         Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
  255.         Do Until rst.EOF
  256.             BenefitList.AddBenefit strFileDSN, lngEmployeeId, rst("BenefitId")
  257.             rst.MoveNext
  258.         Loop
  259.     End If
  260.         
  261.     objContext.SetComplete
  262.     Exit Function
  263.     
  264. ErrorHandler:
  265.     If Not rst Is Nothing Then Set rst = Nothing
  266.  
  267.     objContext.SetAbort
  268.     Err.Raise Err.Number, "Employee.NewBenefits()", Err.Description
  269.  
  270. End Function
  271.  
  272. Function AddDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
  273.      ByVal lngDependentTypeId As Long, ByVal strFirstName As String, _
  274.      ByVal strLastName As String, ByVal strMiddleName As String, _
  275.      ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
  276.      ByVal datDependentBirthdate As Date)
  277.  
  278.     Dim objContext As ObjectContext
  279.     Set objContext = GetObjectContext
  280.  
  281.     On Error GoTo ErrorHandler
  282.     
  283.     ' If date beyond permissible range entered, substitute today's date
  284.     If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
  285.       datDependentBirthdate = Date
  286.     End If
  287.         
  288.     Dim lngDependentId As Integer
  289.     Dim strSQL As String
  290.     Dim rst As New ADOR.Recordset
  291.      
  292.         ' Create the Dependent record. We need to create the corresponding
  293.         '   record in EmployeeDependent, so use @@identity to retrieve the
  294.         '   DependentId added to Dependent.
  295.         strSQL = "SET NOCOUNT ON " & _
  296.                 "INSERT INTO Dependent " & _
  297.                           "(LastName, FirstName, MiddleName, " & _
  298.                           "DependentBirthdate, DependentGenderId, " & _
  299.                           "DependentSSN) " & _
  300.                           "VALUES (" & _
  301.                           "'" & SQLEncode(strLastName) & "', " & _
  302.                           "'" & SQLEncode(strFirstName) & "', " & _
  303.                           "'" & SQLEncode(strMiddleName) & "', " & _
  304.                           "'" & datDependentBirthdate & "', " & _
  305.                           lngDependentGenderId & ", " & _
  306.                           "'" & SQLEncode(strDependentSSN) & "'" & _
  307.                           ")" & _
  308.                 "SELECT @@IDENTITY " & _
  309.                 "SET NOCOUNT OFF"
  310.  
  311.     rst.CursorLocation = adUseServer
  312.     rst.Open strSQL, "FILEDSN=" & strFileDSN
  313.     lngDependentId = rst(0)
  314.   
  315.     Dim cnn As New ADODB.Connection
  316.     
  317.     cnn.Open "FileDSN=" & strFileDSN
  318.             
  319.     strSQL = "INSERT INTO EmployeeDependent " & _
  320.                           "(EmployeeId, DependentId, DependentTypeId) " & _
  321.                           "VALUES (" & _
  322.                           lngEmployeeId & ", " & _
  323.                           lngDependentId & ", " & _
  324.                           lngDependentTypeId & _
  325.                           ")"
  326.                           
  327.     cnn.Execute (strSQL)
  328.     
  329.     ' Add record to EmployeeBenefitDependent for every benefit in EmployeeBenefit
  330.     Dim rst2 As New ADOR.Recordset
  331.  
  332.     strSQL = "SELECT eb.BenefitId " & _
  333.              "FROM EmployeeBenefit eb " & _
  334.              "WHERE eb.EmployeeId = " & lngEmployeeId
  335.  
  336.     rst2.CursorLocation = adUseServer
  337.     rst2.Open strSQL, "FILEDSN=" & strFileDSN
  338.     
  339.     ' This method is in another class, so have to "objContext.CreateInstance"
  340.     '   Note that should not CreateObject in this circumstance, because if
  341.     '   CreateObject, will get a NEW transaction that cannot see the work
  342.     '   done in this (calling) transaction
  343.     If Not rst2.EOF Then
  344.         Dim BenefitList As Object
  345.         Set BenefitList = objContext.CreateInstance("Benefit.BenefitList")
  346.         Do Until rst2.EOF
  347.             BenefitList.AddEBD strFileDSN, lngEmployeeId, rst2("BenefitId"), _
  348.               lngDependentId, lngDependentTypeId
  349.             rst2.MoveNext
  350.         Loop
  351.     End If
  352.     
  353.     objContext.SetComplete
  354.     Exit Function
  355.  
  356. ErrorHandler:
  357.     If Not rst Is Nothing Then Set rst = Nothing
  358.     If Not cnn Is Nothing Then Set cnn = Nothing
  359.     If Not rst2 Is Nothing Then Set rst2 = Nothing
  360.  
  361.     objContext.SetAbort
  362.     Err.Raise Err.Number, "Employee.AddDependent()", Err.Description
  363.  
  364. End Function
  365.  
  366. Function AddEmployeeDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
  367.  
  368.     Dim objContext As ObjectContext
  369.     Set objContext = GetObjectContext
  370.  
  371.     On Error GoTo ErrorHandler
  372.         
  373.     ' Create the Dependent record. We need to create the corresponding record in
  374.     '   EmployeeDependent, so use @@identity to retrieve the DependentId added to
  375.     '   Dependent.
  376.     Dim strSQL As String, lngDependentId As Integer
  377.     Dim rst As New ADOR.Recordset
  378.  
  379.         strSQL = "SET NOCOUNT ON " & _
  380.                 "INSERT Dependent DEFAULT VALUES " & _
  381.                 "SELECT @@IDENTITY " & _
  382.                 "SET NOCOUNT OFF"
  383.  
  384.     rst.CursorLocation = adUseServer
  385.     rst.Open strSQL, "FILEDSN=" & strFileDSN
  386.     
  387.     lngDependentId = rst(0)
  388.   
  389.     Dim cnn As New ADODB.Connection
  390.     
  391.     cnn.Open "FileDSN=" & strFileDSN
  392.             
  393.     strSQL = "INSERT INTO EmployeeDependent " & _
  394.                           "(EmployeeId, DependentId, DependentTypeId) " & _
  395.                           "VALUES (" & _
  396.                           lngEmployeeId & ", " & _
  397.                           lngDependentId & ", " & _
  398.                           1 & _
  399.                           ")"
  400.                           
  401.     cnn.Execute (strSQL)
  402.       
  403.     objContext.SetComplete
  404.     Exit Function
  405.  
  406. ErrorHandler:
  407.     If Not rst Is Nothing Then Set rst = Nothing
  408.     If Not cnn Is Nothing Then Set cnn = Nothing
  409.  
  410.     objContext.SetAbort
  411.     Err.Raise Err.Number, "Employee.AddEmployeeDependent()", Err.Description
  412.  
  413. End Function
  414.  
  415. Function GetDependents(ByVal strFileDSN As String, ByVal lngEmployeeId As Long)
  416.     
  417.     Dim objContext As ObjectContext
  418.     Set objContext = GetObjectContext
  419.     
  420.     On Error GoTo ErrorHandler
  421.     
  422.     Dim strSQL As String
  423.     Dim rst As New ADOR.Recordset
  424.      
  425.     strSQL = "SELECT d.DependentId, dt.DependentTypeLabel, d.LastName, d.FirstName, " & _
  426.       "d.MiddleName, d.DependentBirthdate, d.DependentGenderId, d.DependentSSN " & _
  427.       "FROM EmployeeDependent ed " & _
  428.       "LEFT OUTER JOIN Dependent d ON d.DependentId = ed.DependentId " & _
  429.       "LEFT OUTER JOIN DependentType dt ON dt.DependentTypeId = ed.DependentTypeId " & _
  430.       "WHERE ed.EmployeeId = " & lngEmployeeId & _
  431.       " AND ed.DependentStatusId = 1 " & _
  432.       " AND ed.DependentTypeId <> 1 " & _
  433.       "ORDER BY dt.DependentTypeRank"
  434.  
  435.     rst.CursorLocation = adUseServer
  436.     rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
  437.     Set GetDependents = rst
  438.     
  439.     objContext.SetComplete
  440.     Exit Function
  441.     
  442. ErrorHandler:
  443.     If Not rst Is Nothing Then Set rst = Nothing
  444.  
  445.     objContext.SetAbort
  446.     Err.Raise Err.Number, "Employee.GetDependents()", Err.Description
  447.  
  448. End Function
  449.  
  450. Function UpdateDependent(ByVal strFileDSN As String, ByVal lngDependentId As Long, _
  451.      ByVal strDependentSSN As String, ByVal lngDependentGenderId As Long, _
  452.      ByVal datDependentBirthdate As Date)
  453.  
  454.     Dim objContext As ObjectContext
  455.     Set objContext = GetObjectContext
  456.     
  457.     On Error GoTo ErrorHandler
  458.     
  459.     ' If date beyond permissible range entered, substitute today's date
  460.     If Year(datDependentBirthdate) < 1753 Or Year(datDependentBirthdate) > 9999 Then
  461.       datDependentBirthdate = Date
  462.     End If
  463.     
  464.     Dim strSQL As String
  465.     Dim cnn As New ADODB.Connection
  466.  
  467.     cnn.Open "FileDSN=" & strFileDSN
  468.  
  469.     strSQL = "UPDATE Dependent " & _
  470.         "SET DependentBirthdate = '" & datDependentBirthdate & "', " & _
  471.         "DependentGenderId = " & lngDependentGenderId & ", " & _
  472.         "DependentSSN = '" & strDependentSSN & "' " & _
  473.         "WHERE DependentId = " & lngDependentId
  474.              
  475.     cnn.Execute (strSQL)
  476.     
  477.     objContext.SetComplete
  478.     Exit Function
  479.     
  480. ErrorHandler:
  481.     If Not cnn Is Nothing Then Set cnn = Nothing
  482.  
  483.     objContext.SetAbort
  484.     Err.Raise Err.Number, "Employee.UpdateDependent()", Err.Description
  485.  
  486. End Function
  487.  
  488. Function RemoveDependent(ByVal strFileDSN As String, ByVal lngEmployeeId As Long, _
  489.      ByVal lngDependentId As Long)
  490.  
  491.     Dim objContext As ObjectContext
  492.     Set objContext = GetObjectContext
  493.     
  494.     On Error GoTo ErrorHandler
  495.     
  496.     Dim strSQL As String
  497.     Dim cnn As New ADODB.Connection
  498.             
  499.     cnn.Open "FileDSN=" & strFileDSN
  500.             
  501.     ' DependentStatusId = 3 means the record status is "Delete".
  502.     strSQL = "UPDATE EmployeeDependent " & _
  503.         "SET DependentStatusId = 3 " & _
  504.         "WHERE EmployeeId = " & lngEmployeeId & _
  505.         " AND DependentId = " & lngDependentId
  506.              
  507.     cnn.Execute (strSQL)
  508.  
  509.     ' EBDStatusId = 3 means the record status is "Delete".
  510.     strSQL = "UPDATE EmployeeBenefitDependent " & _
  511.         "SET EBDStatusId = 3 " & _
  512.         "WHERE EmployeeId = " & lngEmployeeId & _
  513.         " AND DependentId = " & lngDependentId
  514.         
  515.     cnn.Execute (strSQL)
  516.     
  517.     objContext.SetComplete
  518.     Exit Function
  519.     
  520. ErrorHandler:
  521.     If Not cnn Is Nothing Then Set cnn = Nothing
  522.  
  523.     objContext.SetAbort
  524.     Err.Raise Err.Number, "Employee.RemoveDependent()", Err.Description
  525.  
  526. End Function
  527.  
  528.