kcdbdh.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 = "KcDbdh"
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_KcDbds As KcDbds

Dim m_KcDbdhDocno As String
Dim m_KcDbdhDat As String
Dim m_KcDbdhSysDat As String
Dim m_KcDbdhSysTime As String
Dim m_KcDbdhNo As Double

Dim m_KcDbdhId As Integer
Dim m_KcDbdhKey As Double

Private Sub Class_Initialize()
   m_KcDbdhId = -1
End Sub

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

Public Property Get KcDbdhId() As Integer
   KcDbdhId = m_KcDbdhId
End Property

Public Property Get KcDbdhKey() As Double
   KcDbdhKey = m_KcDbdhKey
End Property

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

Public Property Get KcDbdhDocno() As String
   KcDbdhDocno = m_KcDbdhDocno
End Property

Public Property Get KcDbdhDat() As String
   KcDbdhDat = m_KcDbdhDat
End Property

Public Property Get KcDbdhSysDat() As String
   KcDbdhSysDat = m_KcDbdhSysDat
End Property

Public Property Get KcDbdhSysTime() As String
   KcDbdhSysTime = m_KcDbdhSysTime
End Property

Public Property Get KcDbdhNo() As Double
   KcDbdhNo = m_KcDbdhNo
End Property

Public Property Let KcDbdhId(vKcDbdhId As Integer)
   m_KcDbdhId = vKcDbdhId
End Property

Public Property Let KcDbdhKey(vKcDbdhKey As Double)
   m_KcDbdhKey = vKcDbdhKey
End Property

Public Property Let KcDbdhDocno(vKcDbdhDocno As String)
   If Trim(vKcDbdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "调拨单号不能为空！"
      Exit Property
   End If
   If m_KcDbdhDocno <> vKcDbdhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM KcDbdHREC WHERE KcDbdHDOCNO='" & vKcDbdhDocno & "'")
      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_KcDbdhDocno = vKcDbdhDocno
End Property

Public Property Let KcDbdhDat(vKcDbdhDat As String)
   If Trim(vKcDbdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "调拨日期不能为空！"
      Exit Property
   End If
   m_KcDbdhDat = vKcDbdhDat
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If KcDbds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_KcDbdhId = -1 Then
      Cmd.CommandText = "{CALL KCDBDHREC_INSERT(?,?,?,?,?)}"
      Cmd(0) = m_KcDbdhDocno
      Cmd(1) = m_KcDbdhDat
      Cmd(2).Direction = adParamOutput 'KcDbdhSysDate
      Cmd(3).Direction = adParamOutput 'KcDbdhSysTime
      Cmd(4).Direction = adParamOutput 'KcDbdhNo
   Else
      Cmd.CommandText = "{CALL KcDbdhREC_UPDATE(?,?,?)}"
      Cmd(0) = m_KcDbdhNo
      Cmd(1) = m_KcDbdhDocno
      Cmd(2) = m_KcDbdhDat
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_KcDbdhId = -1 Then
      m_KcDbdhNo = Cmd(4)
   End If
   KcDbds.Save Me
   Conn.CommitTrans
   
   If m_KcDbdhId = -1 Then
      m_KcDbdhSysDat = Cmd(2)
      m_KcDbdhSysTime = Cmd(3)
      m_KcDbdhId = 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 KcDbdHREC_DELETE(?)}"
   Cmd(0) = m_KcDbdhNo
   
   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(vKcDbdhDocno As String, Optional vKcDbdhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KcDbdHDOCNO,KcDbdHDAT,KcDbdHSYSDAT,KcDbdHSYSTIME,KcDbdHNO FROM KcDbdHREC,KHREC WHERE (KcDbdHDOCNO='" & vKcDbdhDocno & "' OR KcDbdHNO=" & CStr(vKcDbdhno) & ") AND KHNO=KcDbdH_KHNO")
   If Not mRs.EOF Then
      BatchLet mRs!KcDbdhDocno, mRs!KcDbdhDat, mRs!KcDbdhSysDat, mRs!KcDbdhSysTime, mRs!KcDbdhNo
   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_KcDbdhDocno = Properties(0)
   m_KcDbdhDat = Properties(1)
   m_KcDbdhSysDat = Properties(2)
   m_KcDbdhSysTime = Properties(3)
   m_KcDbdhNo = Properties(4)

   m_KcDbdhId = 1

End Sub