xssodh.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 = "XsSodh"
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_XsSods As XsSods

Dim m_XsSodhDocno As String
Dim m_XsSodhDat As String
Dim m_XsSodh_KhCode As String
Dim m_XsSodh_Khno As Double
Dim m_XsSodhSysDat As String
Dim m_XsSodhSysTime As String
Dim m_XsSodhNo As Double

Dim m_XsSodhId As Integer
Dim m_XsSodhKey As Double

Private Sub Class_Initialize()
   m_XsSodhId = -1
End Sub

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

Public Property Get XsSodhId() As Integer
   XsSodhId = m_XsSodhId
End Property

Public Property Get XsSodhKey() As Double
   XsSodhKey = m_XsSodhKey
End Property

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

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

Public Property Get XsSodhDocno() As String
   XsSodhDocno = m_XsSodhDocno
End Property

Public Property Get XsSodhDat() As String
   XsSodhDat = m_XsSodhDat
End Property

Public Property Get XsSodh_Khno() As Double
   XsSodh_Khno = m_XsSodh_Khno
End Property

Public Property Get XsSodhSysDat() As String
   XsSodhSysDat = m_XsSodhSysDat
End Property

Public Property Get XsSodhSysTime() As String
   XsSodhSysTime = m_XsSodhSysTime
End Property

Public Property Get XsSodhNo() As Double
   XsSodhNo = m_XsSodhNo
End Property

Public Property Let XsSodhId(vXsSodhId As Integer)
   m_XsSodhId = vXsSodhId
End Property

Public Property Let XsSodhKey(vXsSodhKey As Double)
   m_XsSodhKey = vXsSodhKey
End Property

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

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

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

Public Sub Save()
On Error GoTo Errorhandle
      
   If XsSods.Count = 0 Then
      On Error GoTo 0
      Err.Raise vbObjectError + 1, , "单据无明细行，不能存盘！"
      Exit Sub
   End If
      
   If m_XsSodhId = -1 Then
      Cmd.CommandText = "{CALL XSSODHREC_INSERT(?,?,?,?,?,?)}"
      Cmd(0) = m_XsSodhDocno
      Cmd(1) = m_XsSodhDat
      Cmd(2) = m_XsSodh_Khno
      Cmd(3).Direction = adParamOutput 'XssodhSysDate
      Cmd(4).Direction = adParamOutput 'XssodhSysTime
      Cmd(5).Direction = adParamOutput 'XssodhNo
   Else
      Cmd.CommandText = "{CALL XsSodhREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_XsSodhNo
      Cmd(1) = m_XsSodhDocno
      Cmd(2) = m_XsSodhDat
      Cmd(3) = m_XsSodh_Khno
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   If m_XsSodhId = -1 Then
      m_XsSodhNo = Cmd(5)
   End If
   XsSods.Save Me
   Conn.CommitTrans
   
   If m_XsSodhId = -1 Then
      m_XsSodhSysDat = Cmd(3)
      m_XsSodhSysTime = Cmd(4)
      m_XsSodhId = 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 XSSODHREC_DELETE(?)}"
   Cmd(0) = m_XsSodhNo
   
   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(vXsSodhDocno As String, Optional vXsSodhno As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT XSSODHDOCNO,XSSODHDAT,XSSODH_KHCODE=KHCODE,XSSODH_KHNO,XSSODHSYSDAT,XSSODHSYSTIME,XSSODHNO FROM XSSODHREC,KHREC WHERE (XSSODHDOCNO='" & vXsSodhDocno & "' OR XSSODHNO=" & CStr(vXsSodhno) & ") AND KHNO=XSSODH_KHNO")
   If Not mRs.EOF Then
      BatchLet mRs!XsSodhDocno, mRs!XsSodhDat, mRs!XsSodh_KhCode, mRs!XsSodh_Khno, mRs!XsSodhSysDat, mRs!XsSodhSysTime, mRs!XsSodhNo
   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_XsSodhDocno = Properties(0)
   m_XsSodhDat = Properties(1)
   m_XsSodh_KhCode = Properties(2)
   m_XsSodh_Khno = Properties(3)
   m_XsSodhSysDat = Properties(4)
   m_XsSodhSysTime = Properties(5)
   m_XsSodhNo = Properties(6)

   m_XsSodhId = 1

End Sub