hwbm.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 = "Hwbm"
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_HwBmCode As String
Dim m_HwBmMc As String
Dim m_HwBmDw As String
Dim m_HwBmIsStop As Integer
Dim m_HwBmNo As Double

Dim m_HwBmId As Integer
Dim m_HwBmKey As Integer

Private Sub Class_Initialize()
   m_HwBmId = -1
End Sub

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

Public Property Get HwbmId() As Integer
   HwbmId = m_HwBmId
End Property

Public Property Get HwbmKey() As Integer
   HwbmKey = m_HwBmKey
End Property

Public Property Get HwBmCode() As String
   HwBmCode = m_HwBmCode
End Property

Public Property Get HwBmMc() As String
   HwBmMc = m_HwBmMc
End Property

Public Property Get HwBmDw() As String
   HwBmDw = m_HwBmDw
End Property

Public Property Get HwBmIsStop() As Integer
   HwBmIsStop = m_HwBmIsStop
End Property

Public Property Get HwBmNo() As Double
   HwBmNo = m_HwBmNo
End Property

Public Property Let HwbmId(vHwbmId As Integer)
   m_HwBmId = vHwbmId
End Property

Public Property Let HwbmKey(vHwbmKey As Integer)
   m_HwBmKey = vHwbmKey
End Property

Public Property Let HwBmCode(vHwbmCode As String)
   If Trim(vHwbmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_HwBmCode <> vHwbmCode Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM HWBMREC WHERE HwbmCode='" & vHwbmCode & "'")
      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_HwBmCode = vHwbmCode
End Property

Public Property Let HwBmMc(vHwBmMc As String)
   If Trim(vHwBmMc) = "" Then
      Err.Raise vbObjectError + 1, , "货物名称不能为空！"
      Exit Property
   End If
   m_HwBmMc = vHwBmMc
End Property

Public Property Let HwBmDw(vHwBmDw As String)
   If Trim(vHwBmDw) = "" Then
      Err.Raise vbObjectError + 1, , "货物单位不能为空！"
      Exit Property
   End If
   m_HwBmDw = vHwBmDw
End Property

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

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_HwBmId = -1 Then
      Cmd.CommandText = "{CALL HWBMREC_INSERT(?,?,?,?,?)}"
      Cmd(0) = m_HwBmCode
      Cmd(1) = m_HwBmMc
      Cmd(2) = m_HwBmDw
      Cmd(3) = m_HwBmIsStop
      Cmd(4).Direction = adParamOutput
   Else
      Cmd.CommandText = "{CALL HWBMREC_UPDATE(?,?,?,?,?)}"
      Cmd(0) = m_HwBmNo
      Cmd(1) = m_HwBmCode
      Cmd(2) = m_HwBmMc
      Cmd(3) = m_HwBmDw
      Cmd(4) = m_HwBmIsStop
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
   If m_HwBmId = -1 Then
      m_HwBmNo = Cmd(4)
      m_HwBmId = 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 HWBMREC_DELETE(?)}"
   Cmd(0) = m_HwBmNo
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vHwbmCode As String, Optional vHwbmNo As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT HWBMCODE,HWBMMC,HWBMDW,HWBMISSTOP,HWBMNO FROM HWBMREC WHERE (HWBMCODE='" & vHwbmCode & "' OR HWBMNO=" & CStr(vHwbmNo) & ")")
   If Not mRs.EOF Then
      BatchLet mRs!HwBmCode, mRs!HwBmMc, mRs!HwBmDw, mRs!HwBmIsStop, mRs!HwBmNo
      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_HwBmCode = Properties(0)
   m_HwBmMc = Properties(1)
   m_HwBmDw = Properties(2)
   m_HwBmIsStop = Properties(3)
   m_HwBmNo = Properties(4)

   m_HwBmId = 1

End Sub