frmzbf.frm

大型商业学分统计系统原代码说明 1.如果在向导设置班级数为8时,此数值为班级总数

VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "actskin4.ocx"
Object = "{19B7F2A2-1610-11D3-BF30-1AF820524153}#1.2#0"; "CCRPFTV6.OCX"
Begin VB.Form FRMzBF 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "指定目录备份"
   ClientHeight    =   5040
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   3435
   Icon            =   "FRMzBF.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5040
   ScaleWidth      =   3435
   StartUpPosition =   2  '屏幕中心
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   2400
      OleObjectBlob   =   "FRMzBF.frx":08CA
      Top             =   5400
   End
   Begin VB.CommandButton Command2 
      Caption         =   "备  份"
      Height          =   525
      Left            =   1200
      TabIndex        =   2
      Top             =   4200
      Width           =   1005
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退  出"
      Height          =   525
      Left            =   2340
      TabIndex        =   1
      Top             =   4200
      Width           =   1005
   End
   Begin CCRPFolderTV6.FolderTreeview FolderTreeview1 
      Height          =   4140
      Left            =   0
      TabIndex        =   0
      Top             =   -30
      Width           =   3435
      _ExtentX        =   6059
      _ExtentY        =   7303
      RootFolder      =   "我的电脑"
      SelectedFolder  =   "我的电脑"
   End
   Begin ACTIVESKINLibCtl.SkinLabel SkinLabel4 
      Height          =   345
      Index           =   2
      Left            =   60
      OleObjectBlob   =   "FRMzBF.frx":0AFE
      TabIndex        =   3
      Top             =   4800
      Width           =   3315
   End
End
Attribute VB_Name = "FRMzBF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SHFileOp As SHFILEOPSTRUCT
Private Sub Command1_Click()
    On Error Resume Next

    Unload Me
End Sub
Private Sub Command2_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
    If FolderTreeview1.SelectedFolder = "我的电脑" Or FolderTreeview1.SelectedFolder = "" Then
        MsgBox "请指定正确的目录进行备份", 32, "目录无效"
    Else
        MousePointer = vbHourglass
        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 "无数据可备份"
            MousePointer = vbDefault
            Exit Sub
        Else
            MousePointer = vbHourglass
            SHFileOp.wFunc = FO_COPY
            SHFileOp.pFrom = App.Path & "\DATA\*.NHB"
            SHFileOp.pTo = FolderTreeview1.SelectedFolder
            SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
            Call SHFileOperation(SHFileOp)
            MousePointer = vbDefault
            MsgBox "执行完毕"
        End If
    End If
    MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    On Error Resume Next
    MAIN.Enabled = False
    Skin1.LoadSkin App.Path & "\SKIN\3.sk"
    Skin1.ApplySkin Me.hwnd
    Text1.Text = FolderTreeview1.SelectedFolder
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
    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
    MAIN.Enabled = True
End Sub