arskd.cls

来自「制造业产供销与往来系统源码」· CLS 代码 · 共 456 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ArSkd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim m_Kh As Kh
Dim m_CwBz As CwBz
Dim m_CwQj As CwQj

Dim m_CwZh As CwZh

Dim m_ArSkdDocno As String
Dim m_ArSkdDat As String

Dim m_ArSkd_CwqjCode As String
Dim m_ArSkd_CwqjNo As Double

Dim m_ArSkd_KhCode As String
Dim m_ArSkd_Khno As Double

Dim m_ArSkd_CwZhMc As String
Dim m_ArSkd_CwZhno As Double

Dim m_ArSkd_CwBzCode As String
Dim m_ArSkd_CwBzno As Double
Dim m_ArSkd_CwBzConv As Double

Dim m_ArSkdAmt As Double
Dim m_ArSkdBz As String

Dim m_ArSkdForm As String

Dim m_ArSkd_ArSkMxno As Double
Dim m_ArSkd_ArApno As Double

Dim m_ArSkdNo As Double

Dim m_ArSkdId As Integer
Dim m_ArSkdKey As Double

Private Sub Class_Initialize()
   m_ArSkdId = -1
End Sub

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

Public Property Get Kh() As Kh
   If m_Kh Is Nothing Then
      Set m_Kh = New Kh
      If m_ArSkd_KhCode <> "" Then
         m_Kh.Requery m_ArSkd_KhCode
      End If
   End If
   Set Kh = m_Kh
End Property

Public Property Get CwQj() As CwQj
   If m_CwQj Is Nothing Then
      Set m_CwQj = New CwQj
      If m_ArSkd_CwqjCode <> "" Then
         m_CwQj.Requery m_ArSkd_CwqjCode
      End If
   End If
   Set CwQj = m_CwQj
End Property

Public Property Get CwBz() As CwBz
   If m_CwBz Is Nothing Then
      Set m_CwBz = New CwBz
      If m_ArSkd_CwBzCode <> "" Then
         m_CwBz.Requery m_ArSkd_CwBzCode
      End If
   End If
   Set CwBz = m_CwBz
End Property

Public Property Get CwZh() As CwZh
   If m_CwZh Is Nothing Then
      Set m_CwZh = New CwZh
      If m_ArSkd_CwZhMc <> "" Then
         m_CwZh.Requery m_ArSkd_CwZhMc
      End If
   End If
   Set CwZh = m_CwZh
End Property

Public Property Get ArSkdId() As Integer
   ArSkdId = m_ArSkdId
End Property

Public Property Get ArSkdKey() As Double
   ArSkdKey = m_ArSkdKey
End Property

Public Property Get ArSkdDocno() As String
   ArSkdDocno = m_ArSkdDocno
End Property

Public Property Get ArSkdDat() As String
   ArSkdDat = m_ArSkdDat
End Property

Public Property Get ArSkd_CwQjCode() As String
   ArSkd_CwQjCode = m_ArSkd_CwqjCode
End Property

Public Property Get ArSkd_CwqjNo() As Double
   ArSkd_CwqjNo = m_ArSkd_CwqjNo
End Property

Public Property Get ArSkd_KhCode() As String
   ArSkd_KhCode = m_ArSkd_KhCode
End Property

Public Property Get ArSkd_Khno() As Double
   ArSkd_Khno = m_ArSkd_Khno
End Property

Public Property Get ArSkd_CwZhMc() As String
   ArSkd_CwZhMc = m_ArSkd_CwZhMc
End Property

Public Property Get ArSkd_CwZhno() As Double
   ArSkd_CwZhno = m_ArSkd_CwZhno
End Property

Public Property Get ArSkd_CwBzCode() As String
   ArSkd_CwBzCode = m_ArSkd_CwBzCode
End Property

Public Property Get ArSkd_CwBzno() As Double
   ArSkd_CwBzno = m_ArSkd_CwBzno
End Property

Public Property Get ArSkd_CwBzConv() As Double
   ArSkd_CwBzConv = m_ArSkd_CwBzConv
End Property

Public Property Get ArSkdAmt() As Double
   ArSkdAmt = m_ArSkdAmt
End Property

Public Property Get ArSkdBz() As String
   ArSkdBz = m_ArSkdBz
End Property

Public Property Get ArSkdForm() As String
   ArSkdForm = m_ArSkdForm
End Property

Public Property Get ArSkd_ArSkMxno() As Double
   ArSkd_ArSkMxno = m_ArSkd_ArSkMxno
End Property

Public Property Get ArSkd_ArApno() As Double
   ArSkd_ArApno = m_ArSkd_ArApno
End Property

Public Property Get ArSkdNo() As Double
   ArSkdNo = m_ArSkdNo
End Property

Public Property Let ArSkdId(vArSkdId As Integer)
   m_ArSkdId = vArSkdId
End Property

Public Property Let ArSkdKey(vArSkdKey As Double)
   m_ArSkdKey = vArSkdKey
End Property

Public Property Let ArSkdDocno(vArSkdDocno As String)

   If Trim(vArSkdDocno) = "" Then
      Err.Raise vbObjectError + 1, , "单据编号不能为空！"
      Exit Property
   End If
   
   If m_ArSkdDocno <> vArSkdDocno Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM ArSkdREC WHERE ArSkdDOCNO='" & vArSkdDocno & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "单据编号已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   
   m_ArSkdDocno = vArSkdDocno
   
End Property

Public Property Let ArSkdDat(vArSkdDat As String)

   If Trim(vArSkdDat) = "" Then
      Err.Raise vbObjectError + 1, , "收货日期不能为空！"
      Exit Property
   End If
   
   m_ArSkd_CwqjCode = gPublicFunction.GetCwqjCode(vArSkdDat)
   CwQj.Requery m_ArSkd_CwqjCode
   m_ArSkd_CwqjNo = CwQj.CwQjNo
   m_ArSkdDat = vArSkdDat
   
End Property

Public Property Let ArSkd_KhCode(vArSkd_KhCode As String)

   If Trim(vArSkd_KhCode) = "" Then
      Err.Raise vbObjectError + 1, , "客户编码不能为空！"
      Exit Property
   End If
   
   If m_ArSkd_KhCode <> vArSkd_KhCode Then
      If Kh.Requery(vArSkd_KhCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的客户编码不存在！"
         Exit Property
      End If
      m_ArSkd_Khno = Kh.KhNo
      m_ArSkd_CwBzCode = Kh.Kh_CwBzCode
      m_ArSkd_CwBzno = Kh.Kh_CwBzno
   End If
   
   m_ArSkd_KhCode = vArSkd_KhCode
   
End Property

Public Property Let ArSkd_CwQjCode(vArSkd_CwQjCode As String)

   If Trim(vArSkd_CwQjCode) = "" Then
      Err.Raise vbObjectError + 1, , "录入的财务月份不能为空！"
      Exit Property
   End If
   
   If m_ArSkd_CwqjCode <> vArSkd_CwQjCode Then
      If CwQj.Requery(vArSkd_CwQjCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的财务月份不存在！"
         Exit Property
      End If
      m_ArSkd_CwqjNo = CwQj.CwQjNo
   End If
   
   m_ArSkd_CwqjCode = vArSkd_CwQjCode
   
End Property

Public Property Let ArSkd_CwZhMc(vArSkd_CwZhMc As String)

   If Trim(vArSkd_CwZhMc) = "" Then
      Err.Raise vbObjectError + 1, , "录入的现金银行账号不能为空！"
      Exit Property
   End If
   
   If m_ArSkd_CwZhMc <> vArSkd_CwZhMc Then
      If CwZh.Requery(vArSkd_CwZhMc) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的现金银行账号不存在！"
         Exit Property
      End If
      m_ArSkd_CwZhno = CwZh.CwZhNo
   End If
   
   m_ArSkd_CwZhMc = vArSkd_CwZhMc
   
End Property

Public Property Let ArSkd_CwBzCode(vArSkd_CwBzCode As String)

   If Trim(vArSkd_CwBzCode) = "" Then
      Err.Raise vbObjectError + 1, , "录入的币种不能为空！"
      Exit Property
   End If
   
   If m_ArSkd_CwBzCode <> vArSkd_CwBzCode Then
      If CwBz.Requery(vArSkd_CwBzCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的币种编码不存在！"
         Exit Property
      End If
      m_ArSkd_CwBzno = CwBz.CwbzNo
   End If
   
   m_ArSkd_CwBzCode = vArSkd_CwBzCode
   
End Property

Public Property Let ArSkdAmt(vArSkdAmt As Double)
   m_ArSkdAmt = vArSkdAmt
End Property

Public Property Let ArSkdBz(vArSkdBz As String)
   m_ArSkdBz = vArSkdBz
End Property

Public Property Let ArSkdForm(vArSkdForm As String)
   m_ArSkdForm = vArSkdForm
End Property

Public Sub Save()
   Dim Cmd As ADODB.Command
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If m_ArSkdId = -1 Then
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArSkdREC_INSERT", 13)
      Cmd(0) = m_ArSkdDocno
      Cmd(1) = m_ArSkdDat
      Cmd(2) = m_ArSkd_CwqjNo
      Cmd(3) = m_ArSkd_Khno
      Cmd(4) = m_ArSkd_CwZhno
      Cmd(5) = m_ArSkd_CwBzno
      Cmd(6) = m_ArSkd_CwBzConv
      Cmd(7) = m_ArSkdAmt
      Cmd(8) = m_ArSkdBz
      Cmd(9) = m_ArSkdForm
      Cmd(10).Direction = adParamOutput   'ArSkd_ArSkMxno
      Cmd(11).Direction = adParamOutput   'ArSkd_ArApNo
      Cmd(12).Direction = adParamOutput      'ArSkdNo
   Else
      Cmd.CommandText = gPublicFunction.GetCallSPString("ArSkdREC_UPDATE", 10)
      Cmd(0) = m_ArSkdNo
      Cmd(1) = m_ArSkdDocno
      Cmd(2) = m_ArSkdDat
      Cmd(3) = m_ArSkd_CwqjNo
      Cmd(4) = m_ArSkd_Khno
      Cmd(5) = m_ArSkd_CwZhno
      Cmd(6) = m_ArSkd_CwBzno
      Cmd(7) = m_ArSkd_CwBzConv
      Cmd(8) = m_ArSkdAmt
      Cmd(9) = m_ArSkdBz
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   If m_ArSkdId = -1 Then
      m_ArSkd_ArSkMxno = Cmd(10)
      m_ArSkd_ArApno = Cmd(11)
      m_ArSkdNo = Cmd(12)
   End If
   gDbCommon.Conn.CommitTrans
   
   If m_ArSkdId = -1 Then
      m_ArSkdId = 1
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Sub Del(Optional mMxDel As Integer = 0)
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "ARSKDREC", "ARSKDNO", CStr(m_ArSkdNo)
   
On Error GoTo Errorhandle
      
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{CALL ArSkdREC_DELETE(?)}"
   Cmd(0) = m_ArSkdNo
   
   If mMxDel = 0 Then
      gDbCommon.Conn.BeginTrans
   End If
   Cmd.Execute
   If mMxDel = 0 Then
      gDbCommon.Conn.CommitTrans
   End If
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   If mMxDel = 0 Then
      gDbCommon.Conn.RollbackTrans
   End If
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(Optional vArSkdDocno As String = "", Optional vArSkdno As Double = 0) As Integer
   Dim mRs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle

   Requery = -1
   
   mSqlStr = "SELECT ArSkdDOCNO,ArSkdDAT,ArSkd_KHCODE=COALESCE((SELECT KHCODE FROM KHREC WHERE KHNO=ArSkd_KHNO),''),ArSkd_KHNO,"
   mSqlStr = mSqlStr & "ArSkd_CwQjCode=COALESCE((SELECT CWQJCODE FROM CWQJREC WHERE CWQJNO=ArSkd_CwQjno),''),ArSkd_CwQjno,"
   mSqlStr = mSqlStr & "ArSkd_CwZhMc=COALESCE((SELECT CwZhMc FROM CwZhREC WHERE CwZhNO=ArSkd_CwZhno),''),ArSkd_CwZhno,"
   mSqlStr = mSqlStr & "ArSkd_CwBzCode=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=ArSkd_CwBzno),''),ArSkd_CwBzno,ArSkd_CWBZCONV,ArSkdAMT,ArSkdBZ,"
   mSqlStr = mSqlStr & "ArSkdFORM,ArSkd_ArSkMxno,ArSkd_ARAPNO,ArSkdNO FROM ArSkdREC WHERE (ArSkdDOCNO='" & vArSkdDocno & "' OR ArSkdNO=" & CStr(vArSkdno) & ") "
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   If Not mRs.EOF Then
      Requery = 1
      BatchLet mRs!ArSkdDocno, mRs!ArSkdDat, mRs!ArSkd_CwQjCode, mRs!ArSkd_CwqjNo, mRs!ArSkd_KhCode, mRs!ArSkd_Khno, mRs!ArSkd_CwZhMc, mRs!ArSkd_CwZhno, mRs!ArSkd_CwBzCode, mRs!ArSkd_CwBzno, mRs!ArSkd_CwBzConv, mRs!ArSkdAmt, mRs!ArSkdBz, mRs!ArSkdForm, mRs!ArSkd_ArSkMxno, mRs!ArSkd_ArApno, mRs!ArSkdNo
   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_ArSkdDocno = Properties(0)
   m_ArSkdDat = Properties(1)
   m_ArSkd_CwqjCode = Properties(2)
   m_ArSkd_CwqjNo = Properties(3)
   m_ArSkd_KhCode = Properties(4)
   m_ArSkd_Khno = Properties(5)
   m_ArSkd_CwZhMc = Properties(6)
   m_ArSkd_CwZhno = Properties(7)
   m_ArSkd_CwBzCode = Properties(8)
   m_ArSkd_CwBzno = Properties(9)
   m_ArSkd_CwBzConv = Properties(10)
   m_ArSkdAmt = Properties(11)
   m_ArSkdBz = Properties(12)
   m_ArSkdForm = Properties(13)
   m_ArSkd_ArSkMxno = Properties(14)
   m_ArSkd_ArApno = Properties(15)
   m_ArSkdNo = Properties(16)

   m_ArSkdId = 1

End Sub