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

Dim m_SysUgPrivs As SysUgPrivs
Dim m_SysUgRfds As SysUgRfds

Dim M_SysUgCode As String
Dim M_SysUgMc As String
Dim M_SysUgNo As Double

Dim M_SysUg_id As Integer
Dim M_SysUg_Key As Long

Private Sub Class_Initialize()

M_SysUg_id = -1

End Sub

Public Property Get SysUgPrivs() As SysUgPrivs

If m_SysUgPrivs Is Nothing Then
   Set m_SysUgPrivs = New SysUgPrivs
   m_SysUgPrivs.Fillbydb Me
End If

Set SysUgPrivs = m_SysUgPrivs

End Property

Public Property Get SysUgRfds() As SysUgRfds

If m_SysUgRfds Is Nothing Then
   Set m_SysUgRfds = New SysUgRfds
   m_SysUgRfds.Fillbydb Me
End If

Set SysUgRfds = m_SysUgRfds

End Property

Public Property Get SysUgCode() As String

SysUgCode = M_SysUgCode

End Property

Public Property Get SysUgMc() As String

SysUgMc = M_SysUgMc

End Property

Public Property Get SysUgNo() As Double

SysUgNo = M_SysUgNo

End Property

Public Property Get SysUg_id() As Integer

    SysUg_id = M_SysUg_id

End Property

Public Property Get SysUg_Key() As Long

    SysUg_Key = M_SysUg_Key

End Property

Public Property Let SysUgCode(VSysUgCode As String)

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

If VSysUgCode <> M_SysUgCode Then
    If M_SysUg_id = -1 Or VSysUgCode <> M_SysUgCode Then
       If gPublicFunction.ExistFlg("FROM SysUgREC WHERE SysUgCode='" + VSysUgCode + "' OR SysUgMc='" + VSysUgCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有角色：" & VSysUgCode
          Exit Property
       End If
    End If
    
    M_SysUgCode = VSysUgCode
End If

End Property

Public Property Let SysUgMc(VSysUgMc As String)

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

If VSysUgMc <> M_SysUgMc Then
    If M_SysUg_id = -1 Or VSysUgMc <> M_SysUgMc Then
       If gPublicFunction.ExistFlg("FROM SysUgrec WHERE SysUgMc='" + VSysUgMc + "' OR SysUgCode='" + VSysUgMc + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有角色说明:" & VSysUgMc
          Exit Property
       End If
    End If
    
    M_SysUgMc = VSysUgMc
End If

End Property

Public Property Let SysUg_id(vSysUg_id As Integer)

M_SysUg_id = vSysUg_id

End Property

Public Property Let SysUg_Key(vSysUg_Key As Long)

M_SysUg_Key = vSysUg_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_SysUg_id = -1 Then
   
       Cmd.CommandText = "{CALL SysUgREC_INSERT(?,?,?)}"
       
       Cmd.Parameters(0) = M_SysUgCode
       Cmd.Parameters(1) = M_SysUgMc
       Cmd.Parameters(2).Direction = adParamOutput

       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       M_SysUgNo = Cmd.Parameters(2)
       SysUgPrivs.DbSave
       SysUgRfds.DbSave
       gDbCommon.Conn.CommitTrans
       
       M_SysUg_id = 1
       
      
   Else
   
       Cmd.CommandText = "{CALL SysUgREC_UPDATE(?,?,?)}"
       
       Cmd(0) = M_SysUgNo
       
       Cmd(1) = M_SysUgCode
       Cmd(2) = M_SysUgMc
       
       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       SysUgPrivs.DbSave
       SysUgRfds.DbSave
       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 "SYSUGREC", "SYSUGNO", CStr(M_SysUgNo)
   
On Error GoTo Errorhandle

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

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select SysUgCODE,SysUgMC,SysUgNO from SysUgrec where SysUgCode='" + VSysUgCode + "'")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!SysUgCode, Rs!SysUgMc, Rs!SysUgNo
   End If
 
   Set Rs = Nothing

Exit Function
Errorhandle:
   Set Rs = Nothing
End Function

Public Sub BatchLet(ParamArray Properties())

M_SysUgCode = Properties(0)
M_SysUgMc = Properties(1)
M_SysUgNo = Properties(2)

M_SysUg_id = 1

End Sub

Public Property Get Name() As String

Name = "SysUg"

End Property


Private Sub Class_Terminate()

Set m_SysUgPrivs = Nothing

End Sub