hwbfrc.cls

企业的进销存源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HwBfRc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:[e-mail]
Option Explicit

Dim m_HwBfRcMc As String
Dim m_HwBfRcIsStop As Integer
Dim m_HwBfRcNo As Double

Dim m_HwBfRcId As Integer
Dim m_HwBfRcKey As Integer

Private Sub Class_Initialize()
   m_HwBfRcId = -1
End Sub

Public Property Get Name() As String
   Name = "HwBfRc"
End Property

Public Property Get HwBfRcId() As Integer
   HwBfRcId = m_HwBfRcId
End Property

Public Property Get HwBfRcKey() As Integer
   HwBfRcKey = m_HwBfRcKey
End Property

Public Property Get HwBfRcMc() As String
   HwBfRcMc = m_HwBfRcMc
End Property

Public Property Get HwBfRcIsStop() As Integer
   HwBfRcIsStop = m_HwBfRcIsStop
End Property

Public Property Get HwBfRcNo() As Double
   HwBfRcNo = m_HwBfRcNo
End Property

Public Property Let HwBfRcId(vHwBfRcId As Integer)
   m_HwBfRcId = vHwBfRcId
End Property

Public Property Let HwBfRcKey(vHwBfRcKey As Integer)
   m_HwBfRcKey = vHwBfRcKey
End Property

Public Property Let HwBfRcMc(vHwBfRcMc As String)
   If Trim(vHwBfRcMc) = "" Then
      Err.Raise vbObjectError + 1, , "报废原因名称不能为空！"
      Exit Property
   End If
   If m_HwBfRcMc <> vHwBfRcMc Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM HwBfRcREC WHERE HwBfRcMc='" & vHwBfRcMc & "'")
      If Not Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "报废原因名称已经存在！"
         Exit Property
      End If
      Rs.Close
      Set Rs = Nothing
   End If
   m_HwBfRcMc = vHwBfRcMc
End Property

Public Property Let HwBfRcIsStop(vHwBfRcIsStop As Integer)
   If vHwBfRcIsStop <> 0 And vHwBfRcIsStop <> 1 Then
      Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
      Exit Property
   End If
   m_HwBfRcIsStop = vHwBfRcIsStop
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_HwBfRcId = -1 Then
      Cmd.CommandText = "{CALL HwBfRcREC_INSERT(?,?,?)}"
      Cmd(0) = m_HwBfRcMc
      Cmd(1) = m_HwBfRcIsStop
      Cmd(2).Direction = adParamOutput
   Else
      Cmd.CommandText = "{CALL HwBfRcREC_UPDATE(?,?,?)}"
      Cmd(0) = m_HwBfRcNo
      Cmd(1) = m_HwBfRcMc
      Cmd(2) = m_HwBfRcIsStop
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
   If m_HwBfRcId = -1 Then
      m_HwBfRcNo = Cmd(2)
      m_HwBfRcId = 1
   End If
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del()
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL HwBfRcREC_DELETE(?)}"
   Cmd(0) = m_HwBfRcNo
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vHwBfRcCode As String, Optional vHwBfRcNo As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT HwBfRcMC,HwBfRcISSTOP,HwBfRcNO FROM HwBfRcREC WHERE (HwBfRcMc='" & vHwBfRcCode & "' OR HWBFRCNO=" & CStr(vHwBfRcNo) & ")")
   If Not mRs.EOF Then
      BatchLet mRs!HwBfRcMc, mRs!HwBfRcIsStop, mRs!HwBfRcNo
      Requery = 1
   End If
   Set mRs = Nothing
Exit Function
Errorhandle:
   Set mRs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Function

Public Sub BatchLet(ParamArray Properties() As Variant)

   m_HwBfRcMc = Properties(0)
   m_HwBfRcIsStop = Properties(1)
   m_HwBfRcNo = Properties(2)

   m_HwBfRcId = 1

End Sub