frmlistaccounts.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form frmListAccounts 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "账套列表"
   ClientHeight    =   4125
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7815
   Icon            =   "frmListAccounts.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4125
   ScaleWidth      =   7815
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.CommandButton cmdDetail 
      Caption         =   "详细(&D)"
      Default         =   -1  'True
      Height          =   345
      Left            =   3840
      TabIndex        =   1
      Top             =   3720
      WhatsThisHelpID =   3
      Width           =   1065
   End
   Begin MSComctlLib.ListView lvwAcc 
      Height          =   3615
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7815
      _ExtentX        =   13785
      _ExtentY        =   6376
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton cmdQuit 
      Cancel          =   -1  'True
      Caption         =   "退出(&Q)"
      Height          =   345
      Left            =   6600
      TabIndex        =   3
      Top             =   3720
      Width           =   1065
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除(&E)"
      Height          =   345
      Left            =   5220
      TabIndex        =   2
      Top             =   3720
      WhatsThisHelpID =   3
      Width           =   1065
   End
End
Attribute VB_Name = "frmListAccounts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdDetail_Click()
    Dim frmD As frmListDetail
    
    Set frmD = New frmListDetail
    With frmD
        .usAccID = lvwAcc.SelectedItem.text
        .Show 1
    End With
    
End Sub

Private Sub Form_Load()
    Dim rstAccount As ADODB.Recordset
    Dim i As Long
    Dim ItmX As ListItem
    On Error Resume Next
    Set rstAccount = New ADODB.Recordset
    With lvwAcc
        .View = lvwReport
        With .ColumnHeaders
            .Add , , "账套号", 1000
            .Add , , "名称", 1500
            .Add , , "启用年月", 1100
            .Add , , "使用单位", 3000
            .Add , , "主管", 800
            .Add
        End With
    End With
    
    With rstAccount
        .CursorLocation = adUseClient
        .Open "select * from tSYS_Account order by accountid,beginyear,beginmonth", _
                    gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
            Do Until .EOF
                Set ItmX = lvwAcc.ListItems.Add(, , .Fields("accountID").Value)
                ItmX.SubItems(1) = .Fields("accountName").Value
                ItmX.SubItems(2) = .Fields("beginYear").Value & "年" & _
                             .Fields("beginMonth").Value & "月"
                ItmX.SubItems(3) = .Fields("entername").Value
                ItmX.SubItems(4) = .Fields("master").Value
                .MoveNext
            Loop
        Else
            cmdDetail.Enabled = False
            cmdDelete.Enabled = False
        End If
        .Close
    End With
    
End Sub



Private Sub cmdDelete_Click()
    Dim adoCmd As ADODB.Command
    Dim sAccID As String
    
    If MsgBox("确实要删除吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
        sAccID = lvwAcc.SelectedItem.text
        If MsgBox("再次警示：确实要删除账套“" & sAccID & "”吗？", vbQuestion _
                    + vbYesNo + vbDefaultButton2) = vbYes Then
            On Error GoTo errorhandler
            
            Me.MousePointer = vbHourglass
            
            Set adoCmd = New ADODB.Command
            adoCmd.ActiveConnection = gloSys.cnnSys
            adoCmd.CommandType = adCmdText
            
        '---Trans Begin---
            gloSys.cnnSys.BeginTrans
            
            'Step1.删除数据库/用户
            Select Case g_FLAT
                Case "SQL"
                    adoCmd.CommandText = "drop database cwDB" & sAccID
                    adoCmd.Execute
                Case "ORACLE"
                    adoCmd.CommandText = "drop user cwDB" & sAccID & " CASCADE"
                    adoCmd.Execute
            End Select
            
            'Step2.在系统库的账套管理表中删除记录
            adoCmd.CommandText = "delete from tSYS_account where accountID='" & _
                    sAccID & "'"
            adoCmd.Execute
            
            'Step3.删除其会计期记录、账套主管人员记录及相应权限设置记录等
            adoCmd.CommandText = "delete from tSYS_period where accountID='" & sAccID & "'"
            adoCmd.Execute
            adoCmd.CommandText = "delete from tSYS_user where userID='" & sAccID & "'"
            adoCmd.Execute
            adoCmd.CommandText = "delete from tSYS_UserAuth where accountID='" & sAccID & "'"
            adoCmd.Execute
    
            'Step4.删除其子系统启用记录
            adoCmd.CommandText = "delete from tSYS_SubSysUsed where accountID='" & sAccID & "'"
            adoCmd.Execute
            
            If MsgBox("一并清除在该账套上运行的日志记录吗？", vbQuestion + vbYesNo) = vbYes Then
            'Step5.删除该账套的运行记录
                adoCmd.CommandText = "delete from tSYS_Manage where AccountID='" & sAccID & "'"
                adoCmd.Execute
            End If
            
'            If g_FLAT = "ORACLE" Then
'                adoCmd.CommandText = "COMMIT"
'                adoCmd.Execute
'            End If

            gloSys.cnnSys.CommitTrans
        '---Trans Commit---
            
            '移除 ListView 中的一项
            lvwAcc.ListItems.Remove lvwAcc.SelectedItem.index
            If lvwAcc.ListItems.Count = 0 Then
                cmdDelete.Enabled = False
                cmdDetail.Enabled = False
            End If
        End If
    End If
    
    Me.MousePointer = vbDefault
    
    Exit Sub
errorhandler:
    
    Me.MousePointer = vbDefault
    
    MsgBox "发生错误。" & vbCr & vbCr & Err.Number & vbTab & _
                    Err.Description & vbCr & vbCr & _
            "请联系系统管理员以解决删除不完全可能遗留的问题。", vbCritical, "提示"
    '如果发生错误，则事务回滚(Trans Rollback)
    gloSys.cnnSys.RollbackTrans
    Err.Clear
    
End Sub


Private Sub cmdQuit_Click()
    Unload Me
End Sub