kcbfdh.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 = "KcBfdh"
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_KcBfds As KcBfds
Dim m_HwCk As HwCk

Dim m_KcBfdhDocno As String
Dim m_KcBfdhDat As String

Dim m_KcBfdh_HwCkMc As String
Dim m_KcBfdh_HwCkNo As Double

Dim m_KcBfdhSysDat As String
Dim m_KcBfdhSysTime As String
Dim m_KcBfdhNo As Double

Dim m_KcBfdhId As Integer
Dim m_KcBfdhKey As Double

Private Sub Class_Initialize()
   m_KcBfdhId = -1
End Sub

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

Public Property Get KcBfdhId() As Integer
   KcBfdhId = m_KcBfdhId
End Property

Public Property Get KcBfdhKey() As Double
   KcBfdhKey = m_KcBfdhKey
End Property

Public Property Get KcBfds() As KcBfds
   If m_KcBfds Is Nothing Then
      Set m_KcBfds = New KcBfds
      m_KcBfds.Fillbydb Me
   End If
   Set KcBfds = m_KcBfds
End Property

Public Property Get HwCk() As HwCk
   If m_HwCk Is Nothing Then
      Set m_HwCk = New HwCk
      m_HwCk.Requery "", m_KcBfdh_HwCkNo
   End If
   Set HwCk = m_HwCk
End Property

Public Property Get KcBfdhDocno() As String
   KcBfdhDocno = m_KcBfdhDocno
End Property

Public Property Get KcBfdhDat() As String
   KcBfdhDat = m_KcBfdhDat
End Property

Public Property Get KcBfdh_HwCkno() As Double
   KcBfdh_HwCkno = m_KcBfdh_HwCkNo
End Property

Public Property Get KcBfdhSysDat() As String
   KcBfdhSysDat = m_KcBfdhSysDat
End Property

Public Property Get KcBfdhSysTime() As String
   KcBfdhSysTime = m_KcBfdhSysTime
End Property

Public Property Get KcBfdhNo() As Double
   KcBfdhNo = m_KcBfdhNo
End Property

Public Property Let KcBfdhId(vKcBfdhId As Integer)
   m_KcBfdhId = vKcBfdhId
End Property

Public Property Let KcBfdhKey(vKcBfdhKey As Double)
   m_KcBfdhKey = vKcBfdhKey
End Property

Public Property Let KcBfdhDocno(vKcBfdhDocno As String)
   If Trim(vKcBfdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "报废单号不能为空！"
      Exit Property
   End If
   If m_KcBfdhDocno <> vKcBfdhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM KcBfdHREC WHERE KcBfdHDOCNO='" & vKcBfdhDocno & "'")
      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_KcBfdhDocno = vKcBfdhDocno
End Property

Public Property Let KcBfdhDat(vKcBfdhDat As String)
   If Trim(vKcBfdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "报废日期不能为空！"
      Exit Property
   End If
   m_KcBfdhDat = vKcBfdhDat
End Property

Public Property Let KcBfdh_HwCkMc(vKcBfdh_HwCkMc As String)
   If Trim(vKcBfdh_HwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   If m_KcBfdh_HwCkMc <> vKcBfdh_HwCkMc Then
      If HwCk.Requery(vKcBfdh_HwCkMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      m_KcBfdh_HwCkNo = HwCk.HwCkNo
   End If
   m_KcBfdh_HwCkMc = vKcBfdh_HwCkMc
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If KcBfds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_KcBfdhId = -1 Then
      Cmd.CommandText = "{CALL KcBfdHREC_INSERT(?,?,?,?,?,?)}"
      Cmd(0) = m_KcBfdhDocno
      Cmd(1) = m_KcBfdhDat
      Cmd(2) = m_KcBfdh_HwCkNo
      Cmd(3).Direction = adParamOutput 'KcBfdhSysDate
      Cmd(4).Direction = adParamOutput 'KcBfdhSysTime
      Cmd(5).Direction = adParamOutput 'KcBfdhNo
   Else
      
      KcBfds.Save Me
      
      Cmd.CommandText = "{CALL KcBfdhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_KcBfdhNo
      Cmd(1) = m_KcBfdhDocno
      Cmd(2) = m_KcBfdhDat
      Cmd(3) = m_KcBfdh_HwCkNo
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_KcBfdhId = -1 Then
      m_KcBfdhNo = Cmd(5)
      KcBfds.Save Me
   End If
   Conn.CommitTrans
   
   If m_KcBfdhId = -1 Then
      m_KcBfdhSysDat = Cmd(3)
      m_KcBfdhSysTime = Cmd(4)
      m_KcBfdhId = 1
   End If
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del(Optional mMxDel As Integer = 0)
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL KcBfdHREC_DELETE(?)}"
   Cmd(0) = m_KcBfdhNo
   
   If mMxDel = 0 Then
      Conn.BeginTrans
   End If
   Cmd.Execute
   If mMxDel = 0 Then
      Conn.CommitTrans
   End If
   
Exit Sub
Errorhandle:
   If mMxDel = 0 Then
      Conn.RollbackTrans
   End If
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vKcBfdhDocno As String, Optional vKcBfdhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcBfdHDOCNO,KcBfdHDAT,KcBfdH_HwCkMc=HwCkMc,KcBfdH_HwCkno,KcBfdHSYSDAT,KcBfdHSYSTIME,KcBfdHNO FROM KcBfdHREC,HWCKREC WHERE (KcBfdHDOCNO='" & vKcBfdhDocno & "' OR KcBfdHNO=" & CStr(vKcBfdhno) & ") AND HwCkno=KcBfdH_HwCkno")
   If Not mRs.EOF Then
      BatchLet mRs!KcBfdhDocno, mRs!KcBfdhDat, mRs!KcBfdh_HwCkMc, mRs!KcBfdh_HwCkno, mRs!KcBfdhSysDat, mRs!KcBfdhSysTime, mRs!KcBfdhNo
   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_KcBfdhDocno = Properties(0)
   m_KcBfdhDat = Properties(1)
   m_KcBfdh_HwCkMc = Properties(2)
   m_KcBfdh_HwCkNo = Properties(3)
   m_KcBfdhSysDat = Properties(4)
   m_KcBfdhSysTime = Properties(5)
   m_KcBfdhNo = Properties(6)

   m_KcBfdhId = 1

End Sub