kcpddh.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 = "KcPddh"
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_KcPdds As KcPdds
Dim m_HwCk As HwCk

Dim m_KcPddhDocno As String
Dim m_KcPddhDat As String

Dim m_KcPddh_HwCkMc As String
Dim m_KcPddh_HwCkNo As Double

Dim m_KcPddhSysDat As String
Dim m_KcPddhSysTime As String
Dim m_KcPddhNo As Double

Dim m_KcPddhId As Integer
Dim m_KcPddhKey As Double

Private Sub Class_Initialize()
   m_KcPddhId = -1
End Sub

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

Public Property Get KcPddhId() As Integer
   KcPddhId = m_KcPddhId
End Property

Public Property Get KcPddhKey() As Double
   KcPddhKey = m_KcPddhKey
End Property

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

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

Public Property Get KcPddhDocno() As String
   KcPddhDocno = m_KcPddhDocno
End Property

Public Property Get KcPddhDat() As String
   KcPddhDat = m_KcPddhDat
End Property

Public Property Get KcPddh_HwCkno() As Double
   KcPddh_HwCkno = m_KcPddh_HwCkNo
End Property

Public Property Get KcPddhSysDat() As String
   KcPddhSysDat = m_KcPddhSysDat
End Property

Public Property Get KcPddhSysTime() As String
   KcPddhSysTime = m_KcPddhSysTime
End Property

Public Property Get KcPddhNo() As Double
   KcPddhNo = m_KcPddhNo
End Property

Public Property Let KcPddhId(vKcPddhId As Integer)
   m_KcPddhId = vKcPddhId
End Property

Public Property Let KcPddhKey(vKcPddhKey As Double)
   m_KcPddhKey = vKcPddhKey
End Property

Public Property Let KcPddhDocno(vKcPddhDocno As String)
   If Trim(vKcPddhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "盘点单号不能为空！"
      Exit Property
   End If
   If m_KcPddhDocno <> vKcPddhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM KcPddHREC WHERE KcPddHDOCNO='" & vKcPddhDocno & "'")
      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_KcPddhDocno = vKcPddhDocno
End Property

Public Property Let KcPddhDat(vKcPddhDat As String)
   If Trim(vKcPddhDat) = "" Then
      Err.Raise vbObjectError + 1, , "盘点日期不能为空！"
      Exit Property
   End If
   m_KcPddhDat = vKcPddhDat
End Property

Public Property Let KcPddh_HwCkMc(vKcPddh_HwCkMc As String)
   If Trim(vKcPddh_HwCkMc) = "" Then
      Err.Raise vbObjectError + 1, , "仓库不能为空！"
      Exit Property
   End If
   If m_KcPddh_HwCkMc <> vKcPddh_HwCkMc Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT HwCkno FROM HWCKREC WHERE HwCkMc='" & vKcPddh_HwCkMc & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的仓库不存在！"
         Exit Property
      End If
      HwCk.Requery vKcPddh_HwCkMc
      m_KcPddh_HwCkNo = Rs!HwCkNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_KcPddh_HwCkMc = vKcPddh_HwCkMc
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If KcPdds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_KcPddhId = -1 Then
      Cmd.CommandText = "{CALL KcPddHREC_INSERT(?,?,?,?,?,?)}"
      Cmd(0) = m_KcPddhDocno
      Cmd(1) = m_KcPddhDat
      Cmd(2) = m_KcPddh_HwCkNo
      Cmd(3).Direction = adParamOutput 'KcPddhSysDate
      Cmd(4).Direction = adParamOutput 'KcPddhSysTime
      Cmd(5).Direction = adParamOutput 'KcPddhNo
   Else
      Cmd.CommandText = "{CALL KcPddhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_KcPddhNo
      Cmd(1) = m_KcPddhDocno
      Cmd(2) = m_KcPddhDat
      Cmd(3) = m_KcPddh_HwCkNo
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_KcPddhId = -1 Then
      m_KcPddhNo = Cmd(5)
   End If
   KcPdds.Save Me
   Conn.CommitTrans
   
   If m_KcPddhId = -1 Then
      m_KcPddhSysDat = Cmd(3)
      m_KcPddhSysTime = Cmd(4)
      m_KcPddhId = 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 KcPddHREC_DELETE(?)}"
   Cmd(0) = m_KcPddhNo
   
   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(vKcPddhDocno As String, Optional vKcPddhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcPddHDOCNO,KcPddHDAT,KcPddH_HwCkMc=HwCkMc,KcPddH_HwCkno,KcPddHSYSDAT,KcPddHSYSTIME,KcPddHNO FROM KcPddHREC,HWCKREC WHERE (KcPddHDOCNO='" & vKcPddhDocno & "' OR KcPddHNO=" & CStr(vKcPddhno) & ") AND HwCkno=KcPddH_HwCkno")
   If Not mRs.EOF Then
      BatchLet mRs!KcPddhDocno, mRs!KcPddhDat, mRs!KcPddh_HwCkMc, mRs!KcPddh_HwCkno, mRs!KcPddhSysDat, mRs!KcPddhSysTime, mRs!KcPddhNo
   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_KcPddhDocno = Properties(0)
   m_KcPddhDat = Properties(1)
   m_KcPddh_HwCkMc = Properties(2)
   m_KcPddh_HwCkNo = Properties(3)
   m_KcPddhSysDat = Properties(4)
   m_KcPddhSysTime = Properties(5)
   m_KcPddhNo = Properties(6)

   m_KcPddhId = 1

End Sub