kh.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 = "Kh"
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_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_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 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 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 ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM KhREC WHERE KhCode='" & vKhCode & "'")
      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_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 ADODB.Recordset
      Set Rs = Conn.Execute("SELECT * FROM KhREC WHERE KhMc='" & vKhMc & "'")
      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_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 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()
On Error GoTo Errorhandle
      
   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_KhIsStop
      Cmd(11).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_KhIsStop
   End If
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
   If m_KhId = -1 Then
      m_KhNo = Cmd(11)
      m_KhId = 1
   End If
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub Del()
On Error GoTo Errorhandle
      
   Cmd.CommandText = "{CALL KhREC_DELETE(?)}"
   Cmd(0) = m_KhNo
   
   Conn.BeginTrans
   Cmd.Execute
   Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function Requery(vKhCode As String, Optional vKhNo As Double = 0) As Integer
   Dim mRs As ADODB.Recordset
On Error GoTo Errorhandle
   Requery = -1
   Set mRs = Conn.Execute("SELECT KHTYPE,KhCODE,KhMC,KhTel,KHFAX,KHEMAIL,KHWWW,KHADD,KHPCODE,KHLINKMAN,KhISSTOP,KhNO FROM KhREC WHERE (KhCODE='" & vKhCode & "' OR KHNO=" & CStr(vKhNo) & ")")
   If Not mRs.EOF Then
      BatchLet mRs!KhType, mRs!KhCode, mRs!KhMc, mRs!KhTel, mRs!KhFax, mRs!KhEmail, mRs!KhWww, mRs!KhAdd, mRs!KhPCode, mRs!KhLinkMan, mRs!KhIsStop, mRs!KhNo
   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_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_KhIsStop = Properties(10)
   m_KhNo = Properties(11)

   m_KhId = 1

End Sub