buyer.cls

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

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

Option Explicit

Dim m_BuyerCode As String
Dim m_BuyerMc As String
Dim m_BuyerIsStop As Integer
Dim m_BuyerNo As Double

Dim m_BuyerId As Integer
Dim m_BuyerKey As Integer

Private Sub Class_Initialize()
   m_BuyerId = -1
End Sub

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

Public Property Get BuyerId() As Integer
   BuyerId = m_BuyerId
End Property

Public Property Get BuyerKey() As Integer
   BuyerKey = m_BuyerKey
End Property

Public Property Get BuyerCode() As String
   BuyerCode = m_BuyerCode
End Property

Public Property Get BuyerMc() As String
   BuyerMc = m_BuyerMc
End Property

Public Property Get BuyerIsStop() As Integer
   BuyerIsStop = m_BuyerIsStop
End Property

Public Property Get BuyerNo() As Double
   BuyerNo = m_BuyerNo
End Property

Public Property Let BuyerId(vBuyerId As Integer)
   m_BuyerId = vBuyerId
End Property

Public Property Let BuyerKey(vBuyerKey As Integer)
   m_BuyerKey = vBuyerKey
End Property

Public Property Let BuyerCode(vBuyerCode As String)
   If Trim(vBuyerCode) = "" Then
      Err.Raise vbObjectError + 1, , "货物编码不能为空！"
      Exit Property
   End If
   If m_BuyerCode <> vBuyerCode Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM BuyerREC WHERE BuyerCode='" & vBuyerCode & "'"
      Rs.MoveFirst
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "货物编码已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   m_BuyerCode = vBuyerCode
End Property

Public Property Let BuyerMc(vBuyerMc As String)
   If Trim(vBuyerMc) = "" Then
      Err.Raise vbObjectError + 1, , "货物名称不能为空！"
      Exit Property
   End If
   m_BuyerMc = vBuyerMc
End Property

Public Property Let BuyerIsStop(vBuyerIsStop As Integer)
   If vBuyerIsStop <> 0 And vBuyerIsStop <> 1 Then
      Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
      Exit Property
   End If
   m_BuyerIsStop = vBuyerIsStop
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_BuyerId = -1 Then
      Cmd.CommandText = "{CALL BuyerREC_INSERT(?,?,?,?)}"
      Cmd(0) = m_BuyerCode
      Cmd(1) = m_BuyerMc
      Cmd(2) = m_BuyerIsStop
      Cmd(3).Direction = adParamOutput
   Else
      Cmd.CommandText = "{CALL BuyerREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_BuyerNo
      Cmd(1) = m_BuyerCode
      Cmd(2) = m_BuyerMc
      Cmd(3) = m_BuyerIsStop
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   If m_BuyerId = -1 Then
      m_BuyerNo = Cmd(3)
      m_BuyerId = 1
   End If
   
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 "BUYERREC", "BUYERNO", CStr(m_BuyerNo)
   
On Error GoTo Errorhandle
   
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL BuyerREC_DELETE(?)}"
   Cmd(0) = m_BuyerNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
Exit Sub
Errorhandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

Public Function Requery(vBuyerCode As String, Optional vBuyerNo As Double = 0) As Integer
   Dim mRs As DbRs
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   mRs.MoveFirst
   mRs.Fillbydb "SELECT BuyerCODE,BuyerMC,BuyerISSTOP,BuyerNO FROM BuyerREC WHERE (BuyerCODE='" & vBuyerCode & "' OR BuyerNO=" & CStr(vBuyerNo) & ")"
   
   If Not mRs.EOF Then
      BatchLet mRs!BuyerCode, mRs!BuyerMc, mRs!BuyerIsStop, mRs!BuyerNo
      Requery = 1
   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_BuyerCode = Properties(0)
   m_BuyerMc = Properties(1)
   m_BuyerIsStop = Properties(2)
   m_BuyerNo = Properties(3)

   m_BuyerId = 1

End Sub