cclienttype.cls

对客户管理的系统 运行相应EXE文件前

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private mvarTypeName As String
Private mvarID As Long
Private mvarSuperID As Long


Public Property Let SuperID(ByVal vData As Long)
  mvarSuperID = vData
End Property
Public Property Get SuperID() As Long
  SuperID = mvarSuperID
End Property


Public Property Let ID(ByVal vData As Long)
  mvarID = vData
End Property
Public Property Get ID() As Long
  ID = mvarID
End Property


Public Property Let TypeName(ByVal vData As String)
  vData = Trim(vData)
  
  
  If Len(vData) > 50 Then vData = Left(vData, 50)
  mvarTypeName = vData
End Property
Public Property Get TypeName() As String
  TypeName = mvarTypeName
End Property




Public Function AddNew(Optional strName As String = "", _
                       Optional lngSuperID As Long = -1) As gxcAddNew
  
  
  
  If ExistByName("ClientType", "TypeName", strName) Then
    AddNew = DuplicateName_AddNew
    Exit Function
  End If
  
 
  If lngSuperID <> 0 Then
    If ExistByID("ClientType", "TypeId", lngSuperID) = False Then
      AddNew = SuperNotExist
      Exit Function
    End If
  End If
  
  

  If strName <> "" Then Me.TypeName = strName
  If lngSuperID <> -1 Then Me.SuperID = lngSuperID
  
  Dim strSQL As String
  Dim ErrMsg As String
  strSQL = "INSERT INTO ClientType(SuperId, TypeName) "
  strSQL = strSQL & " VALUES(" & lngSuperID
  strSQL = strSQL & ",'" & strName & "'"
  strSQL = strSQL & ")"
  
  If RunSql(strSQL, ErrMsg) Then
    Me.ID = MaxID("ClientType", "TypeId")
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
   
End Function


Public Function Update() As gxcUpdate
  
  If Not ExistByID("ClientType", "TypeId", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  
  
  If ExistByName("ClientType", "TypeName", Me.TypeName) Then
    Update = DuplicateName_Update
    Exit Function
  End If
  

  Dim strSQL As String
  
  strSQL = "Update ClientType Set TypeName='" & RealString(Me.TypeName) & "',"
  strSQL = strSQL & "SuperID=" & Me.SuperID
  strSQL = strSQL & " where TypeId=" & Me.ID
  
  g_Conn.Execute strSQL
  
  
  If Err.Number = 0 Then
    Update = UpdateOK
  Else
    Update = UpdateFail
  End If
End Function


Public Function Delete(Optional ByVal lngID As Long = 0) As gxcDelete
  
  If lngID <> 0 Then Me.ID = lngID
  
  
  If ExistByID("ClientInfo", "TypeID", Me.ID) Then
    Delete = DeleteClientExists
    Exit Function
  End If
  
  
  If ExistByID("ClientType", "SuperID", Me.ID) Then
    Delete = DeleteSubExists
    Exit Function
  End If
  
  On Error Resume Next
  
  g_Conn.Execute "Delete from ClientType where TypeId=" & Me.ID
  Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
End Function


Public Function Clients() As CClients
  Dim objClients As New CClients
  
  Set Clients = objClients.Find(, , Me.ID)
End Function


Public Function SubTypes() As CTypes
  Dim objTypes As New CTypes
  
  Set SubTypes = objTypes.Find(, Me.ID)
End Function


Public Function SuperType() As CType
  Dim objTypes As New CTypes
  
  objTypes.Find Me.SuperID
  If objTypes.Count > 0 Then Set SuperType = objTypes.Item(1)
End Function