⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cwarning.cls

📁 对客户管理的系统 运行相应EXE文件前
💻 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 = "CWarning"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private mvarID As Long
Private mvarTypeId As Long
Private mvarTypeName As String
Private mvarClientId As Long
Private mvarClientName As String
Private mvarMsg As String
Private mvarShowDate As Date
Private mvarBirthdayWarn As Boolean


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 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


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
  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
  
  If Not ExistByID("Warning", "WarnId", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  

  Dim strSQL As String
  
  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
  
  
  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
  
  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






⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -