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

📄 message.vb

📁 <Visual Basic 数据库开发实例精粹(第二版)>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术
💻 VB
字号:
'==================================
'
' 联系信息数据模型描述
'
'==================================
Public Class MessageDataModel
  '类的数据成员变量
  Public m_iInfoID As Int64
  Public m_bProcessed As Boolean
  Public m_iDeptSendId As Integer
  Public m_iDeptReceiveId As Integer
  Public m_szDeptSendName As String
  Public m_szDeptReceiveName As String
  Public m_iAddresserID As Integer
  Public m_szAddresserAccount As String
  Public m_szAddresserTrueName As String
  Public m_szAddresserTel As String
  Public m_dtProcTimeLimit As Date
  Public m_dtSendTime As Date
  Public m_szInfoContent As String
  Public m_iReplyInfoID As Int64
End Class

'==================================
'
' 信息描述,提供联系信息操作的所有功能
'
'==================================
Public Class Message
  '类内部定义的数据库字段名,只读,字段名与数据库中的值一致
  Protected Const InfoIDField = "InfoID"
  Protected Const ProcessedField = "Processed"
  Protected Const DeptSendIdField = "DeptSend"
  Protected Const DeptSendNameField = "DeptSendName"
  Protected Const DeptReceiveIdField = "DeptReceive"
  Protected Const DeptReceiveNameField = "DeptReceiveName"
  Protected Const AddresserIDField = "AddresserID"
  Protected Const AddresserAccountField = "AddresserAccount"
  Protected Const AddresserTrueNameField = "TrueName"
  Protected Const AddresserTelField = "AddresserTel"
  Protected Const ProcTimeLimitField = "ProcTimeLimit"
  Protected Const SendTimeField = "SendTime"
  Protected Const InfoContentField = "InfoContent"
  Protected Const ReplyInfoIDField = "ReplyInfoID"


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 添加一个新信息
  '// </summary>
  '// <param name="dmMsg">[in]联系信息的数据模型</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Private Function AddMsg(ByRef dmMsg As MessageDataModel) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    strSQL = "EXEC AddMessage " & IIf(dmMsg.m_bProcessed, 1, 0) _
            & "," & dmMsg.m_iDeptSendId _
            & "," & dmMsg.m_iDeptReceiveId _
            & "," & dmMsg.m_iAddresserID _
            & ",'" & dbObj.SafeDbString(dmMsg.m_szAddresserAccount) & "'" _
            & ",'" & dbObj.SafeDbString(dmMsg.m_szAddresserTel) & "'" _
            & ",'" & dmMsg.m_dtProcTimeLimit & "'" _
            & ",'" & dmMsg.m_dtSendTime & "'" _
            & ",'" & dbObj.SafeDbString(dmMsg.m_szInfoContent) & "'" _
            & "," & dmMsg.m_iReplyInfoID

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

    dmMsg.m_iInfoID = dv(0)(Me.InfoIDField)

    Return ErrMsg

  End Function

  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 根据信息ID获取联系信息
  '// </summary>
  '// <param name="dmMsg">[in][out]联系信息的数据模型,传入时ID已初始化</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Private Function GetMsg(ByRef dmMsg As MessageDataModel) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView

    strSQL = "EXEC GetMessage " & dmMsg.m_iInfoID
    ErrMsg = dbObj.GetDataView(strSQL, dv)
    If dv.Count = 0 Then
      Return ErrMsg
    End If

    '给dmMsg赋值
    dmMsg.m_bProcessed = IIf(dv(0)(Me.ProcessedField) > 0, True, False)
    dmMsg.m_iDeptSendId = dv(0)(Me.DeptSendIdField)
    dmMsg.m_iDeptReceiveId = dv(0)(Me.DeptReceiveIdField)
    dmMsg.m_szDeptSendName = dv(0)(Me.DeptSendNameField)
    dmMsg.m_szDeptReceiveName = dv(0)(Me.DeptReceiveNameField)
    dmMsg.m_iAddresserID = dv(0)(Me.AddresserIDField)
    dmMsg.m_szAddresserAccount = dv(0)(Me.AddresserAccountField)
    dmMsg.m_szAddresserTel = dv(0)(Me.AddresserTelField)
    dmMsg.m_szAddresserTrueName = dv(0)(Me.AddresserTrueNameField)
    dmMsg.m_dtProcTimeLimit = dv(0)(Me.ProcTimeLimitField)
    dmMsg.m_dtSendTime = dv(0)(Me.SendTimeField)
    dmMsg.m_szInfoContent = dv(0)(Me.InfoContentField)
    dmMsg.m_iReplyInfoID = dv(0)(Me.ReplyInfoIDField)

    Return ErrMsg

  End Function

  Public Function SendMsg(ByRef dmMsg As MessageDataModel) As String
    dmMsg.m_dtSendTime = Now()

    Return AddMsg(dmMsg)

  End Function

  Public Function ReceiveMsg(ByVal iMsgId As Int64, _
                      ByRef dmMsg As MessageDataModel) As String
    dmMsg.m_iInfoID = iMsgId

    Return GetMsg(dmMsg)
  End Function


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 根据条件获取简要的消息列表,不包括消息正文
  '// </summary>
  '// <param name="Arv">消息列表数据,元素为MessageDataModel</param>
  '// <param name="iDeptSend">信息发送者的部门</param>
  '// <param name="iDeptReceive">信息接收者的部门</param>
  '// <param name="bShowReply">是否包括回复的信息</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function GetConciseMsgList(ByRef Arv As ArrayList, _
                                    ByVal iDeptSend As Integer, _
                                    ByVal iDeptReceive As Integer, _
                                    ByVal bShowReply As Boolean) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView
    Dim iShowReply As Int16
    '为了语义清晰,将Boolean转换为int,True-1, False-0,
    '要与存储过程中的定义一致
    iShowReply = IIf(bShowReply, 1, 0)
    strSQL = "Exec GetConciseMsgList " & iDeptSend & "," & iDeptReceive & "," & iShowReply
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If ErrMsg <> "" Then
      Return ErrMsg
    End If

    ErrMsg = FillMsgDataModelArray(Arv, dv)

    Return ErrMsg

  End Function


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 根据条件获取某条信息的回复信息简要列表,不包括信息正文
  '// </summary>
  '// <param name="Arv">消息列表数据,元素为MessageDataModel</param>
  '// <param name="iDeptSend">信息发送者的部门</param>
  '// <param name="iDeptReceive">信息接收者的部门</param>
  '// <param name="lReplyMsgID">被回复的信息ID</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function GetConciseReplyMsgList(ByRef Arv As ArrayList, _
                                    ByVal iDeptSend As Integer, _
                                    ByVal iDeptReceive As Integer, _
                                    ByVal lReplyMsgID As Long) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView
    '为了语义清晰,将Boolean转换为int,True-1, False-0,
    '要与存储过程中的定义一致
    strSQL = "Exec GetConciseReplyMsgList " & lReplyMsgID & "," & iDeptSend & "," & iDeptReceive
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If ErrMsg <> "" Then
      Return ErrMsg
    End If

    ErrMsg = FillMsgDataModelArray(Arv, dv)

    Return ErrMsg

  End Function

  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 根据条件搜索信息,结果不包括信息正文
  '// </summary>
  '// <param name="Arv">消息列表数据,元素为MessageDataModel</param>
  '// <param name="iDeptSend">信息发送者的部门</param>
  '// <param name="iDeptReceive">信息接收者的部门</param>
  '// <param name="strAddresser">发送者的姓名或账号</param>
  '// <param name="strKey">消息关键字</param>
  '// <param name="bShowReply">是否包括回复信息</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Public Function Search(ByRef Arv As ArrayList, _
                                      ByVal iDeptSend As Integer, _
                                      ByVal iDeptReceive As Integer, _
                                      ByVal strAddresser As String, _
                                      ByVal strKey As String, _
                                      ByVal bShowReply As Boolean) As String
    Dim dbObj As New DBOpProvider.ConnSqlServer.SQLClass
    Dim ErrMsg As String = ""
    Dim strSQL As String
    Dim dv As New DataView
    Dim iShowReply As Int16
    '为了语义清晰,将Boolean转换为int,True-1, False-0,
    '要与存储过程中的定义一致
    iShowReply = IIf(bShowReply, 1, 0)
    strSQL = "Exec SearchConciseMsgList " & iDeptSend & "," & iDeptReceive & "," _
              & "'%" & dbObj.SafeDbString(strAddresser) & "%'," _
              & "'%" & dbObj.SafeDbString(strKey) & "%'," _
              & iShowReply
    ErrMsg = dbObj.GetDataView(strSQL, dv)

    If ErrMsg <> "" Then
      Return ErrMsg
    End If

    ErrMsg = FillMsgDataModelArray(Arv, dv)

    Return ErrMsg

  End Function


  '// -----------------------------------------------------------------------------
  '// <summary>
  '// 将DataView中的数据转换成MessageDataModel并存储到Arv中
  '// </summary>
  '// <param name="Arv">消息列表数据,元素为MessageDataModel</param>
  '// <param name="dv">从数据库中检索出来的数据</param>
  '// <returns>成功返回空字符串,失败返回错误信息</returns>
  '// <remarks>
  '// </remarks>
  '// <history>
  '// 	[Tom]	2006-1-21	Created
  '// </history>
  '// -----------------------------------------------------------------------------
  Private Function FillMsgDataModelArray(ByRef Arv As ArrayList, _
                                          ByVal dv As DataView) As String
    Dim ErrMsg As String = ""
    '验证dv是否有效
    If dv Is Nothing Then
      Return "Invalid Dataview"
    End If

    '验证Arv是否实例化
    If Arv Is Nothing Then
      Arv = New ArrayList
    End If
    Arv.Clear()
    Arv.Capacity = dv.Count

    Dim i As Integer
    Dim dmMsgObj As MessageDataModel

    Try
      '填写数据
      For i = 0 To dv.Count - 1
        dmMsgObj = New MessageDataModel
        dmMsgObj.m_iInfoID = dv(i)(Me.InfoIDField)
        dmMsgObj.m_bProcessed = dv(i)(Me.ProcessedField)
        dmMsgObj.m_iDeptSendId = dv(i)(Me.DeptSendIdField)
        dmMsgObj.m_iDeptReceiveId = dv(i)(Me.InfoIDField)
        dmMsgObj.m_szDeptSendName = dv(i)(Me.DeptSendNameField)
        dmMsgObj.m_szDeptReceiveName = dv(i)(Me.DeptReceiveNameField)
        dmMsgObj.m_szAddresserAccount = dv(i)(Me.AddresserAccountField)
        dmMsgObj.m_szAddresserTrueName = dv(i)(Me.AddresserTrueNameField)
        dmMsgObj.m_szAddresserTel = dv(i)(Me.AddresserTelField)
        dmMsgObj.m_dtProcTimeLimit = dv(i)(Me.ProcTimeLimitField)
        dmMsgObj.m_dtSendTime = dv(i)(Me.SendTimeField)
        dmMsgObj.m_iReplyInfoID = dv(i)(Me.ReplyInfoIDField)

        Arv.Add(dmMsgObj)
      Next
    Catch ex As Exception
      ErrMsg = ex.Message
    End Try

    Return ErrMsg

  End Function

End Class

⌨️ 快捷键说明

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