psbm.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 = "PsBm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim M_PsBmCode As String
Dim M_PsBmMc As String
Dim M_PsBmType As Integer
Dim M_PsBmNo As Double

Dim M_PsBm_id As Integer
Dim M_PsBm_Key As Long

Private Sub Class_Initialize()

M_PsBm_id = -1

End Sub

Public Property Get PsBmCode() As String

PsBmCode = M_PsBmCode

End Property

Public Property Get PsBmMc() As String

PsBmMc = M_PsBmMc

End Property

Public Property Get PsBmType() As Integer

PsBmType = M_PsBmType

End Property

Public Property Get PsBmNo() As Double

PsBmNo = M_PsBmNo

End Property

Public Property Get PsBm_id() As Integer

    PsBm_id = M_PsBm_id

End Property

Public Property Get PsBm_Key() As Long

    PsBm_Key = M_PsBm_Key

End Property

Public Property Let PsBmCode(VPsBmCode As String)

If Trim(VPsBmCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="部门编码不能为空！"
   Exit Property
End If

If VPsBmCode <> M_PsBmCode Then
    If M_PsBm_id = -1 Or VPsBmCode <> M_PsBmCode Then
       If gPublicFunction.ExistFlg("FROM PsBmREC WHERE PsBmCode='" + VPsBmCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有部门编码:" & VPsBmCode
          Exit Property
       End If
    End If
End If
    
M_PsBmCode = VPsBmCode

End Property

Public Property Let PsBmMc(vPsBmMc As String)

If Trim(vPsBmMc) = "" Then
   Err.Raise vbObjectError + 1, , "部门名称不能为空！"
   Exit Property
End If

If vPsBmMc <> M_PsBmMc Then
    If M_PsBm_id = -1 Or vPsBmMc <> M_PsBmMc Then
       If gPublicFunction.ExistFlg("FROM PsBmREC WHERE PsBmMc='" + vPsBmMc + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有部门名称:" & vPsBmMc
          Exit Property
       End If
    End If
    M_PsBmMc = vPsBmMc
End If

End Property

Public Property Let PsBmType(VPsBmType As Integer)

If VPsBmType <> 1 And VPsBmType <> 2 Then
   Err.Raise vbObjectError + 1, , "部门类型只能为1或2！"
   Exit Property
End If

M_PsBmType = VPsBmType

End Property

Public Property Let PsBm_id(vPsBm_id As Integer)

M_PsBm_id = vPsBm_id

End Property

Public Property Let PsBm_Key(vPsBm_Key As Long)

M_PsBm_Key = vPsBm_Key

End Property

Public Sub DbSave()
   Dim Cmd As ADODB.Command
   Dim mSqlStr As String
On Error GoTo ErrorHandle


   Set Cmd = New ADODB.Command
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   If M_PsBm_id = -1 Then
   
       Cmd.CommandText = "{CALL PsBmREC_INSERT(?,?,?,?)}"
       
       Cmd.Parameters(0) = M_PsBmCode
       Cmd.Parameters(1) = M_PsBmMc
       Cmd.Parameters(2) = M_PsBmType
       Cmd.Parameters(3).Direction = adParamOutput
       
       Cmd.Execute
       
       M_PsBm_id = 1
   
       M_PsBmNo = Cmd.Parameters(3)
      
   Else
   
       Cmd.CommandText = "{CALL PsBmREC_UPDATE(?,?,?,?)}"
       
       Cmd(0) = M_PsBmNo
       
       Cmd(1) = M_PsBmCode
       Cmd(2) = M_PsBmMc
       Cmd(3) = M_PsBmType
       
       Cmd.Execute
   
   End If
   
   Set Cmd = Nothing

Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Sub DbDel()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "PSBMREC", "PSBMNO", CStr(M_PsBmNo)
   
On Error GoTo ErrorHandle

   Set Cmd = New ADODB.Command
   
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{call PsBmrec_delete(?)}"
   
   Cmd.Parameters(0) = M_PsBmNo
   
   gDbCommon.Conn.BeginTrans
   Cmd.Execute
   gDbCommon.Conn.CommitTrans
   
   Set Cmd = Nothing

Exit Sub
ErrorHandle:
   Set Cmd = Nothing
   gDbCommon.Conn.RollbackTrans
End Sub

Public Function Requery(VPsBmCode As String) As Integer
   Dim Rs As DbRs
On Error GoTo ErrorHandle

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select PsBmCode,PsBmMc,PsBmType,PsBmNo from PsBmrec where PsBmCode='" + VPsBmCode + "'")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!PsBmCode, Rs!PsBmMc, Rs!PsBmType, Rs!PsBmNo
   End If
 
   Set Rs = Nothing

Exit Function
ErrorHandle:
   Set Rs = Nothing
End Function

Public Sub BatchLet(ParamArray Properties())

M_PsBmCode = Properties(0)
M_PsBmMc = Properties(1)
M_PsBmType = Properties(2)
M_PsBmNo = Properties(3)

M_PsBm_id = 1

End Sub

Public Property Get Name() As String

Name = "PsBm"

End Property