client.vb

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

Public Class Client

#Region "字段常量字义"
  '类内部定义的数据库字段名，只读，字段名与数据库中的值一致
  Protected Const IDField As String = "ClientID" '客户编号
  Protected Const Name As String = "Name" '客户名称
  Protected Const AgeField As String = "Age" '客户年龄
  Protected Const SexField As String = "Sex" '性别
  Protected Const TypeIdField As String = "TypeId" '客户类型Id
  Protected Const TypeNameField As String = "TypeName" '客户类型名
  Protected Const MobileField As String = "Mobile" '手机
  Protected Const EmailField As String = "Email" 'E-mail
  Protected Const OfficePhoneField As String = "OfficePhone" '办公室电话
  Protected Const HomePhoneField As String = "HomePhone" '宅电
  Protected Const FaxField As String = "Fax" '传真
  Protected Const HomeAddressField As String = "HomeAddress" '家庭住址
  Protected Const MailAddressField As String = "MailAddress" '通讯地址
  Protected Const ZipCodeField As String = "ZipCode" '邮编
  Protected Const BirthdayField As String = "Birthday" '生日
  Protected Const BirthdayWarnField As String = "BirthdayWarn" '是不启用生日提醒
  Protected Const JobField As String = "Job" '职业
  Protected Const JobPositionField As String = "JobPosition" '职位
  Protected Const CompanyField As String = "Company" '公司
  Protected Const CompanySiteField As String = "CompanySite" '公司网址
  Protected Const SelfSiteField As String = "SelfSite" '个人网址
  Protected Const LikesField As String = "Likes" '喜好
  Protected Const HatesField As String = "Hates" '厌恶
  Protected Const ImportanceField As String = "Importance" '重要度
  Protected Const FriendlyField As String = "Friendly" '友好度
  Protected Const SatisfactionField As String = "Satisfaction" '满意度
  Protected Const RemarkField As String = "Remark" '备注
#End Region

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

  '添加一个客户
  Public Function AddNew(ByRef dmClient As ClientDataModel) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    '为存储过程提供参数，注意需调用SafeDbString替换字符串中的单引号
    strSQL = "EXEC AddClient '" & dbObj.SafeDbString(dmClient.mvarName) & "'," _
              & dmClient.mvarAge & "," _
              & dmClient.mvarSex & "," _
              & dmClient.mvarTypeId & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarMobile) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarEmail) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarOfficePhone) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHomePhone) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarFax) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHomeAddress) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarMailAddress) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarZipCode) & "'," _
              & "'" & dmClient.mvarBirthday & "'," _
              & IIf(dmClient.mvarBirthdayWarn, 1, 0) & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarJob) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarJobPosition) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarCompany) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarCompanySite) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarSelfSite) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarLikes) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHates) & "'," _
              & dmClient.mvarImportance & "," _
              & dmClient.mvarFriendly & "," _
              & dmClient.mvarSatisfaction & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarRemark) & "'"

    ErrMsg = dbObj.GetDataView(strSQL, dv)
    If dv.Count = 0 Then
      Return ErrMsg
    End If

    dmClient.ID = dv(0)(Me.IDField)

    Return ErrMsg

  End Function

  '修改客户信息
  Public Function Update(ByVal dmClient As ClientDataModel) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String

    '为存储过程提供参数，注意需调用SafeDbString替换字符串中的单引号，
    strSQL = "Exec UpdateClientInfo " _
              & dmClient.mvarID & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarName) & "'," _
              & dmClient.mvarAge & "," _
              & dmClient.mvarSex & "," _
              & dmClient.mvarTypeId & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarMobile) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarEmail) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarOfficePhone) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHomePhone) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarFax) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHomeAddress) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarMailAddress) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarZipCode) & "'," _
              & "'" & dmClient.mvarBirthday & "'," _
              & IIf(dmClient.mvarBirthdayWarn, 1, 0) & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarJob) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarJobPosition) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarCompany) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarCompanySite) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarSelfSite) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarLikes) & "'," _
              & "'" & dbObj.SafeDbString(dmClient.mvarHates) & "'," _
              & dmClient.mvarImportance & "," _
              & dmClient.mvarFriendly & "," _
              & dmClient.mvarSatisfaction & "," _
              & "'" & dbObj.SafeDbString(dmClient.mvarRemark) & "'"

    ErrMsg = dbObj.RunSql(strSQL)

    Return ErrMsg

  End Function

  '删除客户资料
  Public Function Delete(ByVal lngID As Integer) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String

    strSQL = "Exec DeleteClientInfo " & lngID
    ErrMsg = dbObj.RunSql(strSQL)

    Return ErrMsg

  End Function
  '方法结束
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''

  '将某个客户移到指定的部门
  Public Function AssignToDepartment(ByRef dmClient As ClientDataModel, _
                                    ByVal iTypeID As Integer) As String


    Dim ErrMsg As String
    '实现很简单，将部门ID变一下，然后调用Update方法就行了
    dmClient.TypeID = iTypeID
    ErrMsg = Me.Update(dmClient)

    Return ErrMsg

  End Function

  
  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 得到该客户所属的客户类型，以对象返回
  '// </summary>
  '// <param name="dmType">[in][out]联系信息的数据模型</param>
  '// <param name="iClientId">客户ID</param>
  '// <returns>成功返回空字符串，失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-14	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function GetClientType(ByRef dmType As ClientTypeDataModel, _
                                  ByVal iClientId As Integer) As String

    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    '获取iClientId 对应的部门ID
    strSQL = "Exec GetTypeIdByClientId " & iClientId
    ErrMsg = dbObj.GetDataView(strSQL, dv)
    If dv.Count < 1 Then
      Return ErrMsg
    End If

    Dim iTypeId As Integer = dv(0)(Me.TypeIdField)
    Dim typeObj As New ClientType
    ErrMsg = typeObj.GetTypeInfo(dmType, iTypeId)

    Return ErrMsg

  End Function

  '
  '
  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 得到此客户类型下的所有客户
  '// </summary>
  '// <param name="Ary">客户列表数据，元素为ClientDataModel</param>
  '// <param name="iTypeId">客户类型ID，如果iTypeId = 0, 则查找所有的客户</param>
  '// <returns>成功返回空字符串，失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-14	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function Search(ByRef Ary As ArrayList, _
                    ByVal iTypeId As Integer) As String


    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    If Ary Is Nothing Then
      Ary = New ArrayList
    End If

    strSQL = "Exec GetChildClientById  " & iTypeId
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If dv.Count = 0 Then
      Return ErrMsg
    End If

    ErrMsg = FillClientDataModel(Ary, dv)

    Return ErrMsg

  End Function


  Public Function Search(ByRef Ary As ArrayList, _
                    ByVal iTypeId As Integer, _
                    ByVal szName As String, _
                    ByVal szTel As String) As String


    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView


    If Ary Is Nothing Then
      Ary = New ArrayList
    End If

    strSQL = "Exec SearchDirectChildClient " & iTypeId & ","
    strSQL &= "'%" & dbObj.SafeDbString(szName) & "%',"
    strSQL &= "'%" & dbObj.SafeDbString(szTel) & "%'"

    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If ErrMsg <> "" Then
      Return ErrMsg
    End If

    ErrMsg = FillClientDataModel(Ary, dv)

    Return ErrMsg

  End Function


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 获取客户信息
  '// </summary>
  '// <param name="dmClient">[in][out]客户信息的数据模型</param>
  '// <param name="iClientId">客户信息ID</param>
  '// <returns>成功返回空字符串，失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-14	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function GetClientInfo(ByRef dmClient As ClientDataModel, _
                    ByVal iClientId As Integer) As String


    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView


    strSQL = "Exec GetClientInfo " & iClientId
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If dv.Count < 1 Then
      Return ErrMsg
    End If

    '此后对Ary(0)操作是安全的
    Dim Ary As New ArrayList
    ErrMsg = FillClientDataModel(Ary, dv)
    If dmClient Is Nothing Then
      dmClient = New ClientDataModel
    End If
    dmClient = Ary(0)

    Return ErrMsg

  End Function


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 将DataView中的数据转换成ClientDataModel并存储到Arv中
  '// </summary>
  '// <param name="Ary">客户列表数据，元素为ClientDataModel</param>
  '// <param name="dv">从数据库中检索出来的数据</param>
  '// <returns>成功返回空字符串，失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-14	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Private Function FillClientDataModel(ByRef Ary As ArrayList, ByVal dv As DataView) As String
    Dim ErrMsg As String = ""

    If Ary Is Nothing Then
      Ary = New ArrayList
    End If

    Dim i As Integer
    Ary.Capacity = dv.Count
    Dim dmClient As ClientDataModel
    Try
      For i = 0 To dv.Count - 1
        dmClient = New ClientDataModel
        '下面直接给成员变量赋值，有两大优点：
        '  1）全部拥有访问权限
        '  2）减少函数调用，速度快
        With dmClient
          .mvarAge = dv(i)(Me.AgeField)
          .mvarBirthday = dv(i)(Me.BirthdayField)
          .mvarBirthdayWarn = IIf(CInt(dv(i)(Me.BirthdayWarnField)) = 1, True, False)
          .mvarCompany = dv(i)(Me.CompanyField).ToString
          .mvarCompanySite = dv(i)(Me.CompanySiteField).ToString
          .mvarEmail = dv(i)(Me.EmailField).ToString
          .mvarFax = dv(i)(Me.FaxField).ToString
          .mvarFriendly = dv(i)(Me.FriendlyField)
          .mvarHates = dv(i)(Me.HatesField).ToString
          .mvarHomeAddress = dv(i)(Me.HomeAddressField).ToString
          .mvarHomePhone = dv(i)(Me.HomePhoneField).ToString
          .mvarID = dv(i)(Me.IDField)
          .mvarImportance = dv(i)(Me.ImportanceField)
          .mvarJob = dv(i)(Me.JobField).ToString
          .mvarJobPosition = dv(i)(Me.JobPositionField).ToString
          .mvarLikes = dv(i)(Me.LikesField).ToString
          .mvarMailAddress = dv(i)(Me.MailAddressField).ToString
          .mvarMobile = dv(i)(Me.MobileField).ToString
          .mvarName = dv(i)(Me.Name).ToString
          .mvarOfficePhone = dv(i)(Me.OfficePhoneField).ToString
          .mvarRemark = dv(i)(Me.RemarkField).ToString.ToString
          .mvarSatisfaction = dv(i)(Me.SatisfactionField)
          .mvarSelfSite = dv(i)(Me.SelfSiteField).ToString
          .mvarSex = dv(i)(Me.SexField)
          .mvarTypeId = dv(i)(Me.TypeIdField)
          .mvarTypeName = dv(i)(Me.TypeNameField).ToString
          .mvarZipCode = dv(i)(Me.ZipCodeField).ToString
        End With
        Ary.Add(dmClient)
      Next
    Catch ex As Exception
      ErrMsg = ex.Message
    End Try

    Return ErrMsg

  End Function
End Class