empcls.cls

本代码适合初学数据库者学习借鉴

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "EmpCls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

Option Explicit

Dim SqlStr As String, TempRec As New ADODB.Recordset
Function AddDep(ByVal NowLjStr As String) As String
Dim NewLj As String
Dim TempNode As Node
Dim NewMc As String, NewCode As String
On Error GoTo GetErr

Screen.MousePointer = 11

AddDep = ""
NewLj = CountNewDepCode(NowLjStr)

NewMc = Trim$(InputBox(LoadResString(230), App.Title, LoadResString(364)))
NewCode = Trim$(InputBox(LoadResString(231), App.Title, ""))

If NewMc = "" Then NewMc = LoadResString(232)

'应该判断该部门外部代码是否重复

'=============================
SqlStr = "INSERT INTO Department(Dir,Name,Id) VALUES('" & NewLj & "','" & NewMc & "','" & NewCode & "') "
GlobalCon.Execute SqlStr
CheckSqlErr GlobalCon
 
AddDep = NewLj + "-" + NewMc

Screen.MousePointer = 0

Exit Function
GetErr:
  ShowMsgBox Err.Description

End Function


Sub ChangeEmpDep(EmpCode As String, NewDepCode As String)
'功能:更改职员的部门

SqlStr = "UPDATE  EmployeeInfo SET Department='" & NewDepCode & "'   "
SqlStr = SqlStr + " WHERE id='" & EmpCode & "' "
GlobalCon.Execute SqlStr
CheckSqlErr GlobalCon

End Sub

Function AddEmployee(EmpId As String, EmpChsName As String, DepDir As String) As String
On Error GoTo EmpErr

'检查该工号是否已经存在
Set TempRec = New ADODB.Recordset
SqlStr = "select count(*) from  employeeinfo where id='" & Trim$(EmpId) & "' "
TempRec.Open SqlStr, GlobalCon
If Not TempRec.EOF Then
   If TempRec.Fields(0).Value >= 1 Then
        AddEmployee = LoadResString(260)
        TempRec.Close
        Set TempRec = Nothing
        Exit Function
   End If
End If
TempRec.Close
Set TempRec = Nothing

'加入记录

SqlStr = "insert into employeeinfo(id,chsname,department,status) values("
SqlStr = SqlStr + "'" & Trim$(EmpId) & "','" & Trim$(EmpChsName) & "','" & Trim$(DepDir) & "','试用') "
GlobalCon.Execute SqlStr

SqlStr = "insert into employeehire(employeeid) values('" & Trim$(EmpId) & "')"
GlobalCon.Execute SqlStr

Exit Function
EmpErr:
    AddEmployee = LoadResString(102)
    ShowMsgBox Err.Description

End Function



Private Function CountNewDepCode(ByVal OldMl As String) As String
'功能:计算新部门的内部代码
Dim MaxNum As Integer, NowML As String
'功能：计算OLDML的下一级目录

On Error GoTo JsErr
CountNewDepCode = ""
Set TempRec = New ADODB.Recordset

If OldMl <> "000" Then
    SqlStr = "select maxnum=max(convert(int,right(rtrim(ltrim(Dir)),3))) from Department where"
    SqlStr = SqlStr + " SUBSTRING(ltrim(rtrim(Dir)),1," & Len(Trim$(OldMl)) & ")='" & Trim$(OldMl) & "'  "
    SqlStr = SqlStr + " AND SUBSTRING(ltrim(rtrim(Dir))," & Len(Trim$(OldMl)) + 3 & ",1) is not null  "
    SqlStr = SqlStr + " AND SUBSTRING(ltrim(rtrim(Dir))," & Len(Trim$(OldMl)) + 4 & ",1) is null "
Else
    SqlStr = "select maxnum=max(convert(int,right(ltrim(rtrim(Dir)),3))) from Department where (substring(ltrim(rtrim(Dir)),3,1) is not null ) "
    SqlStr = SqlStr + " and (substring(ltrim(rtrim(Dir)),4,1) is null )"
End If

TempRec.Open SqlStr, GlobalCon, adOpenForwardOnly, adLockReadOnly

If Not TempRec.EOF Then
   If Not IsNull(TempRec!MaxNum) Then
         MaxNum = TempRec!MaxNum + 1
   Else
      MaxNum = 1
   End If
Else
   MaxNum = 1
End If
TempRec.Close
Set TempRec = Nothing

If OldMl = "000" Then OldMl = ""

If Len(Trim$(Str(MaxNum))) = 1 Then NowML = Trim$(OldMl + "00" + Trim$(Str(MaxNum)))
If Len(Trim$(Str(MaxNum))) = 2 Then NowML = Trim$(OldMl + "0" + Trim$(Str(MaxNum)))
If Len(Trim$(Str(MaxNum))) = 3 Then NowML = Trim$(OldMl + Trim$(Str(MaxNum)))
Set TempRec = New ADODB.Recordset
SqlStr = "select Dir  from Department where Dir='" & Trim$(NowML) & "' "
TempRec.Open SqlStr, GlobalCon, adOpenForwardOnly, adLockReadOnly
If Not TempRec.EOF Then
    CountNewDepCode = ""
    ShowMsgBox LoadResString(219), vbExclamation
    TempRec.Close
    Set TempRec = Nothing
    Exit Function
End If
TempRec.Close
Set TempRec = Nothing

CountNewDepCode = Trim$(NowML)

Exit Function
JsErr:
  ShowMsgBox Err.Description, 48
  CountNewDepCode = ""


End Function


Public Function DelDepart(DepartDir As String) As Boolean
On Error GoTo DelBmErr

DelDepart = False
Screen.MousePointer = 11

'开始判断是否允许删除该部门
    '判断该部门以及其下属部门是否有员工,有则不允许删除
    
    

'允许删除该部门
SqlStr = "DELETE FROM Department WHERE Dir='" & DepartDir & "'"
GlobalCon.Execute SqlStr
CheckSqlErr GlobalCon

'删除下级部门

SqlStr = "SELECT * FROM Department WHERE SUBSTRING(Dir,1," & Len(DepartDir) & ")='" & DepartDir & "' "
TempRec.Open SqlStr, GlobalCon, adOpenForwardOnly, adLockReadOnly
Do Until TempRec.EOF
       If Not IsNull(TempRec!DepartDir) Then
          SqlStr = "DELETE FROM Department WHERE Dir='" & Trim$(TempRec!DepartDir) & "'"
          GlobalCon.Execute SqlStr
          CheckSqlErr GlobalCon
       End If
       TempRec.MoveNext
Loop

TempRec.Close
Set TempRec = Nothing

DelDepart = True
Screen.MousePointer = 0
 
Exit Function
DelBmErr:
  ShowMsgBox Err.Description, 0
  Resume Next

End Function


Function DelEmployee(EmpCode As String) As Boolean
'功能:删除职员
On Error GoTo DelErr
DelEmployee = False

'首先检测是否允许删除该职员


'开始删除该职员
SqlStr = "delete from  "
GlobalCon.Execute SqlStr


DelEmployee = True
Exit Function
DelErr:
    ShowMsgBox Err.Description
    DelEmployee = False
    
End Function