ccooperate.cls

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

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              '合作信息ID
Private mvarClientId As Long        '客户ID
Private mvarClientName As String    '客户名称
Private mvarRemark As String        '合作信息
Private mvarCooperateDate As Date   '合作日期
Private mvarSatisfaction As Integer '合作满意度

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'以下为合作信息的属性

'提醒的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 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  '上级合作信息的ID
  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
  '通过ID判断是否存在该记录，即该记录是否被其它客户端删除
  '如果不存在该记录，则返回相应的操作结果给调用者
  If Not ExistByID("Cooperate", "CooperateId", Me.ID) Then
    Update = RecordNotExist
    Exit Function
  End If
  
  On Error Resume Next
  Dim strSQL As String
  '构造SQL语句，注意需调用RealString函数去除字符串中的单引号
  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 '执行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 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
'方法结束
'''''''''''''''''''''''''''''''''''''''''''''''''''''''