cgshdh.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 = "CgShdh"
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_Kh As Kh
Dim m_CgShds As CgShds

Dim m_CgShdhType As Integer
Dim m_CgShdhDocno As String
Dim m_CgShdhDat As String
Dim m_CgShdh_KhCode As String
Dim m_CgShdh_Khno As Double
Dim m_CgShdhSysDat As String
Dim m_CgShdhSysTime As String
Dim m_CgShdhNo As Double

Dim m_CgShdhId As Integer
Dim m_CgShdhKey As Double

Private Sub Class_Initialize()
   m_CgShdhId = -1
End Sub

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

Public Property Get CgShdhId() As Integer
   CgShdhId = m_CgShdhId
End Property

Public Property Get CgShdhKey() As Double
   CgShdhKey = m_CgShdhKey
End Property

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      m_Kh.Requery "", m_CgShdh_Khno
   End If
   Set Kh = m_Kh
End Property

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

Public Property Get CgShdhType() As Integer
   CgShdhType = m_CgShdhType
End Property

Public Property Get CgShdhDocno() As String
   CgShdhDocno = m_CgShdhDocno
End Property

Public Property Get CgShdhDat() As String
   CgShdhDat = m_CgShdhDat
End Property

Public Property Get CgShdh_Khno() As Double
   CgShdh_Khno = m_CgShdh_Khno
End Property

Public Property Get CgShdhSysDat() As String
   CgShdhSysDat = m_CgShdhSysDat
End Property

Public Property Get CgShdhSysTime() As String
   CgShdhSysTime = m_CgShdhSysTime
End Property

Public Property Get CgShdhNo() As Double
   CgShdhNo = m_CgShdhNo
End Property

Public Property Let CgShdhId(vCgShdhId As Integer)
   m_CgShdhId = vCgShdhId
End Property

Public Property Let CgShdhKey(vCgShdhKey As Double)
   m_CgShdhKey = vCgShdhKey
End Property

Public Property Let CgShdhType(vCgShdhType As Integer)
   If vCgShdhType <> 1 And vCgShdhType <> 2 Then
      Err.Raise vbObjectError + 1, , "收货单类型只能为1-采购收货单，2-采购退货单！"
      Exit Property
   End If
   m_CgShdhType = vCgShdhType
End Property

Public Property Let CgShdhDocno(vCgShdhDocno As String)
   If Trim(vCgShdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "收货单号不能为空！"
      Exit Property
   End If
   If m_CgShdhDocno <> vCgShdhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM CgShdHREC WHERE CgShdHDOCNO='" & vCgShdhDocno & "'")
      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_CgShdhDocno = vCgShdhDocno
End Property

Public Property Let CgShdhDat(vCgShdhDat As String)
   If Trim(vCgShdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   m_CgShdhDat = vCgShdhDat
End Property

Public Property Let CgShdh_KhCode(vCgShdh_KhCode As String)
   If Trim(vCgShdh_KhCode) = "" Then
      Err.Raise vbObjectError + 1, , "供应商编码不能为空！"
      Exit Property
   End If
   If m_CgShdh_KhCode <> vCgShdh_KhCode Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT KHNO FROM KHREC WHERE KHCODE='" & vCgShdh_KhCode & "'")
      If Rs.EOF Then
         Rs.Close
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "录入的供应商编码不存在！"
         Exit Property
      End If
      m_CgShdh_Khno = Rs!KhNo
      Rs.Close
      Set Rs = Nothing
   End If
   m_CgShdh_KhCode = vCgShdh_KhCode
End Property

Public Sub Save()
On Error GoTo Errorhandle
      
   If CgShds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_CgShdhId = -1 Then
      Cmd.CommandText = "{CALL CgShdHREC_INSERT(?,?,?,?,?,?,?)}"
      Cmd(0) = m_CgShdhType
      Cmd(1) = m_CgShdhDocno
      Cmd(2) = m_CgShdhDat
      Cmd(3) = m_CgShdh_Khno
      Cmd(4).Direction = adParamOutput 'CgShdhSysDate
      Cmd(5).Direction = adParamOutput 'CgShdhSysTime
      Cmd(6).Direction = adParamOutput 'CgShdhNo
   Else
      Cmd.CommandText = "{CALL CgShdhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_CgShdhNo
      Cmd(1) = m_CgShdhDocno
      Cmd(2) = m_CgShdhDat
      Cmd(3) = m_CgShdh_Khno
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_CgShdhId = -1 Then
      m_CgShdhNo = Cmd(6)
   End If
   CgShds.Save Me
   Conn.CommitTrans
   
   If m_CgShdhId = -1 Then
      m_CgShdhSysDat = Cmd(4)
      m_CgShdhSysTime = Cmd(5)
      m_CgShdhId = 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 CgShdHREC_DELETE(?)}"
   Cmd(0) = m_CgShdhNo
   
   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(vCgShdhDocno As String, Optional vCgShdhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT CgShdHTYPE,CgShdHDOCNO,CgShdHDAT,CgShdH_KHCODE=KHCODE,CgShdH_KHNO,CgShdHSYSDAT,CgShdHSYSTIME,CgShdHNO FROM CgShdHREC,KHREC WHERE (CgShdHDOCNO='" & vCgShdhDocno & "' OR CgShdHNO=" & CStr(vCgShdhno) & ") AND KHNO=CgShdH_KHNO")
   If Not mRs.EOF Then
      BatchLet mRs!CgShdhType, mRs!CgShdhDocno, mRs!CgShdhDat, mRs!CgShdh_KhCode, mRs!CgShdh_Khno, mRs!CgShdhSysDat, mRs!CgShdhSysTime, mRs!CgShdhNo
   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_CgShdhType = Properties(0)
   m_CgShdhDocno = Properties(1)
   m_CgShdhDat = Properties(2)
   m_CgShdh_KhCode = Properties(3)
   m_CgShdh_Khno = Properties(4)
   m_CgShdhSysDat = Properties(5)
   m_CgShdhSysTime = Properties(6)
   m_CgShdhNo = Properties(7)

   m_CgShdhId = 1

End Sub