saler.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 = "Saler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit

Dim m_SalerCode As String
Dim m_SalerMc As String
Dim m_SalerIsStop As Integer
Dim m_SalerNo As Double

Dim m_SalerId As Integer
Dim m_SalerKey As Integer

Private Sub Class_Initialize()
   m_SalerId = -1
End Sub

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

Public Property Get SalerId() As Integer
   SalerId = m_SalerId
End Property

Public Property Get SalerKey() As Integer
   SalerKey = m_SalerKey
End Property

Public Property Get SalerCode() As String
   SalerCode = m_SalerCode
End Property

Public Property Get SalerMc() As String
   SalerMc = m_SalerMc
End Property

Public Property Get SalerIsStop() As Integer
   SalerIsStop = m_SalerIsStop
End Property

Public Property Get SalerNo() As Double
   SalerNo = m_SalerNo
End Property

Public Property Let SalerId(vSalerId As Integer)
   m_SalerId = vSalerId
End Property

Public Property Let SalerKey(vSalerKey As Integer)
   m_SalerKey = vSalerKey
End Property

Public Property Let SalerCode(vSalerCode As String)
   If Trim(vSalerCode) = "" Then
      Err.Raise vbObjectError + 1, , "销售员编码不能为空！"
      Exit Property
   End If
   If m_SalerCode <> vSalerCode Then
      Dim Rs As DbRs
      Set Rs = New DbRs
      Rs.Fillbydb "SELECT * FROM SalerREC WHERE SalerCode='" & vSalerCode & "'"
      Rs.MoveFirst
      If Not Rs.EOF Then
         Set Rs = Nothing
         Err.Raise vbObjectError + 1, , "销售员编码已经存在！"
         Exit Property
      End If
      Set Rs = Nothing
   End If
   m_SalerCode = vSalerCode
End Property

Public Property Let SalerMc(vSalerMc As String)
   If Trim(vSalerMc) = "" Then
      Err.Raise vbObjectError + 1, , "销售员名称不能为空！"
      Exit Property
   End If
   m_SalerMc = vSalerMc
End Property

Public Property Let SalerIsStop(vSalerIsStop As Integer)
   If vSalerIsStop <> 0 And vSalerIsStop <> 1 Then
      Err.Raise vbObjectError + 1, , "停用标志只能为0或1！"
      Exit Property
   End If
   m_SalerIsStop = vSalerIsStop
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_SalerId = -1 Then
      Cmd.CommandText = "{CALL SalerREC_INSERT(?,?,?,?)}"
      Cmd(0) = m_SalerCode
      Cmd(1) = m_SalerMc
      Cmd(2) = m_SalerIsStop
      Cmd(3).Direction = adParamOutput
   Else
      Cmd.CommandText = "{CALL SalerREC_UPDATE(?,?,?,?)}"
      Cmd(0) = m_SalerNo
      Cmd(1) = m_SalerCode
      Cmd(2) = m_SalerMc
      Cmd(3) = m_SalerIsStop
   End If
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   If m_SalerId = -1 Then
      m_SalerNo = Cmd(3)
      m_SalerId = 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 "SALERREC", "SALERNO", CStr(m_SalerNo)
   
On Error GoTo Errorhandle
   
   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
      
   Cmd.CommandText = "{CALL SalerREC_DELETE(?)}"
   Cmd(0) = m_SalerNo
   
   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(vSalerCode As String, Optional vSalerNo As Double = 0) As Integer
   Dim mRs As DbRs
On Error GoTo Errorhandle
   Requery = -1
   
   Set mRs = New DbRs
   mRs.MoveFirst
   mRs.Fillbydb "SELECT SalerCODE,SalerMC,SalerISSTOP,SalerNO FROM SalerREC WHERE (SalerCODE='" & vSalerCode & "' OR SalerNO=" & CStr(vSalerNo) & ")"
   
   If Not mRs.EOF Then
      BatchLet mRs!SalerCode, mRs!SalerMc, mRs!SalerIsStop, mRs!SalerNo
      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_SalerCode = Properties(0)
   m_SalerMc = Properties(1)
   m_SalerIsStop = Properties(2)
   m_SalerNo = Properties(3)

   m_SalerId = 1

End Sub