cwarning.cls

一个客户系统,VB+SQL,其中有客户类型分类

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

Private mvarID As Long              '提醒信息ID
Private mvarTypeId As Long          '提醒类型ID
Private mvarTypeName As String      '提醒类型名称
Private mvarClientId As Long        '提醒客户ID
Private mvarClientName As String    '提醒客户名称
Private mvarMsg As String           '提醒显示消息
Private mvarShowDate As Date        '提醒显示时间
Private mvarBirthdayWarn As Boolean '是否启用生日提醒

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'以下为部门的属性

'提醒的ID
Public Property Let ID(ByVal vData As Long)
  mvarID = vData
End Property
Public Property Get ID() As Long
  ID = mvarID
End Property

'提醒类型的ID
Public Property Let TypeID(ByVal vData As Long)
  mvarTypeId = vData
End Property
Public Property Get TypeID() As Long
  TypeID = mvarTypeId
End Property

'提醒类型的名称
Public Property Let TypeName(ByVal vData As String)
  mvarTypeName = vData
End Property
Public Property Get TypeName() As String
  TypeName = mvarTypeName
End Property

'提醒客户ID
Public Property Let ClientID(ByVal vData As Long)
  mvarClientId = vData
  SetClientName
End Property
Public Property Get ClientID() As Long
  ClientID = mvarClientId
End Property

'提醒客户的名称
Public Property Get ClientName() As String
  ClientName = mvarClientName
End Property

'提醒内容
Public Property Let Msg(ByVal vData As String)
  mvarMsg = vData
End Property
Public Property Get Msg() As String
  Msg = mvarMsg
End Property

'提醒显示日期
Public Property Let ShowDate(ByVal vData As Date)
  mvarShowDate = vData
End Property
Public Property Get ShowDate() As Date
  ShowDate = mvarShowDate
End Property

'启用生日提醒
Public Property Let ShowBirthdayWarn(ByVal vData As Boolean)
  mvarBirthdayWarn = vData
  Dim strSQL As String
  If mvarBirthdayWarn Then
    strSQL = " SELECT * FROM Warning WHERE ClientId = " _
              & Me.ClientID & " AND TypeId = " & BirthdayWarn
    Dim rs As Recordset
    Set rs = g_Conn.Execute(strSQL)
    If rs.RecordCount = 0 Then
      AddNew Me.ShowDate, Me.ClientID, 1, "今天是 " & Me.ClientName & " 的生日，请做好准备。"
    End If
    Set rs = Nothing
  Else
    strSQL = " DELETE FROM Warning WHERE ClientId = " _
              & Me.ClientID & " AND TypeId = " & BirthdayWarn
    g_Conn.Execute (strSQL)
  End If
End Property
Public Property Get ShowBirthdayWarn() As Boolean
  ShowBirthdayWarn = mvarBirthdayWarn
End Property

'属性结束
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'以下为方法

'新增提醒信息，并返回操作的结果
Public Function AddNew(Optional datDate As Date = #1/1/1900#, _
                       Optional lngClientId As Long = -1, _
                       Optional lngTypeId As Long = -1, _
                       Optional strMsg As String = "") As gxcAddNew
  '根据传入的参数更新属性值
  
 
  '如果参数被传入，则以传入的参数更新属性
  If lngClientId <> -1 Then Me.ClientID = lngClientId
  If lngTypeId <> -1 Then Me.TypeID = lngTypeId '提醒类型的ID
  If strMsg <> "" Then Me.Msg = strMsg
  If datDate <> #1/1/1900# Then Me.ShowDate = datDate
  
  Dim strSQL As String
  Dim ErrMsg As String
  strSQL = "INSERT INTO Warning(ClientId, ShowDate, TypeId, Msg) "
  strSQL = strSQL & " VALUES(" & Me.ClientID
  strSQL = strSQL & ",'" & Me.ShowDate & "'"
  strSQL = strSQL & "," & Me.TypeID
  strSQL = strSQL & ",'" & Me.Msg & "'"
  strSQL = strSQL & ")"
  
  If RunSql(strSQL, ErrMsg) Then
    Me.ID = MaxID("Warning", "WarnId")
    Me.TypeName = GetValueByID("WarnType", "WTypeId", Me.TypeID, "WTypeName")
    SetClientName
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
   
End Function

'修改提醒信息，返回操作结果
Public Function Update() As gxcUpdate
  '通过ID判断是否存在该记录，即该记录是否被其它客户端删除
  '如果不存在该记录，则返回相应的操作结果给调用者
  If Not ExistByID("Warning", "WarnId", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  
'  On Error Resume Next
  Dim strSQL As String
  '构造SQL语句，注意需调用RealString函数去除字符串中的单引号
  strSQL = "Update Warning Set "
  strSQL = strSQL & "Msg='" & RealString(Me.Msg) & "'"
  strSQL = strSQL & ", TypeId=" & Me.TypeID
  strSQL = strSQL & ", ShowDate='" & Me.ShowDate
  strSQL = strSQL & "' where WarnId=" & Me.ID
  
  g_Conn.Execute strSQL '执行SQL语句
  
  '根据是否出错，返回给调用者相应的信息
  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
  '如果调用该函数时传入了ID，则更新该对象的ID
  If lngID <> 0 Then Me.ID = lngID
  
  On Error Resume Next
  '执行删除操作并返回操作结果
  g_Conn.Execute "Delete from Warning where WarnId=" & Me.ID
  Delete = IIf(Err.Number = 0, DeleteOK, DeleteFail)
  
End Function

Private Sub SetClientName()
    If Me.ClientID = 0 Then
      mvarClientName = "不限客户"
    Else
      mvarClientName = GetValueByID("ClientInfo", "ClientId", Me.ClientID, "Name")
    End If
End Sub
'方法结束
'''''''''''''''''''''''''''''''''''''''''''''''''''''''