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

Dim m_SysCpCw As SysCpCw

Dim M_SysCpCode As String
Dim M_SysCpMc As String
Dim M_SysCpEMc As String
Dim M_SysCpTel As String
Dim M_SysCpFax As String
Dim M_SysCpAdd As String
Dim M_SysCpPCode As String
Dim M_SysCpEmail As String
Dim M_SysCpWww As String

Dim M_SysCpNo As Double

Dim M_SysCp_id As Integer
Dim M_SysCp_Key As Long

Private Sub Class_Initialize()

M_SysCp_id = -1

End Sub

Public Property Get SysCpCw() As SysCpCw

If m_SysCpCw Is Nothing Then
   Set m_SysCpCw = New SysCpCw
   Set m_SysCpCw.Parent = Me
   If M_SysCp_id = 1 Then
      m_SysCpCw.Requery M_SysCpNo
   End If
End If

Set SysCpCw = m_SysCpCw

End Property

Public Property Get SysCpCode() As String

SysCpCode = M_SysCpCode

End Property

Public Property Get SysCpMc() As String

SysCpMc = M_SysCpMc

End Property

Public Property Get SysCpEmc() As String

SysCpEmc = M_SysCpEMc

End Property

Public Property Get SysCpTel() As String

SysCpTel = M_SysCpTel

End Property

Public Property Get SysCpFax() As String

SysCpFax = M_SysCpFax

End Property

Public Property Get SysCpAdd() As String

SysCpAdd = M_SysCpAdd

End Property

Public Property Get SysCpPCode() As String

SysCpPCode = M_SysCpPCode

End Property

Public Property Get SysCpEmail() As String

SysCpEmail = M_SysCpEmail

End Property

Public Property Get SysCpWww() As String

SysCpWww = M_SysCpWww

End Property

Public Property Get SysCpNo() As Double

SysCpNo = M_SysCpNo

End Property

Public Property Get SysCp_id() As Integer

    SysCp_id = M_SysCp_id

End Property

Public Property Get SysCp_Key() As Long

    SysCp_Key = M_SysCp_Key

End Property

Public Property Let SysCpCode(VSysCpCode As String)

If Trim(VSysCpCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="角色名不能为空！"
   Exit Property
End If

If VSysCpCode <> M_SysCpCode Then
    If M_SysCp_id = -1 Or VSysCpCode <> M_SysCpCode Then
       If gPublicFunction.ExistFlg("FROM SysCpREC WHERE SysCpCode='" + VSysCpCode + "' OR SysCpMc='" + VSysCpCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有角色：" & VSysCpCode
          Exit Property
       End If
    End If
    
    M_SysCpCode = VSysCpCode
End If

End Property

Public Property Let SysCpMc(VSysCpMc As String)

If Trim(VSysCpMc) = "" Then
   Err.Raise vbObjectError + 1, , "角色说明不能为空！"
   Exit Property
End If

If VSysCpMc <> M_SysCpMc Then
    If M_SysCp_id = -1 Or VSysCpMc <> M_SysCpMc Then
       If gPublicFunction.ExistFlg("FROM SysCprec WHERE SysCpMc='" + VSysCpMc + "' OR SysCpCode='" + VSysCpMc + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有角色说明:" & VSysCpMc
          Exit Property
       End If
    End If
    
    M_SysCpMc = VSysCpMc
End If

End Property

Public Property Let SysCpEmc(VSysCpEmc As String)
    
M_SysCpEMc = VSysCpEmc

End Property

Public Property Let SysCpTel(VSysCpTel As String)
    
M_SysCpTel = VSysCpTel

End Property

Public Property Let SysCpFax(VSysCpFax As String)
    
M_SysCpFax = VSysCpFax

End Property

Public Property Let SysCpAdd(VSysCpAdd As String)
    
M_SysCpAdd = VSysCpAdd

End Property

Public Property Let SysCpPCode(VSysCpPCode As String)
    
M_SysCpPCode = VSysCpPCode

End Property

Public Property Let SysCpEmail(VSysCpEmail As String)
    
M_SysCpEmail = VSysCpEmail

End Property

Public Property Let SysCpWww(VSysCpWww As String)
    
M_SysCpWww = VSysCpWww

End Property

Public Property Let SysCp_id(vSysCp_id As Integer)

M_SysCp_id = vSysCp_id

End Property

Public Property Let SysCp_Key(vSysCp_Key As Long)

M_SysCp_Key = vSysCp_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_SysCp_id = -1 Then
   
       Cmd.CommandText = "{CALL SysCpREC_INSERT(?,?,?,?,?,?,?,?,?,?)}"
       
       Cmd.Parameters(0) = M_SysCpCode
       Cmd.Parameters(1) = M_SysCpMc
       Cmd.Parameters(2) = M_SysCpEMc
       Cmd.Parameters(3) = M_SysCpTel
       Cmd.Parameters(4) = M_SysCpFax
       Cmd.Parameters(5) = M_SysCpAdd
       Cmd.Parameters(6) = M_SysCpPCode
       Cmd.Parameters(7) = M_SysCpEmail
       Cmd.Parameters(8) = M_SysCpWww
       Cmd.Parameters(9).Direction = adParamOutput

       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       M_SysCpNo = Cmd.Parameters(9)
       gDbCommon.Conn.CommitTrans
       
       M_SysCp_id = 1
       
      
   Else
   
       Cmd.CommandText = "{CALL SysCpREC_UPDATE(?,?,?,?,?,?,?,?,?,?)}"
       
       Cmd(0) = M_SysCpNo
       
       Cmd.Parameters(1) = M_SysCpCode
       Cmd.Parameters(2) = M_SysCpMc
       Cmd.Parameters(3) = M_SysCpEMc
       Cmd.Parameters(4) = M_SysCpTel
       Cmd.Parameters(5) = M_SysCpFax
       Cmd.Parameters(6) = M_SysCpAdd
       Cmd.Parameters(7) = M_SysCpPCode
       Cmd.Parameters(8) = M_SysCpEmail
       Cmd.Parameters(9) = M_SysCpWww
       
       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       gDbCommon.Conn.CommitTrans
   
   End If
   
   Set Cmd = Nothing

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

Public Sub DbDel()
   Dim Cmd As ADODB.Command
   
   gPublicFunction.CheckCanBeDelete "SYSCPREC", "SYSCPNO", CStr(M_SysCpNo)
   
On Error GoTo Errorhandle

   Set Cmd = New ADODB.Command
   
   Set Cmd.ActiveConnection = gDbCommon.Conn
   
   Cmd.CommandText = "{call SysCprec_delete(?)}"
   
   Cmd.Parameters(0) = M_SysCpNo
   
   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(VSysCpCode As String) As Integer
   Dim Rs As DbRs
On Error GoTo Errorhandle

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select SysCpCODE,SysCpMC,SysCpEMc,SysCpTel,SysCpFax,SysCpAdd,SysCpPCode,SysCpEmail,SysCpWww,SysCpNO from SysCprec where SysCpCode='" + VSysCpCode + "'")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!SysCpCode, Rs!SysCpMc, Rs!SysCpEmc, Rs!SysCpTel, Rs!SysCpFax, Rs!SysCpAdd, Rs!SysCpPCode, Rs!SysCpEmail, Rs!SysCpWww, Rs!SysCpNo
   End If
 
   Set Rs = Nothing

Exit Function
Errorhandle:
   Set Rs = Nothing
End Function

Public Sub BatchLet(ParamArray Properties())

M_SysCpCode = Properties(0)
M_SysCpMc = Properties(1)
M_SysCpEMc = Properties(2)
M_SysCpTel = Properties(3)
M_SysCpFax = Properties(4)
M_SysCpAdd = Properties(5)
M_SysCpPCode = Properties(6)
M_SysCpEmail = Properties(7)
M_SysCpWww = Properties(8)
M_SysCpNo = Properties(9)

M_SysCp_id = 1

End Sub

Public Property Get Name() As String

Name = "SysCp"

End Property


Private Sub Class_Terminate()

Set m_SysCpCw = Nothing

End Sub