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

Private mvarID As Long                '客户编号
Private mvarName As String            '客户名称
Private mvarAge As Integer            '客户年龄
Private mvarSex As gxcSex             '性别
Private mvarTypeId As Long            '客户类型Id
Private mvarTypeName As String        '客户类型名
Private mvarMobile As String          '手机
Private mvarEmail As String           'E-mail
Private mvarOfficePhone As String     '办公室电话
Private mvarHomePhone As String       '宅电
Private mvarFax As String             '传真
Private mvarHomeAdr As String         '家庭住址
Private mvarMailAdr As String         '通讯地址
Private mvarZipCode As String         '邮编
Private mvarBirthday As Date          '生日
Private mvarBirthdayWarn As Boolean   '是不启用生日提醒
Private mvarWork As String            '职业
Private mvarPosition As String        '职位
Private mvarCompany As String         '公司
Private mvarCompanySite As String     '公司网址
Private mvarSelfSite As String        '个人网址
Private mvarLikes As String           '喜好
Private mvarHate As String            '厌恶
Private mvarRemark As String          '备注
Private mvarImportance As Integer     '重要度
Private mvarFriendly As Integer       '友好度
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 Name(ByVal vData As String)
  vData = Trim(vData) '去除两边的空格
  '控制名称的长度不可大于10
  If Len(vData) > 10 Then vData = Left(vData, 10)
  mvarName = vData
End Property
Public Property Get Name() As String
  Name = mvarName
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 TypeID(ByVal vData As Long)
  mvarTypeId = vData
End Property
Public Property Get TypeID() As Long
  TypeID = mvarTypeId
End Property

'性别
Public Property Let Sex(ByVal vData As gxcSex)
  mvarSex = vData
End Property
Public Property Get Sex() As gxcSex
  Sex = mvarSex
End Property

'手机
Public Property Let Mobile(ByVal vData As String)
  mvarMobile = vData
End Property
Public Property Get Mobile() As String
  Mobile = mvarMobile
End Property

'Email
Public Property Let Email(ByVal vData As String)
  mvarEmail = vData
End Property
Public Property Get Email() As String
  Email = mvarEmail
End Property

'办公室电话
Public Property Let OfficePhone(ByVal vData As String)
  mvarOfficePhone = vData
End Property
Public Property Get OfficePhone() As String
  OfficePhone = mvarOfficePhone
End Property

'住宅电话
Public Property Let HomePhone(ByVal vData As String)
  mvarHomePhone = vData
End Property
Public Property Get HomePhone() As String
  HomePhone = mvarHomePhone
End Property

'传真
Public Property Let Fax(ByVal vData As String)
  mvarFax = vData
End Property
Public Property Get Fax() As String
  Fax = mvarFax
End Property

'住址
Public Property Let HomeAdr(ByVal vData As String)
  mvarHomeAdr = vData
End Property
Public Property Get HomeAdr() As String
  HomeAdr = mvarHomeAdr
End Property

'通讯地址
Public Property Let MailAdr(ByVal vData As String)
  mvarMailAdr = vData
End Property
Public Property Get MailAdr() As String
  MailAdr = mvarMailAdr
End Property

'邮编
Public Property Let ZipCode(ByVal vData As String)
  mvarZipCode = vData
End Property
Public Property Get ZipCode() As String
  ZipCode = mvarZipCode
End Property

'生日
Public Property Let Birthday(ByVal vData As Date)
  mvarBirthday = vData
End Property
Public Property Get Birthday() As Date
  Birthday = mvarBirthday
End Property

'年龄
Public Property Let Age(ByVal vData As Integer)
  mvarAge = vData
End Property
Public Property Get Age() As Integer
  Age = mvarAge
End Property

'启用生日提醒
Public Property Let BirthdayWarn(ByVal vData As Boolean)
  mvarBirthdayWarn = vData
End Property
Public Property Get BirthdayWarn() As Boolean
  BirthdayWarn = mvarBirthdayWarn
End Property

'职业
Public Property Let Work(ByVal vData As String)
  mvarWork = vData
End Property
Public Property Get Work() As String
  Work = mvarWork
End Property

'职位
Public Property Let Position(ByVal vData As String)
  mvarPosition = vData
End Property
Public Property Get Position() As String
  Position = mvarPosition
End Property

'就职单位
Public Property Let Company(ByVal vData As String)
  mvarCompany = vData
End Property
Public Property Get Company() As String
  Company = mvarCompany
End Property

'公司网站
Public Property Let CompanySite(ByVal vData As String)
  mvarCompanySite = vData
End Property
Public Property Get CompanySite() As String
  CompanySite = mvarCompanySite
End Property

'个人网站
Public Property Let SelfSite(ByVal vData As String)
  mvarSelfSite = vData
End Property
Public Property Get SelfSite() As String
  SelfSite = mvarSelfSite
End Property

'喜好
Public Property Let Likes(ByVal vData As String)
  mvarLikes = vData
End Property
Public Property Get Likes() As String
  Likes = mvarLikes
End Property

'厌恶
Public Property Let Hate(ByVal vData As String)
  mvarHate = vData
End Property
Public Property Get Hate() As String
  Hate = mvarHate
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 Importance(ByVal vData As Integer)
  mvarImportance = vData
End Property
Public Property Get Importance() As Integer
  Importance = mvarImportance
End Property

'友好度
Public Property Let Friendly(ByVal vData As Integer)
  mvarFriendly = vData
End Property
Public Property Get Friendly() As Integer
  Friendly = mvarFriendly
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 ByVal strName As String = "", _
                       Optional ByVal intAge As Integer = 0, _
                       Optional varSex As gxcSex = -1, _
                       Optional lngTypeId As Long = 0) As Boolean
  On Error Resume Next
  
  '如果参数为缺省值，即未传入，则直接调用类中的参数，否则调用传入的参数
  If strName <> "" Then Me.Name = strName
  If intAge <> 0 Then Me.Age = intAge
  If varSex <> -1 Then Me.Sex = varSex
  If lngTypeId <> 0 Then Me.TypeID = lngTypeId
  
  Dim strSQL As String
  
  g_Conn.BeginTrans
  '开始一个事务，以免费得到的ID值已被其它客户端所使用
  '此处调用NextID方法，得到该类对应的数据表的下一个ID，即最大ID+1
  Me.ID = NextID("ClientInfo", "ClientId")
  Me.TypeName = GetValueByID("ClientType", "TypeId", Me.TypeID, "TypeName")
  
  '构造SQL语句，注意需调用RealString去除字符串中的单引号，以及一些SQL语法的关键词加[]
  strSQL = "Insert into ClientInfo([Name], Age, Sex, TypeId, Mobile, Email, OfficePhone, "
  strSQL = strSQL & " HomePhone, Fax, HomeAddress, MailAddress, ZipCode, Birthday, "
  strSQL = strSQL & " BirthdayWarn, [Work], [Position], Company, CompanySite, SelfSite, "
  strSQL = strSQL & " Likes, Hate, Remark, Importance, Friendly, Satisfaction) "
  strSQL = strSQL & " VALUES("
  strSQL = strSQL & "'" & RealString(mvarName) & "',"            '客户名称
  strSQL = strSQL & mvarAge & ","                                '客户年龄
  strSQL = strSQL & mvarSex & ","                                '性别
  strSQL = strSQL & mvarTypeId & ","                             '客户类型Id
  strSQL = strSQL & "'" & RealString(mvarMobile) & "',"          '手机
  strSQL = strSQL & "'" & RealString(mvarEmail) & "',"           'E-mail
  strSQL = strSQL & "'" & RealString(mvarOfficePhone) & "',"     '办公室电话
  strSQL = strSQL & "'" & RealString(mvarHomePhone) & "',"       '宅电
  strSQL = strSQL & "'" & RealString(mvarFax) & "',"             '传真
  strSQL = strSQL & "'" & RealString(mvarHomeAdr) & "',"         '家庭住址
  strSQL = strSQL & "'" & RealString(mvarMailAdr) & "',"         '通讯地址
  strSQL = strSQL & "'" & RealString(mvarZipCode) & "',"         '邮编
  strSQL = strSQL & "'" & mvarBirthday & "',"                    '生日
  strSQL = strSQL & mvarBirthdayWarn & ","                       '是不启用生日提醒
  strSQL = strSQL & "'" & RealString(mvarWork) & "',"            '职业
  strSQL = strSQL & "'" & RealString(mvarPosition) & "',"        '职位
  strSQL = strSQL & "'" & RealString(mvarCompany) & "',"         '公司
  strSQL = strSQL & "'" & RealString(mvarCompanySite) & "',"     '公司网址
  strSQL = strSQL & "'" & RealString(mvarSelfSite) & "',"        '个人网址
  strSQL = strSQL & "'" & RealString(mvarLikes) & "',"           '喜好
  strSQL = strSQL & "'" & RealString(mvarHate) & "',"            '厌恶
  strSQL = strSQL & "'" & RealString(mvarRemark) & "',"          '备注
  strSQL = strSQL & mvarImportance & ","                         '重要度
  strSQL = strSQL & mvarFriendly & ","                           '友好度
  strSQL = strSQL & mvarSatisfaction                             '满意度
  strSQL = strSQL & ")"
  
  '执行SQL语句，并提交事务
  g_Conn.Execute strSQL
  g_Conn.CommitTrans
  
  '如果发生错误，则返回FALSE，表示未成功添加
  AddNew = (Err.Number = 0)
End Function

'修改客户信息
Public Function Update() As Boolean
  On Error Resume Next
  Dim strSQL As String
  
  '构造SQL语句
  strSQL = "Update ClientInfo set "
  
  strSQL = strSQL & "[Name]= '" & RealString(mvarName) & "',"            '客户名称
  strSQL = strSQL & "Age = " & mvarAge & ","                                '客户年龄
  strSQL = strSQL & "Sex = " & mvarSex & ","                                '性别
  strSQL = strSQL & "TypeId = " & mvarTypeId & ","                             '客户类型Id
  strSQL = strSQL & "Mobile = '" & RealString(mvarMobile) & "',"          '手机
  strSQL = strSQL & "Email = '" & RealString(mvarEmail) & "',"           'E-mail
  strSQL = strSQL & "OfficePhone = '" & RealString(mvarOfficePhone) & "',"     '办公室电话
  strSQL = strSQL & "HomePhone = '" & RealString(mvarHomePhone) & "',"       '宅电
  strSQL = strSQL & "Fax = '" & RealString(mvarFax) & "',"             '传真
  strSQL = strSQL & "HomeAddress = '" & RealString(mvarHomeAdr) & "',"         '家庭住址
  strSQL = strSQL & "MailAddress = '" & RealString(mvarMailAdr) & "',"         '通讯地址
  strSQL = strSQL & "ZipCode = '" & RealString(mvarZipCode) & "',"         '邮编
  strSQL = strSQL & "Birthday = '" & mvarBirthday & "',"                    '生日
  strSQL = strSQL & "BirthdayWarn = " & mvarBirthdayWarn & ","                       '是不启用生日提醒
  strSQL = strSQL & "[Work] = '" & RealString(mvarWork) & "',"            '职业
  strSQL = strSQL & "[Position] = '" & RealString(mvarPosition) & "',"        '职位
  strSQL = strSQL & "Company = '" & RealString(mvarCompany) & "',"         '公司
  strSQL = strSQL & "CompanySite = '" & RealString(mvarCompanySite) & "',"     '公司网址
  strSQL = strSQL & "SelfSite = '" & RealString(mvarSelfSite) & "',"        '个人网址
  strSQL = strSQL & "Likes = '" & RealString(mvarLikes) & "',"           '喜好
  strSQL = strSQL & "Hate = '" & RealString(mvarHate) & "',"            '厌恶
  strSQL = strSQL & "Remark = '" & RealString(mvarRemark) & "',"          '备注
  strSQL = strSQL & "Importance = " & mvarImportance & ","                         '重要度
  strSQL = strSQL & "Friendly = " & mvarFriendly & ","                           '友好度
  strSQL = strSQL & "Satisfaction = " & mvarSatisfaction                             '满意度
  
  strSQL = strSQL & " Where ClientId=" & Me.ID
  
  g_Conn.Execute strSQL
  
  '如果发生错误，则返回FALSE，表示未成功更新
  Update = (Err.Number = 0)
End Function

'删除客户资料
Public Function Delete(Optional ByVal lngID As Long = 0) As Boolean
  Dim strSQL As String
  On Error Resume Next
  
  '如果已传入了要删除的ID，则按此ID删除
  If lngID <> 0 Then Me.ID = lngID
  
  '以下三个操作要同时发生
  g_Conn.BeginTrans

  '删除Warning表中的相关提醒
  strSQL = "DELETE FROM Warning WHERE ClientId =" & Me.ID
  g_Conn.Execute strSQL
  
  '删除Cooperate表中的相关合作信息
  strSQL = "DELETE FROM Cooperate WHERE ClientId =" & Me.ID
  g_Conn.Execute strSQL
  
  '删除ClientInfo表中的客户信息
  strSQL = "DELETE FROM ClientInfo WHERE ClientId=" & Me.ID
  g_Conn.Execute strSQL
  
  g_Conn.CommitTrans
  
  '如果发生错误，则返回FALSE，表示未删除成功
  Delete = (Err.Number = 0)
End Function
'方法结束
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

'将某个客户移到指定的部门
Public Function AssignToDepartment(ByVal TypeID As Long) As Boolean
  '实现很简单，将部门ID变一下，然后调用Update方法就行了
  Me.TypeID = TypeID
  AssignToDepartment = Me.Update
End Function

'得到该客户所在部门，以对象返回
Public Function GetType() As CType
  Dim objTypes As New CTypes
  '调用cTypes的Find方法，得到部门
  objTypes.Find Me.TypeID
  If objTypes.Count > 0 Then Set GetType = objTypes.Item(1)
End Function