frmdang.frm

教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库

FRMDANG.Picture = LoadPicture(App.Path + "\ICON\bAKGRD5.jpg")
PIC = App.Path + "\ICON\bAKGRD5.jpg"
error:
Exit Sub
End Sub

Private Sub MENU1227_Click()
On Error GoTo error
FRMDANG.Picture = LoadPicture(App.Path + "\ICON\bAKGRD6.jpg")
PIC = App.Path + "\ICON\bAKGRD6.jpg"
error:
Exit Sub
End Sub
Private Sub MENU1231_Click()
On Error GoTo error
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m00.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
error:
Exit Sub
End Sub

Private Sub MENU1232_Click()
On Error GoTo error
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m01.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
error:
Exit Sub
End Sub

Private Sub MENU1233_Click()
On Error GoTo error
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m02.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
error:
Exit Sub
End Sub

Private Sub MENU1234_Click()
On Error GoTo error
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m03.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
error:
Exit Sub
End Sub

Private Sub MENU1235_Click()
On Error GoTo ERR
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m04.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
ERR:
Exit Sub
End Sub

Private Sub menu1236_Click()
On Error GoTo ERR
frmWave.mciWave.Wait = True
ppp = App.Path + "\music\m05.mid"
Open App.Path + "\system\music.txt" For Output As #1
Write #1, ppp
Close #1
Load frmWave
MENU1232.Enabled = False
MENU1233.Enabled = False
MENU1234.Enabled = False
MENU1231.Enabled = False
MENU1235.Enabled = False
menu1236.Enabled = False
ERR:
Exit Sub
End Sub

Private Sub MENU1237_Click()
On Error GoTo ERR
Unload frmWave
MENU1231.Enabled = True
MENU1232.Enabled = True
MENU1233.Enabled = True
MENU1234.Enabled = True
MENU1235.Enabled = True
menu1236.Enabled = True
ERR:
Exit Sub
End Sub

Private Sub MENU1238_Click()
Load frmCD
frmCD.Show
End Sub

Private Sub MENU124_Click()
Load FRMPATH
FRMPATH.Show

End Sub

Private Sub MENU3_Click()
FRMDANG.Enabled = False
Load frmDataGrid
frmDataGrid.Show
End Sub

Private Sub MENU5_Click()
Load FRMCOUNT
FRMCOUNT.Show
FRMDANG.Enabled = False
End Sub

Private Sub MENU6_Click()
FRMDANG.Enabled = False
Load frmquey
frmquey.Show
End Sub

Private Sub MENU71_Click()
On Error GoTo ERR
Dim ttt, nnn As String
ttt = App.Path + "\system\" + "note.txt"
X = Shell(winpath & "\Notepad " + ttt, 1)
Exit Sub
ERR:
MsgBox "请在[系统设置]中正确设置 WIN95的安装路径", 48, vbOKOnly
End Sub

Private Sub MENU72_Click()
FRMDANG.Enabled = False
Load Frmhelp
Frmhelp.Show
End Sub

Private Sub MENU73_Click()
On Error GoTo ERR
X = Shell(winpath & "\msapps\msinfo\msinfo.exe", 1)
Exit Sub
ERR:
Exit Sub
End Sub

Private Sub MENU81_Click()
On Error GoTo ERR
'X = Shell(App.Path + "\wordpad.exe", 1)
X = Shell(winpath & "\Write.EXE", 1)
Exit Sub
ERR:
MsgBox "请在[系统设置]中正确设置 WIN95的安装路径", 48, vbOKOnly
End Sub

Private Sub MENU82_Click()
On Error GoTo ERR
X = Shell(winpath & "\CALC.EXE", 1)
Exit Sub
ERR:
MsgBox "请在[系统设置]中正确设置 WIN95的安装路径", 48, vbOKOnly
End Sub

Private Sub MENU83_Click()
On Error GoTo ERR
X = Shell(App.Path + "\play\SOL.EXE", 1)
ERR:
Exit Sub
End Sub

Private Sub MENU84_Click()
On Error GoTo ERR
X = Shell(App.Path + "\play\WINMINE.EXE", 1)
ERR:
Exit Sub
End Sub

Private Sub MENU85_Click()
On Error GoTo ERR
X = Shell(winpath & "\CDPLAYER.EXE", 1)
Exit Sub
ERR:
MsgBox "请在[系统设置]中正确设置 WIN95的安装路径", 48, vbOKOnly
End Sub

Private Sub MENUADD_Click()
FRMDANG.Enabled = False
Load FRMADD
FRMADD.Show
End Sub

Private Sub menuexit_Click()
Open App.Path + "\system\PIC.TXT" For Output As #1
Write #1, PIC
Close #1
End
End Sub

Private Sub MENUOUT_Click()
On Error GoTo ERR
X = Shell(winpath & "\EXPLORER.EXE /n,/e,c:\", 1)
Exit Sub
ERR:
MsgBox "请在[系统设置]中正确设置 WIN95的安装路径", 48, vbOKOnly
End Sub

Private Sub MENUPRO_Click()
'Load MainForm
'MainForm.Show
End Sub

Private Sub MENUSECU_Click()
FRMDANG.Enabled = False
Load FRMPASS
FRMPASS.Show
End Sub

Private Sub MNUDATAIN_Click()
On Error GoTo ERR
Dim DB1 As Database
Dim db2 As Database
Dim rec1 As Recordset
Dim rec2 As Recordset
Dim i, j, k, m As Integer
Dim X, Y As Integer
Dim sql As String

  If MsgBox("您确信要导入A盘数据?", vbInformation + vbOKCancel) = vbOK Then
  '是
      Set DB1 = OpenDatabase("a:\student.mdb", False, False)
      Set db2 = OpenDatabase(App.Path + "\database\student.mdb", False, False)
      Set rec1 = DB1.OpenRecordset("stud1", dbOpenDynaset)
      Set rec2 = db2.OpenRecordset("stud1", dbOpenDynaset)
      rec1.MoveLast
      X = rec1.AbsolutePosition + 1
      If X = 0 Then
      MsgBox "A:盘数据库为空，请重新换一张盘！", vbInformation + vbOKOnly
      End If
      rec1.MoveFirst
      rec2.MoveLast
      Y = rec2.AbsolutePosition + 1
      rec2.MoveFirst
             rec1.MoveFirst
             For i = 1 To X
                 rec2.MoveFirst
                 For j = 1 To rec2.RecordCount
                    If rec2(0).value = rec1(0).value And rec2(2).value = rec1(2).value Then
                    rec2.Delete
                    End If
                   rec2.MoveNext
                   If j > rec2.RecordCount Then
                   GoTo 2
                   End If
                   
               Next j
2:              rec1.MoveNext
          Next i
      rec1.MoveFirst
            Do Until rec1.EOF
            rec2.AddNew
            For k = 0 To 15
            rec2(k).value = rec1(k).value
            Next k
            rec2.Update
            rec1.MoveNext
            Loop
            'sql = "insert into stud1(姓名,性别,出生日期,民族,生源,家庭出生,文化程度,班级,所在年级,申请时间,通过时间,审批时间,调档时间,转正时间,转档时间) "
            'sql = sql + "values('" + Trim(rec!姓名) + "','" + Trim(rec!性别) + "','" + Trim(CDate(rec!出生日期)) + "','" + Trim(rec!民族) + "','" + Trim(rec!生源) + "','" + Trim(rec!家庭出生) + "','" + Trim(rec!文化程度) + "','" + Trim(rec!班级) + "','" + Trim(rec!所在年级) + "','" + Trim(CDate(rec!申请时间)) + "','" + Trim(CDate(rec!通过时间)) + "','" + Trim(CDate(rec!审批时间)) + "','" + Trim(CDate(rec!调档时间)) + "','" + Trim(CDate(rec!转正时间)) + "','" + Trim(CDate(rec!转档时间)) + "')"
            'db2.Execute sql
      db2.Recordsets.Refresh
        Else
  Exit Sub
  End If
  MsgBox "导入工作完成！", vbInformation + vbOKOnly
  Exit Sub
ERR:
    MsgBox "操作出现问题，请检查数据库是否为空或是否有不合格数据！", vbInformation + vbOKOnly
        
End Sub

Private Sub MNUFILENEW_Click()
 On Error GoTo 1
  MsgBox "请插入A盘并确保有足够的空间！", vbInformation + vbOKOnly
  FileCopy App.Path + "\database\student.mdb", "a:\student.mdb"
   MsgBox "拷贝成功！", vbInformation + vbOKOnly
  Exit Sub
1: MsgBox "拷贝无效，请插入另一张盘重试！", vbInformation + vbOKOnly
End Sub

Private Sub MNUFILEOLD_Click()
 On Error GoTo 1
  MsgBox "请插入A盘并确保有足够的空间！", vbInformation + vbOKOnly
  FileCopy App.Path + "\database\oldstudent.mdb", "a:\oldstudent.mdb"
  MsgBox "拷贝成功！", vbOKOnly
  Exit Sub
1: MsgBox "拷贝无效，请插入另一张盘重试！", vbInformation + vbOKOnly
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If i = 0 Then
Image1.Picture = LoadPicture(App.Path + "\icon\1.jpg")
i = 1
Else
If i = 1 Then
Image1.Picture = LoadPicture(App.Path + "\icon\2.jpg")
i = 2
Else
If i = 2 Then
Image1.Picture = LoadPicture(App.Path + "\icon\3.jpg")
i = 3
Else
If i = 3 Then
Image1.Picture = LoadPicture(App.Path + "\icon\4.jpg")
i = 4
Else
If i = 4 Then
Image1.Picture = LoadPicture(App.Path + "\icon\5.jpg")
i = 5
Else
If i = 5 Then
Image1.Picture = LoadPicture(App.Path + "\icon\6.jpg")
i = 6
Else
If i = 6 Then
Image1.Picture = LoadPicture(App.Path + "\icon\7.jpg")
i = 7
Else
If i = 7 Then
Image1.Picture = LoadPicture(App.Path + "\icon\8.jpg")
i = 1
End If
End If
End If
End If
End If
End If
End If
End If
End Sub