clsitype.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 = "clsIType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable(s) to hold property value(s)
Private mvarID As Integer 'local copy
Private mvarTypeName As String 'local copy
Private mvarRemark As String 'local copy

Public Property Let Remark(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Remark = 5
    mvarRemark = vData
End Property


Public Property Get Remark() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Remark
    Remark = mvarRemark
End Property



Public Property Let TypeName(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.TypeName = 5
    mvarTypeName = vData
End Property


Public Property Get TypeName() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.TypeName
    TypeName = mvarTypeName
End Property



Public Property Let ID(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.ID = 5
    mvarID = vData
End Property


Public Property Get ID() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ID
    ID = mvarID
End Property
Public Function DeleteEx() As gxcDelete
  Call Delete(Me.ID)
End Function
Public Function Delete(Optional lngID As Long = -1) As gxcDelete
  Dim strSQL As String
 
  '如果调用该函数时传入ID，则更新该对象的ID
  If lngID <> -1 Then Me.ID = lngID
  '如果该项目类型下面有项目，则不能删除
  If ExistByID("IImage", "I_TypeID", Me.ID) Then
     Delete = DeleteSubExists
     Exit Function
  End If
  strSQL = "delete from IType"
  strSQL = strSQL & " where IT_ID=" & Me.ID
  g_Conn.Execute strSQL
  Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
 
End Function

Public Function Update() As gxcUpdate
  Dim strSQL As String
  '通过ID判断是否存在该记录,即该记录是否被其他项目端删除
  '如果不存在该记录,则返回相应的操作结果给调用者
  If Not ExistByID("IType", "IT_ID", Me.ID) Then
     Update = RecordNotExist
     Exit Function
  End If
  '通过名称判断是否存在相同名称的记录,如果存在相同的名称,则返回调用者"存在相同名称"的信息
  If ExistByNameExceptID("IType", "IT_ID", Me.ID, "IT_Name", Me.TypeName) Then
    Update = DuplicateName_Update
    Exit Function
  End If
  strSQL = "update IType set "
  strSQL = strSQL & "IT_Name='" & RealString(Me.TypeName) & "',"
  strSQL = strSQL & "IT_Remark='" & Me.Remark & "'"
  strSQL = strSQL & " where IT_ID=" & Me.ID
  g_Conn.Execute strSQL
  '根据是否出错，返回给调用者相应的信息
  Update = IIf(Err.Number = 0, UpdateOK, UpdateFail)
End Function
Public Function AddNew() As gxcAddNew
  Dim strSQL As String
  '检测输入名称是否存在
  If ExistByName("IType", "IT_Name", TypeName) Then
   AddNew = DuplicateName_AddNew
   Exit Function
  End If
   strSQL = "insert into IType(IT_Name,IT_Remark)"
        strSQL = strSQL & " values( "
        strSQL = strSQL & "'" & TypeName & "'"
        strSQL = strSQL & ",'" & Remark & "'"
        strSQL = strSQL & ")"
  '执行SQL语句,并提交事务
  g_Conn.Execute strSQL
  '如果错误,返回FALSE,表示未成功添加
  If Err.Number = 0 Then
    Me.ID = MaxID("IType", "IT_ID")
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
End Function