ccooperate.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 = "CCooperate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private mvarID As Long
Private mvarClientId As Long
Private mvarClientName As String
Private mvarRemark As String
Private mvarCooperateDate As Date
Private mvarSatisfaction As Integer


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 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 Remark(ByVal vData As String)
  mvarRemark = vData
End Property
Public Property Get Remark() As String
  Remark = mvarRemark
End Property


Public Property Let CooperateDate(ByVal vData As Date)
  mvarCooperateDate = vData
End Property
Public Property Get CooperateDate() As Date
  CooperateDate = mvarCooperateDate
End Property


Public Property Let Satisfaction(ByVal vData As Integer)
  mvarSatisfaction = vData
End Property
Public Property Get Satisfaction() As Integer
  Satisfaction = mvarSatisfaction
End Property


Public Function AddNew(Optional datDate As Date = #1/1/1900#, _
                       Optional lngClientId As Long = -1, _
                       Optional intSatify As Integer = -1, _
                       Optional strRemark As String = "") As gxcAddNew
 
  
  If lngClientId <> -1 Then Me.ClientID = lngClientId
  If intSatify <> -1 Then Me.Satisfaction = intSatify
  If strRemark <> "" Then Me.Remark = strRemark
  If datDate <> #1/1/1900# Then Me.CooperateDate = datDate
  
  Dim strSQL As String
  Dim ErrMsg As String
  strSQL = "INSERT INTO Cooperate(ClientId, [Date], Satisfaction, Remark) "
  strSQL = strSQL & " VALUES(" & Me.ClientID
  strSQL = strSQL & ",'" & Me.CooperateDate & "'"
  strSQL = strSQL & "," & Me.Satisfaction
  strSQL = strSQL & ",'" & RealString(Me.Remark) & "'"
  strSQL = strSQL & ")"
  
  If RunSql(strSQL, ErrMsg) Then
    Me.ID = MaxID("Cooperate", "CooperateId")
    AddNew = AddNewOK
  Else
    AddNew = AddNewFail
  End If
   
End Function


Public Function Update() As gxcUpdate
  
  If Not ExistByID("Cooperate", "CooperateId", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  
  On Error Resume Next
  Dim strSQL As String
  
  strSQL = "Update Cooperate Set "
  strSQL = strSQL & "Remark='" & RealString(Me.Remark) & "'"
  strSQL = strSQL & ", Satisfaction=" & Me.Satisfaction
  strSQL = strSQL & ", [Date]='" & Me.CooperateDate & "'"
  strSQL = strSQL & ", ClientId=" & Me.ClientID
  strSQL = strSQL & " WHERE CooperateId=" & 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 Cooperate where CooperateId=" & 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