⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sysugprivops.cls

📁 制造业产供销与往来系统源码
💻 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 = "SysUgPrivTbs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim OSysUgPrivTbs As Collection

Public Property Get Count() As Integer

Count = OSysUgPrivTbs.Count
    
End Property

Public Sub Add(OSysUgPrivTb As SysUgPrivTb)

Dim vKey As Integer, vSysUgPrivTb As SysUgPrivTb

For Each vSysUgPrivTb In OSysUgPrivTbs
   If vSysUgPrivTb.SysUgPrivTb_Key > vKey Then
      vKey = vSysUgPrivTb.SysUgPrivTb_Key
   End If
Next

vKey = vKey + 1

OSysUgPrivTb.SysUgPrivTb_Key = vKey
OSysUgPrivTbs.Add OSysUgPrivTb, CStr(vKey)

End Sub

Public Function Item(Vindex) As SysUgPrivTb
Attribute Item.VB_UserMemId = 0

   Set Item = OSysUgPrivTbs.Item(Vindex)

End Function

Public Sub Remove(Vindex)
   
OSysUgPrivTbs.Remove (Vindex)
      
End Sub

Public Sub ClearAll()

Dim i, Vcount As Integer
Vcount = OSysUgPrivTbs.Count

For i = 1 To Vcount
   OSysUgPrivTbs.Remove (1)
Next

End Sub

Public Sub Fillbydb(vSysUgPriv As SysUgPriv, Optional Orderstr As String = "SYSTBSEQ")
   Dim OSysUgPrivTb As SysUgPrivTb
   Dim Rs As DbRs
   Dim SqlStr As String, SqlStr1 As String
   Dim vKey As Integer
On Error GoTo ErrorHandle

   ClearAll
   
   If vSysUgPriv.SysForm.SysFormTbType <> 5 Then
      SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SYSUGPRIVTBREC WHERE SYSUGPRIVTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFTB_SYSTBNO) THEN 1 ELSE 0 END,SysUgPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & ",SysUgPrivTb_SysTbNo=SysFtb_SYSTBNo,SysUgPrivTb_SysTbCode=SysTbCode,SysUgPrivTb_SysTbMc=SYSTBDESC,SysUgPrivTbno=COALESCE((SELECT SYSUGPrivTbNO FROM SYSUGPrivTbREC WHERE SYSUGPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SysFtb_SYSTBNo),0) FROM SYSFTBREC,SYSTBREC WHERE SYSFTBTYPE=" & CStr(vSysUgPriv.SysForm.SysFormTbType) & " AND SYSTBNO=SYSFTB_SYSTBNO AND SYSTBISPRIV=1"
   Else
      SqlStr = "SELECT SELECTFLG=CASE WHEN EXISTS(SELECT * FROM SYSUGPRIVTBREC WHERE SYSUGPRIVTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFORMTB_SYSTBNO) THEN 1 ELSE 0 END,SysUgPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & ",SysUgPrivTb_SysTbNo=SYSFORMTB_SYSTBNO,SysUgPrivTb_SysTbCode=SysTbCode,SysUgPrivTb_SysTbMc=SYSTBDESC,SysUgPrivTbno=COALESCE((SELECT SYSUGPrivTbNO FROM SYSUGPrivTbREC WHERE SYSUGPrivTbNO1=" & CStr(vSysUgPriv.SysUgPrivNo) & " AND SYSUGPrivTb_SysTbNo=SYSFORMTB_SYSTBNO),0) FROM SYSFORMTBREC,SYSTBREC WHERE SYSFORMTB_SYSFORMNO=" & CStr(vSysUgPriv.SysForm.SysFormNo) & " AND SYSTBNO=SYSFORMTB_SYSTBNO AND SYSTBISPRIV=1"
   End If
     
   If Orderstr <> "" Then
      SqlStr = SqlStr + " order by " + Orderstr
   End If
   
   Set Rs = New DbRs
   
   Rs.Fillbydb SqlStr
   Rs.MoveFirst
   
   vKey = 1

   Do Until Rs.EOF
      Set OSysUgPrivTb = New SysUgPrivTb
      Set OSysUgPrivTb.Parent = vSysUgPriv
      OSysUgPrivTb.SysUgPrivTb_Key = vKey
      OSysUgPrivTb.BatchLet Rs!SysUgPrivTbNo1, Rs!SysUgPrivTb_SysTbNo, Rs!SysUgPrivTb_SysTbCode, Rs!SysUgPrivTb_SysTbMc, Rs!SysUgPrivTbNo, Rs!SelectFlg
      If Rs!SysUgPrivTbNo1 = 0 Then
         OSysUgPrivTb.SysUgPrivTb_id = -1
      Else
         OSysUgPrivTb.SysUgPrivTb_id = 1
      End If
      OSysUgPrivTbs.Add OSysUgPrivTb, CStr(vKey)
      Rs.MoveNext
      vKey = vKey + 1
   Loop

   Set Rs = Nothing

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

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"

  Set NewEnum = OSysUgPrivTbs.[_NewEnum]
  
End Function

Private Sub Class_Initialize()

Set OSysUgPrivTbs = New Collection

End Sub

Private Sub Class_Terminate()

Set OSysUgPrivTbs = Nothing

End Sub

Public Property Get Name() As String

Name = "SysUgPrivTbs"

End Property

Public Sub DbSave()
   Dim mSysUgPrivTb As SysUgPrivTb
   Dim mNotSaved As Collection
   Dim mNotDeled As Collection
On Error GoTo ErrorHandle

   Set mNotSaved = New Collection
   Set mNotDeled = New Collection
      
   For Each mSysUgPrivTb In OSysUgPrivTbs
      If mSysUgPrivTb.SelectFlg = 1 Then
         If mSysUgPrivTb.SysUgPrivTb_id = -1 Then
            mNotSaved.Add mSysUgPrivTb
         End If
         mSysUgPrivTb.DbSave
      Else
         If mSysUgPrivTb.SysUgPrivTb_id = 1 Then
            mNotDeled.Add mSysUgPrivTb
            mSysUgPrivTb.DbDel
            mSysUgPrivTb.SysUgPrivTb_id = -1
         End If
      End If
   Next
   
      
   Set mNotSaved = Nothing
   Set mNotDeled = Nothing

Exit Sub
ErrorHandle:
   For Each mSysUgPrivTb In mNotSaved
      mSysUgPrivTb.SysUgPrivTb_id = -1
   Next
   For Each mSysUgPrivTb In mNotDeled
      mSysUgPrivTb.SysUgPrivTb_id = 1
   Next
   Set mNotSaved = Nothing
   Set mNotDeled = Nothing
   Err.Raise vbObjectError + 1, , gDbCommon.Conn.Errors(0)
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -