kh.cls

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

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

Dim m_CwBz As CwBz
Dim m_CwSm As CwSm

Dim m_KhType As Integer
Dim m_KhCode As String
Dim m_KhMc As String
Dim m_KhTel As String
Dim m_KhFax As String
Dim m_KhEmail As String
Dim m_KhWww As String
Dim m_KhAdd As String
Dim m_KhPCode As String
Dim m_KhLinkMan As String

Dim m_Kh_CwBzNo As Double
Dim m_Kh_CwBzCode As String

Dim m_Kh_CwSmNo As Double
Dim m_Kh_CwSmCode As String

Dim m_KhIsStop As Integer
Dim m_KhNo As Double

Dim m_KhId As Integer
Dim m_KhKey As Integer

Private Sub Class_Initialize()
   m_KhId = -1
End Sub

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

Public Property Get KhId() As Integer
   KhId = m_KhId
End Property

Public Property Get KhKey() As Integer
   KhKey = m_KhKey
End Property

Public Property Get CwBz() As CwBz

   If m_CwBz Is Nothing Then
      Set m_CwBz = New CwBz
      If m_Kh_CwBzCode <> "" Then
         m_CwBz.Requery m_Kh_CwBzCode
      End If
   End If
   
   Set CwBz = m_CwBz

End Property

Public Property Get CwSm() As CwSm

   If m_CwSm Is Nothing Then
      Set m_CwSm = New CwSm
      If m_Kh_CwSmCode <> "" Then
         m_CwSm.Requery m_Kh_CwSmCode
      End If
   End If
   
   Set CwSm = m_CwSm

End Property

Public Property Get KhType() As Integer
   KhType = m_KhType
End Property

Public Property Get KhCode() As String
   KhCode = m_KhCode
End Property

Public Property Get KhMc() As String
   KhMc = m_KhMc
End Property

Public Property Get KhTel() As String
   KhTel = m_KhTel
End Property

Public Property Get KhFax() As String
   KhFax = m_KhFax
End Property

Public Property Get KhEmail() As String
   KhEmail = m_KhEmail
End Property

Public Property Get KhWww() As String
   KhWww = m_KhWww
End Property

Public Property Get KhAdd() As String
   KhAdd = m_KhAdd
End Property

Public Property Get KhPCode() As String
   KhPCode = m_KhPCode
End Property

Public Property Get KhLinkMan() As String
   KhLinkMan = m_KhLinkMan
End Property

Public Property Get Kh_CwBzno() As Double
   Kh_CwBzno = m_Kh_CwBzNo
End Property

Public Property Get Kh_CwBzCode() As String
   Kh_CwBzCode = m_Kh_CwBzCode
End Property

Public Property Get Kh_CwSmno() As Double
   Kh_CwSmno = m_Kh_CwSmNo
End Property

Public Property Get Kh_CwSmCode() As String
   Kh_CwSmCode = m_Kh_CwSmCode
End Property

Public Property Get KhIsStop() As Integer
   KhIsStop = m_KhIsStop
End Property

Public Property Get KhNo() As Double
   KhNo = m_KhNo
End Property

Public Property Let KhId(vKhId As Integer)
   m_KhId = vKhId
End Property

Public Property Let KhKey(vKhKey As Integer)
   m_KhKey = vKhKey
End Property

Public Property Let KhType(vKhType As Integer)
   If vKhType <> 1 And vKhType <> 2 Then
      Err.Raise vbObjectError + 1, , "单位类型只能为1-客户，2-供应商！"
      Exit Property
   End If
   m_KhType = vKhType
End Property

Public Property Let KhCode(vKhCode As String)
   If Trim(vKhCode) = "" Then
      Err.Raise vbObjectError + 1, , "客户或供应商编码不能为空！"
      Exit Property
   End If
   If m_KhCode <> vKhCode Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM KhREC WHERE KhCode='" & vKhCode & "'"
      Rs.MoveFirst
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "客户或供应商编码已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   m_KhCode = vKhCode
End Property

Public Property Let KhMc(vKhMc As String)
   If Trim(vKhMc) = "" Then
      Err.Raise vbObjectError + 1, , "客户或供应商名称不能为空！"
      Exit Property
   End If
   If m_KhMc <> vKhMc Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.MoveFirst
      Rs.Fillbydb "SELECT * FROM KhREC WHERE KhMc='" & vKhMc & "'"
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "客户或供应商名称已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   m_KhMc = vKhMc
End Property

Public Property Let KhTel(vKhTel As String)
   m_KhTel = Trim(vKhTel)
End Property

Public Property Let KhFax(vKhFax As String)
   m_KhFax = vKhFax
End Property

Public Property Let KhEmail(vKhEmail As String)
   m_KhEmail = vKhEmail
End Property

Public Property Let KhWww(vKhWww As String)
   m_KhWww = vKhWww
End Property

Public Property Let KhAdd(vKhAdd As String)
   m_KhAdd = vKhAdd
End Property

Public Property Let KhPCode(vKhPcode As String)
   m_KhPCode = vKhPcode
End Property

Public Property Let KhLinkMan(vKhLinkMan As String)
   m_KhLinkMan = vKhLinkMan
End Property

Public Property Let Kh_CwBzCode(vKh_CwBzCode As String)
   If vKh_CwBzCode = "" Then
      Err.Raise vbObjectError + 1, , "默认币种不能为空!"
      Exit Property
   End If
   If m_Kh_CwBzCode <> vKh_CwBzCode Then
      If CwBz.Requery(vKh_CwBzCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的币种不存在!"
         Exit Property
      End If
      m_Kh_CwBzNo = CwBz.CwbzNo
   End If
   m_Kh_CwBzCode = vKh_CwBzCode
End Property

Public Property Let Kh_CwSmCode(vKh_CwSmCode As String)
   If vKh_CwSmCode = "" Then
      Err.Raise vbObjectError + 1, , "默认税码不能为空!"
      Exit Property
   End If
   If m_Kh_CwSmCode <> vKh_CwSmCode Then
      If CwSm.Requery(vKh_CwSmCode) = -1 Then
         Err.Raise vbObjectError + 1, , "录入的税码不存在!"
         Exit Property
      End If
      m_Kh_CwSmNo = CwSm.CwsmNo
   End If
   m_Kh_CwSmCode = vKh_CwSmCode
End Property

Public Property Let KhIsStop(vKhIsStop As Integer)
   If vKhIsStop <> 0 And vKhIsStop <> 1 Then
      Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
      Exit Property
   End If
   m_KhIsStop = vKhIsStop
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_KhId = -1 Then
      Cmd.CommandText = "{CALL KhREC_INSERT(?,?,?,?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KhType
      Cmd(1) = m_KhCode
      Cmd(2) = m_KhMc
      Cmd(3) = m_KhTel
      Cmd(4) = m_KhFax
      Cmd(5) = m_KhEmail
      Cmd(6) = m_KhWww
      Cmd(7) = m_KhAdd
      Cmd(8) = m_KhPCode
      Cmd(9) = m_KhLinkMan
      Cmd(10) = m_Kh_CwBzNo
      Cmd(11) = m_Kh_CwSmNo
      Cmd(12) = m_KhIsStop
      Cmd(13).Direction = adParamOutput
   Else
      Cmd.CommandText = "{CALL KhREC_UPDATE(?,?,?,?,?,?,?,?,?,?,?,?,?)}"
      Cmd(0) = m_KhNo
      Cmd(1) = m_KhCode
      Cmd(2) = m_KhMc
      Cmd(3) = m_KhTel
      Cmd(4) = m_KhFax
      Cmd(5) = m_KhEmail
      Cmd(6) = m_KhWww
      Cmd(7) = m_KhAdd
      Cmd(8) = m_KhPCode
      Cmd(9) = m_KhLinkMan
      Cmd(10) = m_Kh_CwBzNo
      Cmd(11) = m_Kh_CwSmNo
      Cmd(12) = m_KhIsStop
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   If m_KhId = -1 Then
      m_KhNo = Cmd(13)
      m_KhId = 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()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "KHREC", "KHNO", CStr(m_KhNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL KhREC_DELETE(?)}"
   Cmd(0) = m_KhNo
   
  gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   Set Cmd = Nothing
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(vKhCode As String, Optional vKhNo As Double = 0) As Integer
   Dim Rs As DbRs
   Dim mSqlStr As String
On Error GoTo Errorhandle
   
   mSqlStr = "SELECT KHTYPE,KhCODE,KhMC,KhTel,KHFAX,KHEMAIL,KHWWW,KHADD,KHPCODE,KHLINKMAN,"
   mSqlStr = mSqlStr & "KH_CWBZCODE=COALESCE((SELECT CWBZCODE FROM CWBZREC WHERE CWBZNO=KH_CWBZNO),''),KH_CWBZNO,"
   mSqlStr = mSqlStr & "KH_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=KH_CWSMNO),''),KH_CWSMNO,"
   mSqlStr = mSqlStr & "KhISSTOP,KhNO FROM KhREC WHERE (KhCODE='" & vKhCode & "' OR KHNO=" & CStr(vKhNo) & ")"
   
   Requery = -1
   Set Rs = New DbRs
   Rs.MoveFirst
   Rs.Fillbydb mSqlStr
   
   If Not Rs.EOF Then
      BatchLet Rs!KhType, Rs!KhCode, Rs!KhMc, Rs!KhTel, Rs!KhFax, Rs!KhEmail, Rs!KhWww, Rs!KhAdd, Rs!KhPCode, Rs!KhLinkMan, Rs!Kh_CwBzCode, Rs!Kh_CwBzno, Rs!Kh_CwSmCode, Rs!Kh_CwSmno, Rs!KhIsStop, Rs!KhNo
      Requery = 1
   End If
   
   Set Rs = Nothing
   
Exit Function
Errorhandle:
   Set Rs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Function

Public Sub BatchLet(ParamArray Properties() As Variant)
   
   m_KhType = Properties(0)
   m_KhCode = Properties(1)
   m_KhMc = Properties(2)
   m_KhTel = Properties(3)
   m_KhFax = Properties(4)
   m_KhEmail = Properties(5)
   m_KhWww = Properties(6)
   m_KhAdd = Properties(7)
   m_KhPCode = Properties(8)
   m_KhLinkMan = Properties(9)
   m_Kh_CwBzCode = Properties(10)
   m_Kh_CwBzNo = Properties(11)
   m_Kh_CwSmCode = Properties(12)
   m_Kh_CwSmNo = Properties(13)
   m_KhIsStop = Properties(14)
   m_KhNo = Properties(15)

   m_KhId = 1

End Sub