main.frm

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

         Caption         =   "-"
      End
      Begin VB.Menu drkw 
         Caption         =   "分数填写表"
      End
      Begin VB.Menu ryusj 
         Caption         =   "数据搜索"
      End
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, _
        ByVal lpFile As String, ByVal lpParameters As String, _
        ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim db As Database
Dim rs As Recordset
Dim GYXEOV As Long
Dim BJS As Long
Dim STR As String

Dim success As String
Dim successa As String
Dim skinini As String


Private Sub ABOUT1_Click()
    On Error Resume Next


    FRMAbout.Show 0, MAIN
End Sub
Private Sub ABOUT3_Click()
    On Error Resume Next

    Me.Enabled = False
    nhb888.Show
End Sub
Private Sub ASDF34GR_Click()
    On Error Resume Next

    MAIN.Enabled = False
    FRMALLNAME.Show
End Sub

Private Sub asrt_Click()
    On Error Resume Next

    MousePointer = vbHourglass
    ABOUTaa.Show 1
    MousePointer = vbDefault
End Sub

Private Sub AUTO_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, "*.*", , 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 "无数据可备份"
        Exit Sub
    Else
        MousePointer = vbHourglass
        SHFileOp.wFunc = FO_COPY
        SHFileOp.pFrom = App.Path & "\DATA\*.*"
        SHFileOp.pTo = App.Path & "\备份"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
        Call SHFileOperation(SHFileOp)
        MousePointer = vbDefault
        MsgBox "执行完毕"
    End If
End Sub
Private Sub AWERPassword_Click()
    On Error Resume Next

    Me.Enabled = False
    frmPassword.Show
End Sub
Private Sub BDJHFX_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "综合分析表.HTM"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT * INTO [HTML Export;DATABASE=C:\ ].[" & nmc & "综合分析表.HTM] FROM  [班主任] "
        db.Close
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "综合分析表.HTM", "", "", SW_SHOW)
    End If
End Sub
Private Sub BFS_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMBFSZ.Show
End Sub
Private Sub BJXF_Click()
    On Error Resume Next

    Me.Enabled = False
    BXF.Show
End Sub
Private Sub BJXM_Click()
    On Error Resume Next

    Me.Enabled = False
    BXN.Show
End Sub
Private Sub BJZH_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMXHBB.Show
End Sub



Private Sub DFG34_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMALLFSB.Show
End Sub
Private Sub dfg56gh_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMmyALLt.Show
End Sub

Private Sub DFTERTDFG_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMBJFSD.Show
End Sub

Private Sub DFYGDS_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMEXCELZH.Show
End Sub

Private Sub drkw_Click()
    On Error Resume Next
    Call TOOL3_Click

End Sub

Private Sub EDIT_Click()
    Me.Enabled = False
    CMD1.CancelError = True
    On Error GoTo 32755
    CMD1.InitDir = App.Path
    CMD1.Flags = cdlOFNHideReadOnly
    CMD1.Filter = "NHB数据文件(*.NHB)|*.NHB|"
    CMD1.FilterIndex = 2
    CMD1.ShowOpen
    DoEvents
    FRMedit.Show
32755:
    Me.Enabled = True
    Exit Sub
End Sub
Private Sub ER5_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMFSD.Show
End Sub
Private Sub EXIT_Click()
    On Error Resume Next

    Me.Enabled = False
    Unload Me
End Sub
Private Sub fha_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMKMFD.Show
End Sub
Private Sub FHRTRYFRGH_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMmyall.Show
End Sub
Private Sub FMUFX_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        Dim AM1 As String
        MousePointer = vbDefault
        MousePointer = vbHourglass
        MousePointer = vbHourglass
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='M1'")
        AM1 = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "分数统计报表.XLS"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT " & AM1 & " INTO [Excel 8.0;DATABASE=C:\" & nmc & "分数统计报表.XLS].[" & nmc & "分数统计报表] FROM  [学生] "
        db.Close
        MousePointer = vbDefault
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "分数统计报表.XLS", "", "", SW_SHOW)
    End If
End Sub
Private Sub Form_Load()
    On Error Resume Next

    SCA.Show
    SCA.Hide
    If App.PrevInstance Then
        MsgBox "程序已经被运行了！"
        End
    End If
    If Not FileExist(App.Path & "\skin\skin.ini") Then
        success = WritePrivateProfileString("Message to Display", "Message", "9", App.Path & "\skin\skin.ini")
    Else
        skinini = ReadWriteINI("GET", "Message to Display", "Message")
    End If
    Skin1.LoadSkin App.Path & "\SKIN\" & skinini & ".sk "
    Skin1.ApplySkin Me.hwnd
    Dim i As Long
    For i = 0 To SKN1.Count - 1
        SKN1(i).Checked = False
    Next
    skinini = ReadWriteINI("GET", "Message to Display", "Message")
    SKN1(skinini).Checked = True
    Unload SCA
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    On Error Resume Next
    emmas.Visible = False

    If Button = 2 Then PopupMenu emmas
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next

    Frmexit.Show
End Sub
Private Sub FSTJ_Click()
    On Error Resume Next

    Me.Enabled = False
    FRNrF.Show
End Sub

Private Sub ftsdfe4_Click()
    On Error Resume Next
    '        MsgBox "此程序演示版,视频文件在正式版中提供", 64, "对不起"
    Dim r As Long
    r = StartDoc(App.Path & "\dict.exe")
End Sub

Private Sub FUMNC_Click()
    On Error Resume Next
    If MAIN.CMD2.filename = "" Then
        MsgBox "数据未载入,无法操作", 32, "提示"
        Exit Sub
    Else
        Dim db As Database
        Dim rs As Recordset
        Dim nmc As String
        Dim AMM1 As String
        MousePointer = vbHourglass
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='名称'")
        nmc = rs![代码]
        db.Close
        Set db = OpenDatabase(MAIN.CMD2.filename)
        Set rs = db.OpenRecordset("SELECT * FROM COM WHERE 标记='MM1'")
        AMM1 = rs![代码]
        db.Close
        SHFileOp.wFunc = FO_DELETE
        SHFileOp.pFrom = "c:\" & nmc & "名次统计报表.XLS"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION + FOF_SILENT
        Call SHFileOperation(SHFileOp)
        Set db = Workspaces(0).OpenDatabase(MAIN.CMD2.filename)
        db.Execute "SELECT " & AMM1 & " INTO [Excel 8.0;DATABASE=C:\" & nmc & "名次统计报表.XLS].[" & nmc & "名次统计报表] FROM  [学生] "
        db.Close
        MousePointer = vbDefault
        MsgBox "数据成功导出在 C:\ 盘,请您另存此数据", 32, "操作完成"
        ret = ShellExecute(Me.hwnd, "open", "C:\" & nmc & "名次统计报表.XLS", "", "", SW_SHOW)
    End If
End Sub
Private Sub FXBST_Click()
    On Error Resume Next

    Me.Enabled = False
    FSD.Show
End Sub
Private Sub GHOST_AUTO_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 & "\备份"
    colDirs.Add pathdir
    intDirsFound = FindAllFiles(pathdir, "*.*", , 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 "无备份数据可恢复"
        Exit Sub
    Else
        MousePointer = vbHourglass
        SHFileOp.wFunc = FO_COPY
        SHFileOp.pFrom = App.Path & "\备份\*.NHB"
        SHFileOp.pTo = App.Path & "\DATA"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
        Call SHFileOperation(SHFileOp)
        MousePointer = vbDefault
        MsgBox "执行完毕"
    End If
End Sub
Private Sub GHOST_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMzHY.Show
End Sub

Private Sub gu_Click()
    On Error Resume Next

    Call FSTJ_Click

End Sub

Private Sub jass_Click()
    On Error Resume Next
    Call SXZHBB_Click

End Sub

Private Sub KMLX_Click()
    On Error Resume Next

    Me.Enabled = False
    FRMSETKM.Show
End Sub
Private Sub KSLX_Click()