xsfhdh.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 = "XsFhdh"
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_XsFhds As XsFhds

Dim m_XsFhdhType As Integer
Dim m_XsFhdhDocno As String
Dim m_XsFhdhDat As String
Dim m_XsFhdh_KhCode As String
Dim m_XsFhdh_Khno As Double
Dim m_XsFhdhSysDat As String
Dim m_XsFhdhSysTime As String
Dim m_XsFhdhNo As Double

Dim m_XsFhdhId As Integer
Dim m_XsFhdhKey As Double

Private Sub Class_Initialize()
   m_XsFhdhId = -1
End Sub

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

Public Property Get XsFhdhId() As Integer
   XsFhdhId = m_XsFhdhId
End Property

Public Property Get XsFhdhKey() As Double
   XsFhdhKey = m_XsFhdhKey
End Property

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

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

Public Property Get XsFhdhType() As Integer
   XsFhdhType = m_XsFhdhType
End Property

Public Property Get XsFhdhDocno() As String
   XsFhdhDocno = m_XsFhdhDocno
End Property

Public Property Get XsFhdhDat() As String
   XsFhdhDat = m_XsFhdhDat
End Property

Public Property Get XsFhdh_Khno() As Double
   XsFhdh_Khno = m_XsFhdh_Khno
End Property

Public Property Get XsFhdhSysDat() As String
   XsFhdhSysDat = m_XsFhdhSysDat
End Property

Public Property Get XsFhdhSysTime() As String
   XsFhdhSysTime = m_XsFhdhSysTime
End Property

Public Property Get XsFhdhNo() As Double
   XsFhdhNo = m_XsFhdhNo
End Property

Public Property Let XsFhdhId(vXsFhdhId As Integer)
   m_XsFhdhId = vXsFhdhId
End Property

Public Property Let XsFhdhKey(vXsFhdhKey As Double)
   m_XsFhdhKey = vXsFhdhKey
End Property

Public Property Let XsFhdhType(vXsFhdhType As Integer)
   If vXsFhdhType <> 1 And vXsFhdhType <> 2 Then
      Err.Raise vbObjectError + 1, , "发货单类型只能为1-销售发货单，2-销售退货单！"
      Exit Property
   End If
   m_XsFhdhType = vXsFhdhType
End Property

Public Property Let XsFhdhDocno(vXsFhdhDocno As String)
   If Trim(vXsFhdhDocno) = "" Then
      Err.Raise vbObjectError + 1, , "发货单号不能为空！"
      Exit Property
   End If
   If m_XsFhdhDocno <> vXsFhdhDocno Then
      Dim Rs As ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM XsFhdHREC WHERE XsFhdHDOCNO='" & vXsFhdhDocno & "'")
      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_XsFhdhDocno = vXsFhdhDocno
End Property

Public Property Let XsFhdhDat(vXsFhdhDat As String)
   If Trim(vXsFhdhDat) = "" Then
      Err.Raise vbObjectError + 1, , "发货日期不能为空！"
      Exit Property
   End If
   m_XsFhdhDat = vXsFhdhDat
End Property

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

Public Sub Save()
On Error GoTo Errorhandle
      
   If XsFhds.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_XsFhdhId = -1 Then
      Cmd.CommandText = "{CALL XsFhdHREC_INSERT(?,?,?,?,?,?,?)}"
      Cmd(0) = m_XsFhdhType
      Cmd(1) = m_XsFhdhDocno
      Cmd(2) = m_XsFhdhDat
      Cmd(3) = m_XsFhdh_Khno
      Cmd(4).Direction = adParamOutput 'XsFhdhSysDate
      Cmd(5).Direction = adParamOutput 'XsFhdhSysTime
      Cmd(6).Direction = adParamOutput 'XsFhdhNo
   Else
      Cmd.CommandText = "{CALL XsFhdhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_XsFhdhNo
      Cmd(1) = m_XsFhdhDocno
      Cmd(2) = m_XsFhdhDat
      Cmd(3) = m_XsFhdh_Khno
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_XsFhdhId = -1 Then
      m_XsFhdhNo = Cmd(6)
   End If
   XsFhds.Save Me
   Conn.CommitTrans
   
   If m_XsFhdhId = -1 Then
      m_XsFhdhSysDat = Cmd(4)
      m_XsFhdhSysTime = Cmd(5)
      m_XsFhdhId = 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 XsFhdHREC_DELETE(?)}"
   Cmd(0) = m_XsFhdhNo
   
   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(vXsFhdhDocno As String, Optional vXsFhdhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT XSFHDHTYPE,XsFhdHDOCNO,XsFhdHDAT,XsFhdH_KHCODE=KHCODE,XsFhdH_KHNO,XsFhdHSYSDAT,XsFhdHSYSTIME,XsFhdHNO FROM XsFhdHREC,KHREC WHERE (XsFhdHDOCNO='" & vXsFhdhDocno & "' OR XsFhdHNO=" & CStr(vXsFhdhno) & ") AND KHNO=XsFhdH_KHNO")
   If Not mRs.EOF Then
      BatchLet mRs!XsFhdhType, mRs!XsFhdhDocno, mRs!XsFhdhDat, mRs!XsFhdh_KhCode, mRs!XsFhdh_Khno, mRs!XsFhdhSysDat, mRs!XsFhdhSysTime, mRs!XsFhdhNo
   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_XsFhdhType = Properties(0)
   m_XsFhdhDocno = Properties(1)
   m_XsFhdhDat = Properties(2)
   m_XsFhdh_KhCode = Properties(3)
   m_XsFhdh_Khno = Properties(4)
   m_XsFhdhSysDat = Properties(5)
   m_XsFhdhSysTime = Properties(6)
   m_XsFhdhNo = Properties(7)

   m_XsFhdhId = 1

End Sub