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

Dim m_SysUrUgs As SysUrUgs

Dim M_SysUrCode As String
Dim M_SysUrMc As String
Dim M_SysUrPass As String

Dim M_SysUrNo As Double

Dim M_SysUr_id As Integer
Dim M_SysUr_Key As Long

Private Sub Class_Initialize()

M_SysUr_id = -1

End Sub

Public Property Get SysUrUgs() As SysUrUgs

If m_SysUrUgs Is Nothing Then
   Set m_SysUrUgs = New SysUrUgs
   m_SysUrUgs.Fillbydb Me
End If

Set SysUrUgs = m_SysUrUgs

End Property

Public Property Get SysUrCode() As String

SysUrCode = M_SysUrCode

End Property

Public Property Get SysUrMc() As String

SysUrMc = M_SysUrMc

End Property

Public Property Get SysUrPass() As String

SysUrPass = M_SysUrPass

End Property

Public Property Get SysUrNo() As Double

SysUrNo = M_SysUrNo

End Property

Public Property Get SysUr_id() As Integer

    SysUr_id = M_SysUr_id

End Property

Public Property Get SysUr_Key() As Long

    SysUr_Key = M_SysUr_Key

End Property

Public Property Let SysUrCode(VSysUrCode As String)

If Trim(VSysUrCode) = "" Then
   Err.Raise Number:=vbObjectError + 1, Description:="操作员编号不能为空！"
   Exit Property
End If

If VSysUrCode <> M_SysUrCode Then
    If M_SysUr_id = -1 Or VSysUrCode <> M_SysUrCode Then
       If gPublicFunction.ExistFlg("FROM SysUrREC WHERE SysUrCode='" + VSysUrCode + "' OR SysUrMc='" + VSysUrCode + "'") = 1 Then
          Err.Raise Number:=vbObjectError + 1, Description:="已有操作员编号：" & VSysUrCode
          Exit Property
       End If
    End If
    
    M_SysUrCode = VSysUrCode
End If

End Property

Public Property Let SysUrMc(VSysUrMc As String)

If Trim(VSysUrMc) = "" Then
   Err.Raise vbObjectError + 1, , "操作员说明不能为空！"
   Exit Property
End If

M_SysUrMc = VSysUrMc

End Property

Public Property Let SysUrPass(VSysUrPass As String)

M_SysUrPass = VSysUrPass

End Property

Public Property Let SysUr_id(vSysUr_id As Integer)

M_SysUr_id = vSysUr_id

End Property

Public Property Let SysUr_Key(vSysUr_Key As Long)

M_SysUr_Key = vSysUr_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_SysUr_id = -1 Then
   
       Cmd.CommandText = "{CALL SysUrREC_INSERT(?,?,?,?)}"
       
       Cmd.Parameters(0) = M_SysUrCode
       Cmd.Parameters(1) = M_SysUrMc
       Cmd.Parameters(2) = M_SysUrPass
       Cmd.Parameters(3).Direction = adParamOutput

       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       M_SysUrNo = Cmd.Parameters(3)
       SysUrUgs.DbSave
       gDbCommon.Conn.CommitTrans
       
       M_SysUr_id = 1
       
      
   Else
   
       Cmd.CommandText = "{CALL SysUrREC_UPDATE(?,?,?,?)}"
       
       Cmd(0) = M_SysUrNo
       
       Cmd(1) = M_SysUrCode
       Cmd(2) = M_SysUrMc
       Cmd(3) = M_SysUrPass
       
       gDbCommon.Conn.BeginTrans
       Cmd.Execute
       SysUrUgs.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 "SYSURREC", "SYSURNO", CStr(M_SysUrNo)
   
On Error GoTo Errorhandle

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

   Set Rs = New DbRs
   
   Rs.Fillbydb ("select SysUrCODE,SysUrMC,SYSURPASS,SysUrNO from SysUrrec where SysUrCode='" + VSysUrCode + "'")
   Requery = -1
   If Not Rs.EOF Then
      Requery = 1
      BatchLet Rs!SysUrCode, Rs!SysUrMc, Rs!SysUrPass, Rs!SysUrNo
   End If
 
   Set Rs = Nothing

Exit Function
Errorhandle:
   Set Rs = Nothing
End Function

Public Sub BatchLet(ParamArray Properties())

M_SysUrCode = Properties(0)
M_SysUrMc = Properties(1)
M_SysUrPass = Properties(2)
M_SysUrNo = Properties(3)

M_SysUr_id = 1

End Sub

Public Property Get Name() As String

Name = "SysUr"

End Property


Private Sub Class_Terminate()

Set m_SysUrUgs = Nothing

End Sub