frmobjectmutex.frm

一个用VB写的财务软件源码

Call LoadAuth(cboSub1)
cboSub2.ListIndex = cboSub1.ListIndex
If lVw.ListItems.Count > 0 Then
    Set lVw.SelectedItem = lVw.ListItems(1)
End If
End Sub

Private Sub cboSub2_Click()
cboMutex.Clear
Call LoadAuth(cboSub2)
If cboMutex.ListCount > 0 Then
    cboMutex.ListIndex = 0
End If
End Sub

Private Sub RefreshMfg()
Dim rSt As New ADODB.Recordset
Dim sSql As String '
Dim i As Integer
mFg.Rows = 2
For i = 0 To 5
    mFg.TextMatrix(1, i) = ""
Next i
mFg.Redraw = False
With rSt
    .CursorLocation = adUseClient
    If g_FLAT = "SQL" Then
        sSql = "select a.SubSysID,a.AuthMenuName,a.ObjectMenuName,b.SubSysName," & _
            "c.AuthName,a.MutexObjectMenuName  from tSYS_MutexObjectInfo a," & _
            "tSYS_SubSys b,tSYS_Auth c  where a.MutexSubSysID=b.SubSysID and " & _
            "a.MutexAuthMenuName=c.AuthMenuName and b.SubSysID=SUBSTRING(c.AuthID,1,2)" & _
            " and a.SubSysID='" & m_sSub(cboSub1.ListIndex + 1) & "' and a.AuthMenuName='" & _
            m_sMenu1(lVw.SelectedItem.index) & "'"
    Else
        sSql = "select a.SubSysID,a.AuthMenuName,a.ObjectMenuName,b.SubSysName," & _
            "c.AuthName,a.MutexObjectMenuName  from tSYS_MutexObjectInfo a," & _
            "tSYS_SubSys b,tSYS_Auth c  where a.MutexSubSysID=b.SubSysID and " & _
            "a.MutexAuthMenuName=c.AuthMenuName and b.SubSysID=SUBSTR(c.AuthID,1,2)" & _
            " and a.SubSysID='" & m_sSub(cboSub1.ListIndex + 1) & "' and a.AuthMenuName='" & _
            m_sMenu1(lVw.SelectedItem.index) & "'"
    End If
    .Open sSql, gloSys.cnnSys, adOpenStatic, adLockReadOnly
    If .RecordCount > 0 Then
        mFg.Rows = 1
        Do Until .EOF
            mFg.AddItem cboSub1.text & vbTab & lVw.SelectedItem.text & vbTab & _
                Trim("" & .Fields(2).Value) & vbTab & Trim("" & .Fields(3).Value) & _
                vbTab & Trim("" & .Fields(4).Value) & vbTab & Trim("" & .Fields(5).Value)
            .MoveNext
        Loop
    End If
    .Close
End With
mFg.Redraw = True
mFg.Refresh
               
End Sub
Private Sub LoadAuth(ByVal cboTemp As ComboBox)
Dim rSt As New ADODB.Recordset
Dim sSql As String, i As Integer
If UCase(cboTemp.Name) = "CBOSUB1" Then
    ReDim m_sMenu1(1)
ElseIf UCase(cboTemp.Name) = "CBOSUB2" Then
    ReDim m_sMenu2(1)
End If
    
    With rSt
        .CursorLocation = adUseClient
        If g_FLAT = "SQL" Then
            sSql = "select * from tsys_auth where bEnd<>'0' and substring(AuthID,1,2)='" & _
                m_sSub(cboTemp.ListIndex + 1) & "' order by AuthID"
        ElseIf g_FLAT = "ORACLE" Then
            sSql = "select * from tsys_auth where bEnd<>'0' and substr(AuthID,1,2)='" & _
                m_sSub(cboTemp.ListIndex + 1) & "' order by AuthID"
        End If
        .Open sSql, gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            If UCase(cboTemp.Name) = "CBOSUB1" Then
                ReDim m_sMenu1(.RecordCount)
            ElseIf UCase(cboTemp.Name) = "CBOSUB2" Then
                ReDim m_sMenu2(.RecordCount)
            End If
            i = 1
            Do Until .EOF
                If UCase(cboTemp.Name) = "CBOSUB1" Then
                    lVw.ListItems.Add , , Trim("" & .Fields("AuthName").Value)
                    m_sMenu1(i) = Trim("" & .Fields("AuthMenuName").Value)
                ElseIf UCase(cboTemp.Name) = "CBOSUB2" Then
                    cboMutex.AddItem Trim("" & .Fields("AuthName").Value)
                    m_sMenu2(i) = Trim("" & .Fields("AuthMenuName").Value)
                End If
                i = i + 1
                .MoveNext
            Loop
        End If
        .Close
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    m_bRevise = False
    m_sMutexSubID = ""
    m_sMutexAuthMenuName = ""
    ReDim m_sSub(1)
    ReDim m_sMenu1(1)
    ReDim m_sMenu2(1)
End Sub

Private Sub lVw_Click()
sTb.Tab = 0
sTb.TabEnabled(0) = True
sTb.TabEnabled(1) = False
If lVw.ListItems.Count = 0 Then
    mnuEditRevise.Enabled = False
    mnuEditDelete.Enabled = False
    mnuEditCancel.Enabled = False
    mnuEditSave.Enabled = False
    mnuEditAppend.Enabled = True
    tBr.Buttons("Revise").Enabled = False
    tBr.Buttons("Delete").Enabled = False
    tBr.Buttons("Cancel").Enabled = False
    tBr.Buttons("Save").Enabled = False
    tBr.Buttons("Append").Enabled = True
ElseIf lVw.SelectedItem.index > 0 Then
    mnuEditRevise.Enabled = True
    mnuEditDelete.Enabled = True
    mnuEditCancel.Enabled = False
    mnuEditSave.Enabled = False
    mnuEditAppend.Enabled = True
    tBr.Buttons("Revise").Enabled = True
    tBr.Buttons("Delete").Enabled = True
    tBr.Buttons("Cancel").Enabled = False
    tBr.Buttons("Save").Enabled = False
    tBr.Buttons("Append").Enabled = True
    Call RefreshMfg
    Call FillBox
End If
End Sub



Private Sub mFg_Click()
Call FillBox
End Sub

Private Sub mnuEditAppend_Click()
mnuEditRevise.Enabled = False
mnuEditDelete.Enabled = False
mnuEditCancel.Enabled = True
mnuEditSave.Enabled = True
mnuEditAppend.Enabled = False
tBr.Buttons("Revise").Enabled = False
tBr.Buttons("Delete").Enabled = False
tBr.Buttons("Cancel").Enabled = True
tBr.Buttons("Save").Enabled = True
tBr.Buttons("Append").Enabled = False
sTb.TabEnabled(0) = False
sTb.TabEnabled(1) = True
sTb.Tab = 1
txtName.text = ""
txtName.SetFocus
txtMutex.text = ""
cboSub1.Enabled = False
lVw.Enabled = False
End Sub

Private Sub mnuEditCancel_Click()
cboSub1.Enabled = True
lVw.Enabled = True
mnuEditRevise.Enabled = True
mnuEditDelete.Enabled = True
mnuEditCancel.Enabled = False
mnuEditSave.Enabled = False
mnuEditAppend.Enabled = True
tBr.Buttons("Revise").Enabled = True
tBr.Buttons("Delete").Enabled = True
tBr.Buttons("Cancel").Enabled = False
tBr.Buttons("Save").Enabled = False
tBr.Buttons("Append").Enabled = True
If m_bRevise = True Then
    m_bRevise = False
    m_sMutexSubID = ""
    m_sMutexAuthMenuName = ""
    sTb.Tab = 0
    sTb.TabEnabled(0) = True
    sTb.TabEnabled(1) = False
Else
    txtName.text = ""
    txtMutex.text = ""
End If

End Sub

Private Sub mnuEditDelete_Click()
Dim adoCmd As New ADODB.Command
Dim i As Integer
If Not (mFg.TextMatrix(1, 0) = "") Then
    If mFg.Row > 0 Then
        If MsgBox("确实要删除选定的记录吗？", vbYesNo, "询问") = vbYes Then
            With adoCmd
                .ActiveConnection = gloSys.cnnSys
                .CommandType = adCmdText
                .CommandText = "Delete from tsys_MutexObjectInfo where SubSysID='" & _
                    m_sSub(cboSub1.ListIndex + 1) & "' and AuthMenuName='" & _
                    m_sMenu1(lVw.SelectedItem.index) & "' and ObjectMenuName='" & _
                    Trim("" & txtName.text) & "' and MutexSubSysID='" & _
                    m_sSub(cboSub2.ListIndex + 1) & "' and MutexAuthMenuName='" & _
                    m_sMenu2(cboMutex.ListIndex + 1) & "' and MutexObjectMenuName='" & _
                    Trim("" & txtMutex.text) & "'"
                .Execute
            End With
            If mFg.Rows = 2 Then
                For i = 0 To 5
                    mFg.TextMatrix(1, i) = ""
                Next i
            Else
                mFg.RemoveItem mFg.Row
            End If
            Call FillBox
        End If
    Else
        MsgBox "请选择要删除的记录！", vbInformation, "提示"
        Exit Sub
    End If
Else
    MsgBox "没有要删除的记录", vbInformation, "提示"
    Exit Sub
End If
End Sub

Private Sub mnuEditRevise_Click()
Dim i As Integer
If mFg.TextMatrix(mFg.Row, 3) <> "" And mFg.TextMatrix(mFg.Row, 4) <> "" Then
    m_bRevise = True
    mnuEditRevise.Enabled = False
    mnuEditDelete.Enabled = False
    mnuEditCancel.Enabled = True
    mnuEditSave.Enabled = True
    mnuEditAppend.Enabled = False
    tBr.Buttons("Revise").Enabled = False
    tBr.Buttons("Delete").Enabled = False
    tBr.Buttons("Cancel").Enabled = True
    tBr.Buttons("Save").Enabled = True
    tBr.Buttons("Append").Enabled = False
    sTb.TabEnabled(0) = False
    sTb.TabEnabled(1) = True
    sTb.Tab = 1
    cboSub1.Enabled = False
    lVw.Enabled = False
   
    For i = 1 To cboSub2.ListCount
        If cboSub2.List(i - 1) = Trim$(mFg.TextMatrix(mFg.Row, 3)) Then
            m_sMutexSubID = m_sSub(i)
            Exit For
        End If
    Next i
    For i = 1 To cboMutex.ListCount
        If cboMutex.List(i - 1) = Trim$(mFg.TextMatrix(mFg.Row, 4)) Then
            m_sMutexAuthMenuName = m_sMenu2(i)
            Exit For
        End If
    Next i
Else
    MsgBox "没有指定的修改记录！", vbInformation, "提示"
    Exit Sub
End If

End Sub
Private Sub FillBox()
If mFg.Row > 0 Then
    If mFg.TextMatrix(mFg.Row, 3) <> "" And mFg.TextMatrix(mFg.Row, 4) <> "" Then
        txtName.text = Trim("" & mFg.TextMatrix(mFg.Row, 2))
        cboSub2.text = Trim("" & mFg.TextMatrix(mFg.Row, 3))
        cboMutex.text = Trim("" & mFg.TextMatrix(mFg.Row, 4))
        txtMutex.text = Trim("" & mFg.TextMatrix(mFg.Row, 5))
    End If
End If
End Sub

Private Sub mnuEditSave_Click()
Dim adoCmd As New ADODB.Command
Dim rSt As New ADODB.Recordset
If Trim("" & txtName.text) = "" Then
    MsgBox "请输入对象菜单标识", vbInformation, "提示"
    txtName.SetFocus
    Exit Sub
End If
If Trim("" & txtMutex.text) = "" Then
    MsgBox "请输入互斥对象菜单标识", vbInformation, "提示"
    txtMutex.SetFocus
    Exit Sub
End If
If cboSub2.text = "" Then
    MsgBox "请选择互斥子系统！", vbInformation, "提示"
    cboSub2.SetFocus
    Exit Sub
End If
If cboMutex.text = "" Then
    MsgBox "请选择互斥功能菜单！", vbInformation, "提示"
    cboMutex.SetFocus
    Exit Sub
End If
With rSt
    .CursorLocation = adUseClient
    .Open "Select * from tSYS_MutexObjectInfo where SubSysID='" & _
        m_sSub(cboSub1.ListIndex + 1) & "' and AuthMenuName='" & _
        m_sMenu1(lVw.SelectedItem.index) & "' and ObjectMenuName='" & _
        Trim("" & txtName.text) & "' and MutexSubSysID='" & _
        m_sSub(cboSub2.ListIndex + 1) & "' and MutexAuthMenuName='" & _
        m_sMenu2(cboMutex.ListIndex + 1) & "' and MutexObjectMenuName='" & _
        Trim("" & txtMutex.text) & "'", gloSys.cnnSys, adOpenStatic, adLockReadOnly
    If Not (.EOF And .BOF) Then
        MsgBox "该记录已经存在，请重新输入互斥对象标识！", vbInformation, "提示"
        Exit Sub
    End If
    .Close
End With
With adoCmd
    .ActiveConnection = gloSys.cnnSys
    .CommandType = adCmdText
    If m_bRevise Then
        .CommandText = "Delete from tsys_MutexObjectInfo where SubSysID='" & _
            m_sSub(cboSub1.ListIndex + 1) & "' and AuthMenuName='" & _
            m_sMenu1(lVw.SelectedItem.index) & "' and ObjectMenuName='" & _
            mFg.TextMatrix(mFg.Row, 2) & "' and MutexSubSysID='" & _
            m_sMutexSubID & "' and MutexAuthMenuName='" & _
            m_sMutexAuthMenuName & "' and MutexObjectMenuName='" & _
            mFg.TextMatrix(mFg.Row, 5) & "'"
        .Execute
    End If
    .CommandText = "Insert into tSYS_MutexObjectInfo(SubSysID,AuthMenuName," & _
        "ObjectMenuName,MutexSubSysID,MutexAuthMenuName,MutexObjectMenuName)" & _
        "Values('" & m_sSub(cboSub1.ListIndex + 1) & "','" & _
        m_sMenu1(lVw.SelectedItem.index) & "','" & Trim("" & txtName.text) & _
        "','" & m_sSub(cboSub2.ListIndex + 1) & "','" & m_sMenu2(cboMutex.ListIndex + 1) & _
        "','" & Trim("" & txtMutex.text) & "')"
    .Execute
End With

'修改网格
If m_bRevise Then
     mFg.TextMatrix(mFg.Row, 2) = Trim("" & txtName.text)
     mFg.TextMatrix(mFg.Row, 3) = cboSub2.text
     mFg.TextMatrix(mFg.Row, 4) = cboMutex.text
     mFg.TextMatrix(mFg.Row, 5) = Trim("" & txtMutex.text)
     
     m_bRevise = False
     m_sMutexSubID = ""
     m_sMutexAuthMenuName = ""
Else
    If mFg.Rows = 2 And mFg.TextMatrix(1, 0) = "" Then
        mFg.Rows = 1
    End If
    mFg.AddItem cboSub1.text & vbTab & lVw.SelectedItem.text & vbTab & _
       Trim("" & txtName.text) & vbTab & cboSub2.text & vbTab & cboMutex.text & _
       vbTab & Trim("" & txtMutex.text)
End If

sTb.Tab = 0
sTb.TabEnabled(0) = True
sTb.TabEnabled(1) = False
cboSub1.Enabled = True
lVw.Enabled = True

mnuEditRevise.Enabled = True
mnuEditDelete.Enabled = True
mnuEditCancel.Enabled = False
mnuEditSave.Enabled = False
mnuEditAppend.Enabled = True
tBr.Buttons("Revise").Enabled = True
tBr.Buttons("Delete").Enabled = True
tBr.Buttons("Cancel").Enabled = False
tBr.Buttons("Save").Enabled = False
tBr.Buttons("Append").Enabled = True
End Sub

Private Sub mnuFileExit_Click()
 Unload Me
End Sub

Private Sub tBr_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "Append"
            Call mnuEditAppend_Click
        Case "Delete"
            Call mnuEditDelete_Click
        Case "Save"
            Call mnuEditSave_Click
        Case "Cancel"
            Call mnuEditCancel_Click
        Case "Revise"
            Call mnuEditRevise_Click
        Case "Exit"
            Call mnuFileExit_Click
    End Select
End Sub