frmexit.frm

1.如果在向导设置班级数为8时,此数值为班级总数

VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "actskin4.ocx"
Begin VB.Form Frmexit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "退出程序"
   ClientHeight    =   1815
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4845
   Icon            =   "Frmexit.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1815
   ScaleWidth      =   4845
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   1545
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   3465
      Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1 
         Height          =   1275
         Left            =   90
         OleObjectBlob   =   "Frmexit.frx":1D42
         TabIndex        =   4
         Top             =   210
         Width           =   3105
      End
   End
   Begin VB.CommandButton EXIT 
      Caption         =   "直接退出"
      Height          =   435
      Left            =   3750
      TabIndex        =   2
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton SAVE 
      Caption         =   "备份退出"
      Height          =   435
      Left            =   3750
      TabIndex        =   1
      Top             =   180
      Width           =   975
   End
   Begin VB.CommandButton UNEXIT 
      Caption         =   "取消退出"
      Height          =   405
      Left            =   3750
      TabIndex        =   0
      Top             =   1260
      Width           =   975
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   3810
      OleObjectBlob   =   "Frmexit.frx":1E15
      Top             =   -30
   End
End
Attribute VB_Name = "Frmexit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SHFileOp As SHFILEOPSTRUCT
Private Sub EXIT_Click()
    On Error Resume Next

    Unload Me
    End
End Sub
Private Sub Form_Load()
    On Error Resume Next
    '    Skin1.LoadSkin App.Path & "\SKIN\0.sk"
    Skin1.ApplySkin Me.hwnd
End Sub
Private Sub SAVE_Click()
    On Error Resume Next
    Dim colFiles As New Collection
    Dim colDirs As New Collection
    Dim intDirsFound As Integer
    Dim vntItem As Variant
    Dim pathdir As String
    pathdir = App.Path & "\DATA"
    colDirs.Add pathdir
    intDirsFound = FindAllFiles(pathdir, "*.NHB", , colDirs, True)
    For Each vntItem In colDirs
        FindAllFiles CStr(vntItem), "*.nhb", colFiles
    Next vntItem
    ' Me.Caption = CStr(colFiles.Count) & "个文件被找到，查找" & STR(intDirsFound) & "个目录"
    If CStr(colFiles.Count) = 0 Then
        MsgBox "无数据可备份", 32, "程序首次使用"
        Kill "C:\*.xls"
        Kill "C:\*.HTM"
        Kill App.Path & "\temp\*.*"
        End
    Else
        MousePointer = vbHourglass
        SHFileOp.wFunc = FO_COPY
        SHFileOp.pFrom = App.Path & "\DATA\*.NHB"
        SHFileOp.pTo = App.Path & "\备份"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
        Call SHFileOperation(SHFileOp)
        Kill "C:\*.xls"
        Kill "C:\*.HTM"
        Kill App.Path & "\temp\*.*"
        End
    End If
End Sub
Private Sub UNEXIT_Click()
    On Error Resume Next

    Unload Me
    MAIN.Enabled = True
    MAIN.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    On Error Resume Next
    Kill "C:\*.xls"
    Kill "C:\*.HTM"
    Kill App.Path & "\temp\*.*"
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
End Sub