xssod.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 = "XsSod"
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_XsSodh As XsSodh
Dim m_Hwbm As Hwbm

Dim m_XsSod_XsSodhno As Double
Dim m_XsSod_HwBmCode As String
Dim m_XsSod_HwBmno As Double

Dim m_XsSodQty As Double
Dim m_XsSodPrice As Double
Dim m_XsSodAmt As Double
Dim m_XsSodOQty As Double

Dim m_XsSodDDat As String
Dim m_XsSodBz As String

Dim m_XsSodSysDat As String
Dim m_XsSodSysTime As String
Dim m_XsSodNo As Double

Dim m_XsSodId As Integer
Dim m_XsSodKey As Double

Private Sub Class_Initialize()
   m_XsSodId = -1
End Sub

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

Public Property Get XsSodId() As Integer
   XsSodId = m_XsSodId
End Property

Public Property Get XsSodKey() As Double
   XsSodKey = m_XsSodKey
End Property

Public Property Get XsSodh() As XsSodh
   If m_XsSodh Is Nothing Then
      Set m_XsSodh = New XsSodh
      m_XsSodh.Requery "", m_XsSod_XsSodhno
   End If
   Set XsSodh = m_XsSodh
End Property

Public Property Get Hwbm() As Hwbm
   If m_Hwbm Is Nothing Then
      Set m_Hwbm = New Hwbm
      m_Hwbm.Requery "", m_XsSod_HwBmno
   End If
   Set Hwbm = m_Hwbm
End Property

Public Property Get XsSod_XsSodhno() As Double
   XsSod_XsSodhno = m_XsSod_XsSodhno
End Property

Public Property Get XsSod_HwBmno() As Double
   XsSod_HwBmno = m_XsSod_HwBmno
End Property

Public Property Get XsSodQty() As Double
   XsSodQty = m_XsSodQty
End Property

Public Property Get XsSodPrice() As Double
   XsSodPrice = m_XsSodPrice
End Property

Public Property Get XsSodAmt() As Double
   XsSodAmt = m_XsSodAmt
End Property

Public Property Get XsSodOQty() As Double
   XsSodOQty = m_XsSodOQty
End Property

Public Property Get XsSodDDat() As String
   XsSodDDat = m_XsSodDDat
End Property

Public Property Get XsSodBz() As String
   XsSodBz = m_XsSodBz
End Property

Public Property Get XsSodSysDat() As String
   XsSodSysDat = m_XsSodSysDat
End Property

Public Property Get XsSodSysTime() As String
   XsSodSysTime = m_XsSodSysTime
End Property

Public Property Get XsSodNo() As Double
   XsSodNo = m_XsSodNo
End Property

Public Property Let XsSodId(vXsSodId As Integer)
   m_XsSodId = vXsSodId
End Property

Public Property Let XsSodKey(vXsSodKey As Double)
   m_XsSodKey = vXsSodKey
End Property

Public Property Set XsSodh(vXsSodh As XsSodh)
   Set m_XsSodh = vXsSodh
End Property

Public Property Let XsSod_HwBmCode(vXsSod_HwBmCode As String)
   If Trim(vXsSod_HwBmCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_XsSod_HwBmCode <> vXsSod_HwBmCode Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HWBMNO FROM HWBMREC WHERE HWBMCODE='" & vXsSod_HwBmCode & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的货物编码不存在！"
         Exit Property
      End If
      m_XsSod_HwBmno = Rs!HwBmNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_XsSod_HwBmCode = vXsSod_HwBmCode
End Property

Public Property Let XsSodQty(vXsSodQty As Double)
   If vXsSodQty <= 0 Then
      Err.Raise vbObjectError + 1, , "订单数量必须大于零！"
      Exit Property
   End If
   m_XsSodQty = vXsSodQty
   m_XsSodAmt = vXsSodQty * m_XsSodPrice
End Property

Public Property Let XsSodPrice(vXsSodPrice As Double)
   If vXsSodPrice < 0 Then
      Err.Raise vbObjectError + 1, , "订单单价不能小于零！"
      Exit Property
   End If
   m_XsSodPrice = vXsSodPrice
   m_XsSodAmt = vXsSodPrice * m_XsSodQty
End Property

Public Property Let XsSodDDat(vXsSodDDat As String)
   m_XsSodDDat = vXsSodDDat
End Property

Public Property Let XsSodBz(vXsSodDBz As String)
   m_XsSodBz = vXsSodDBz
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If m_XsSodId = -1 Then
      Cmd.CommandText = "{CALL XSSODREC_INSERT(?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_XsSodh.XsSodhNo
      Cmd(1) = m_XsSod_HwBmno
      Cmd(2) = m_XsSodQty
      Cmd(3) = m_XsSodPrice
      Cmd(4) = m_XsSodAmt
      Cmd(5) = m_XsSodDDat
      Cmd(6) = m_XsSodBz
      Cmd(7).Direction = adParamOutput 'XsSodSysDate
      Cmd(8).Direction = adParamOutput 'XsSodSysTime
      Cmd(9).Direction = adParamOutput 'XsSodNo
   Else
      Cmd.CommandText = "{CALL XSSODREC_UPDATE(?,?,?,?,?,?,?)}"
      Cmd(0) = m_XsSodNo
      Cmd(1) = m_XsSod_HwBmno
      Cmd(2) = m_XsSodQty
      Cmd(3) = m_XsSodPrice
      Cmd(4) = m_XsSodAmt
      Cmd(5) = m_XsSodDDat
      Cmd(6) = m_XsSodBz
   End If
   
   Cmd.Execute
   
   If m_XsSodId = -1 Then
      m_XsSodSysDat = Cmd(7)
      m_XsSodSysTime = Cmd(8)
      m_XsSodNo = Cmd(9)
      m_XsSodId = 1
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del()
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL XSSODREC_DELETE(?)}"
   Cmd(0) = m_XsSodNo
   
   
   Conn.BeginTrans
   Cmd.Execute
   If XsSodh.XsSods.Count = 1 Then
      XsSodh.Del 1
   End If
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vXsSodNo As Double) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT XSSOD_XSSODHNO,XSSOD_HWBMCODE=HWBMCODE,XSSOD_HWBMNO,XSSODQTY,XSSODPRICE,XSSODAMT,XSSODOQTY,XSSODDDAT,XSSODBZ,XSSODSYSDAT,XSSODSYSTIME,XSSODNO FROM XSSODREC,HWBMREC WHERE XSSODNO=" & CStr(vXsSodNo) & " AND HWBMNO=XSSOD_HWBMNO")
   If Not mRs.EOF Then
      BatchLet mRs!XsSod_XsSodhno, mRs!XsSod_HwBmCode, mRs!XsSod_HwBmno, mRs!XsSodQty, mRs!XsSodPrice, mRs!XsSodAmt, mRs!XsSodOQty, mRs!XsSodDDat, mRs!XsSodBz, mRs!XsSodSysDat, mRs!XsSodSysTime, mRs!XsSodNo
   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_XsSod_XsSodhno = Properties(0)
   m_XsSod_HwBmCode = Properties(1)
   m_XsSod_HwBmno = Properties(2)
   m_XsSodQty = Properties(3)
   m_XsSodPrice = Properties(4)
   m_XsSodAmt = Properties(5)
   m_XsSodOQty = Properties(6)
   m_XsSodDDat = Properties(7)
   m_XsSodBz = Properties(8)
   m_XsSodSysDat = Properties(9)
   m_XsSodSysTime = Properties(10)
   m_XsSodNo = Properties(11)

   m_XsSodId = 1

End Sub