cgpodh.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 = "CgPodh"
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_CgPods As CgPods

Dim m_CgPodhDocno As String
Dim m_CgPodhDat As String
Dim m_CgPodh_KhCode As String
Dim m_CgPodh_Khno As Double
Dim m_CgPodhSysDat As String
Dim m_CgPodhSysTime As String
Dim m_CgPodhNo As Double

Dim m_CgPodhId As Integer
Dim m_CgPodhKey As Double

Private Sub Class_Initialize()
   m_CgPodhId = -1
End Sub

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

Public Property Get CgPodhId() As Integer
   CgPodhId = m_CgPodhId
End Property

Public Property Get CgPodhKey() As Double
   CgPodhKey = m_CgPodhKey
End Property

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

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

Public Property Get CgPodhDocno() As String
   CgPodhDocno = m_CgPodhDocno
End Property

Public Property Get CgPodhDat() As String
   CgPodhDat = m_CgPodhDat
End Property

Public Property Get CgPodh_Khno() As Double
   CgPodh_Khno = m_CgPodh_Khno
End Property

Public Property Get CgPodhSysDat() As String
   CgPodhSysDat = m_CgPodhSysDat
End Property

Public Property Get CgPodhSysTime() As String
   CgPodhSysTime = m_CgPodhSysTime
End Property

Public Property Get CgPodhNo() As Double
   CgPodhNo = m_CgPodhNo
End Property

Public Property Let CgPodhId(vCgPodhId As Integer)
   m_CgPodhId = vCgPodhId
End Property

Public Property Let CgPodhKey(vCgPodhKey As Double)
   m_CgPodhKey = vCgPodhKey
End Property

Public Property Let CgPodhDocno(vCgPodhDocno As String)
   If Trim(vCgPodhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "订单编号不能为空！"
      Exit Property
   End If
   If m_CgPodhDocno <> vCgPodhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM CgPodHREC WHERE CgPodHDOCNO='" & vCgPodhDocno & "'")
      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_CgPodhDocno = vCgPodhDocno
End Property

Public Property Let CgPodhDat(vCgPodhDat As String)
   If Trim(vCgPodhDat) = "" Then
      Err.Raise vbObjectError + 1, , "订单日期不能为空！"
      Exit Property
   End If
   m_CgPodhDat = vCgPodhDat
End Property

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

Public Sub Save()
On Error GoTo Errorhandle
      
   If CgPods.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_CgPodhId = -1 Then
      Cmd.CommandText = "{CALL CgPodHREC_INSERT(?,?,?,?,?,?)}"
      Cmd(0) = m_CgPodhDocno
      Cmd(1) = m_CgPodhDat
      Cmd(2) = m_CgPodh_Khno
      Cmd(3).Direction = adParamOutput 'CgPodhSysDate
      Cmd(4).Direction = adParamOutput 'CgPodhSysTime
      Cmd(5).Direction = adParamOutput 'CgPodhNo
   Else
      Cmd.CommandText = "{CALL CgPodhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_CgPodhNo
      Cmd(1) = m_CgPodhDocno
      Cmd(2) = m_CgPodhDat
      Cmd(3) = m_CgPodh_Khno
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_CgPodhId = -1 Then
      m_CgPodhNo = Cmd(5)
   End If
   CgPods.Save Me
   Conn.CommitTrans
   
   If m_CgPodhId = -1 Then
      m_CgPodhSysDat = Cmd(3)
      m_CgPodhSysTime = Cmd(4)
      m_CgPodhId = 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 CgPodHREC_DELETE(?)}"
   Cmd(0) = m_CgPodhNo
   
   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(vCgPodhDocno As String, Optional vCgPodhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT CgPodHDOCNO,CgPodHDAT,CgPodH_KHCODE=KHCODE,CgPodH_KHNO,CgPodHSYSDAT,CgPodHSYSTIME,CgPodHNO FROM CgPodHREC,KHREC WHERE (CgPodHDOCNO='" & vCgPodhDocno & "' OR CgPodHNO=" & CStr(vCgPodhno) & ") AND KHNO=CgPodH_KHNO")
   If Not mRs.EOF Then
      BatchLet mRs!CgPodhDocno, mRs!CgPodhDat, mRs!CgPodh_KhCode, mRs!CgPodh_Khno, mRs!CgPodhSysDat, mRs!CgPodhSysTime, mRs!CgPodhNo
   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_CgPodhDocno = Properties(0)
   m_CgPodhDat = Properties(1)
   m_CgPodh_KhCode = Properties(2)
   m_CgPodh_Khno = Properties(3)
   m_CgPodhSysDat = Properties(4)
   m_CgPodhSysTime = Properties(5)
   m_CgPodhNo = Properties(6)

   m_CgPodhId = 1

End Sub