Begin VB.Menu MNUCOLOR 
         Caption         =   "設置背景顏色"
      End
   End
End
Attribute VB_Name = "Frmstart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WORD As Object
Dim dbOldStudent As Database
Dim recSource As Recordset
Dim PIC As String
Sub InitBField()
  On Error Resume Next
  XuehaoLD = False
  BasField(1) = " XH,XM,BJ,YX,XL ": BasFldCnt(1) = 5
  BasField(2) = " XH,XM,BJ,YX,XL ": BasFldCnt(2) = 5
  BasField(3) = " XH,XM,BJ ": BasFldCnt(3) = 3
  BasField(4) = " XH,XM,BJ,YX,NJ,XL,SY,LTKHM,SFZHM ": BasFldCnt(4) = 9
  BasField(5) = " XH,XM,BJ,YX,NJ,SY,LTKHM ": BasFldCnt(5) = 7
  BasField(6) = " XH,XM,XB,YX,BJ,HKSX,SS,DH ": BasFldCnt(6) = 8
  BasField(7) = " XH,XM,BJ,YX,SY,ZZMM ": BasFldCnt(7) = 6
End Sub
Private Sub cmdExit_Click()
On Error Resume Next
If MsgBox("確信要退出系統?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Dbstudent.Close
Timer4.Enabled = False
Set Frmstart = Nothing
'卸載所有窗體
Dim I As Integer
While Forms.Count > 1
    I = 0
    While Forms(I).Caption = Me.Caption
         I = I + 1
    Wend
    Unload Forms(I)
Wend
Unload Me
End
End Sub
Private Sub Form_Load()
On Error Resume Next
'SF1.Left = 0
'SF1.Top = 0
'SF1.Width = Screen.Width
'GifAni1.Top = -100
'GifAni1.Left = Screen.Width - 740
 InitBField  '后面要用
Set Dbstudent = OpenDatabase(App.Path + "\database\student.mdb", True, False, ";PWD=62414968;")
Open App.Path + "\SYSTEM\PIC.TXT" For Input As #1
Input #1, PIC
Close #1
'Frmstart.Picture = LoadPicture(PIC)
Dim col As String
Open App.Path + "\system\winpath.txt" For Input As #1
Input #1, col
Close #1
App.HelpFile = App.Path + "\help\student.hlp"
''''''FlatBar1.SetToolBAar Toolbar1, 2
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set Frmstart = Nothing
Dim I As Integer
While Forms.Count > 1
    I = 0
    While Forms(I).Caption = Me.Caption
         I = I + 1
    Wend
    Unload Forms(I)
Wend
Unload Me
End

End Sub

Private Sub MNUBASE1_Click()
frmBaseInput.Show 1
End Sub

Private Sub MNUBASE2_Click()
frmGridModify.Show 1
End Sub

Private Sub MNUBASE3_Click()
frmQuery.Show 1
End Sub

Private Sub MNUBASE4_Click()
frmCount.Show 1
End Sub

Private Sub MNUBXKC_Click()
FRMMARKIN.Show 1
End Sub

Private Sub MNUCANCEL_Click()
MNUCANCEL.Checked = True
Frmstart.Picture = LoadPicture("")
Dim PIC As String
Open App.Path + "\SYSTEM\PIC.TXT" For Output As #1
PIC = ""
Write #1, PIC
Close #1
End Sub

Private Sub MNUCONGDU_Click()
FRMCONGDU.Show 1
'GSDATABASE = App.Path + "\DATABASE\MARK.MDB"
'GSRECORDSOURCE = "XXKC"
End Sub

Private Sub mnuDataDR1_Click()
On Error GoTo err
Dim AA As Boolean
AA = FileExists("A:\STUDENT.MDB")
If AA = False Then
MsgBox "軟盤上不存在數據庫文件,請檢查軟盤上內容!", vbCritical, "出錯信息"
Exit Sub
Else
'End If
If MsgBox("您確信開始導入數據？", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Set dbOldStudent = OpenDatabase("a:\student.mdb", False, False)
MsgBox "開始導入基本信息表中內容,請等待......", vbInformation, "導入數據過程之一"
Screen.MousePointer = 11
CopyRecordXH "zbqkb", 20
MsgBox "開始導入家庭情況表中內容,請等待......", vbInformation, "導入數據過程之二"
Screen.MousePointer = 11
CopyRecordXH "jtqkb", 12
dbOldStudent.Close
Exit Sub
End If
err:
MsgBox "導入過程出錯，請檢查軟盤是否插入軟驅或軟盤上是否存在數據庫文件！", vbCritical, "出錯提示"
Screen.MousePointer = 0
End Sub


Private Sub mnuDataRC1_Click()
On Error GoTo err
Dim AA As Boolean
AA = FileExists("A:\STUDENT.MDB")
If AA = True Then
        
        If MsgBox("軟盤上已存在相同的數據文件,是否要覆蓋該文件?", vbQuestion + vbYesNo) = vbNo Then
           Exit Sub
        End If
 Else
   
        DrvFact1.DriveLetter = "A:"
        If DrvFact1.FreeSize <= 1 Then
        MsgBox "軟盤是沒有足夠的空間,請換插一張空盤!", vbInformation + vbOKOnly, "錯誤信息"
        Exit Sub
        End If
End If

Screen.MousePointer = 11
'MsgBox "先復制空數據庫到軟盤,確定后請等待......", vbInformation + vbOKOnly, "數據導出過程步驟之一"
FileCopy App.Path + "\emptydatabase\student.mdb", "a:\student.mdb"
MsgBox "開始導出基本情況表中數據到軟盤,確定后請等待......", vbInformation + vbOKOnly, "數據導出過程之一"
CopyRecordOut0 "zbqkb", 20
MsgBox "開始導出家庭情況表中數據到軟盤,確定后請等待......", vbInformation + vbOKOnly, "數據導出過程之二"
CopyRecordOut0 "jtqkb", 12

Screen.MousePointer = 0
Exit Sub
err:
MsgBox "請檢查是否軟盤為空或是否軟盤插入軟驅中!", vbCritical + vbOKOnly, "出錯提示"
End Sub

Private Sub MNUEXIT_Click()
On Error Resume Next
If MsgBox("確信要退出系統?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Dbstudent.Close
'Timer4.Enabled = False
Set Frmstart = Nothing
'卸載所有窗體
Dim I As Integer
While Forms.Count > 1
    I = 0
    While Forms(I).Caption = Me.Caption
         I = I + 1
    Wend
    Unload Forms(I)
Wend
Unload Me
End
End Sub
Private Sub MNUHELP2_Click()
Dim TTT  As String
TTT = App.Path + "\help\STUDENT.hlp"
X = Shell("winhelp " + TTT, 1)
End Sub

Private Sub MNUHELP3_Click()
Frmhelp.Show 1
End Sub

Private Sub MNUMARK1_Click()
frmMark.Show 1
End Sub

Private Sub MNUMARKADD_Click()
FRMDATABASE.Show 1
End Sub

Private Sub MNUOP_Click()
On Error Resume Next
 Dim sFile As String
    With CDlog1
        'To Do
        '設置 common dialog 控件的標志和屬性
        .Filter = "文本文件(*.txt)|*.txt|Word文檔" & _
                  "(*.doc)|*.doc|Excel文檔(*.xls)|*.xls"
' 指定缺省的過濾器
        .FilterIndex = 2
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With

'文本文檔
If Right(Trim(sFile), 3) = "txt" Then
Dim X
X = Shell("Notepad " + sFile, 1)
End If

'Word文檔
If Right(Trim(sFile), 3) = "doc" Then
Set WORD = CreateObject("Word.BASIC")
With WORD
     .FILEOPEN sFile
     .APPSHOW
End With
Set WORD = Nothing
End If

'EXCEL文檔
If Right(Trim(sFile), 3) = "xls" Then
Dim Excel As Object
Dim WorkSheet As Object
Dim WorkBook As Object
Set Excel = CreateObject("Excel.application")
Excel.Workbooks.Open sFile
Set WorkBook = Excel.ActiveWorkbook
Set WorkSheet = Excel.ActiveSheet
Excel.Visible = True
WorkBook.Saved = True
Set WorkSheet = Nothing
Set WorkBook = Nothing
Set Excel = Nothing
End If
End Sub

Private Sub MNUQUERY_Click()
FRMSQLMARK.Show 1
End Sub

Private Sub MNUWJ11_Click()
 On Error Resume Next
 Dim sFile As String
    With CDlog1
        'To Do
        '設置 common dialog 控件的標志和屬性
        .Filter = "BMP圖像格式(*.BMP)|*.BMP|JPG圖像格式" & _
                  "(*.JPG)|*.JPG|wmf圖像格式(*.wmf)|*.wmf|所有文件(*.*)|*.*"
' 指定缺省的過濾器
        .FilterIndex = 2
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
Frmstart.Picture = LoadPicture(sFile)
Open App.Path + "\SYSTEM\PIC.TXT" For Output As #1
Write #1, sFile
Close #1
MNUCANCEL.Checked = False

End Sub

Private Sub MNUWJ12_Click()
frmSystemUserModify.Show 1
End Sub

Private Sub MNUWJ13_Click()
frmSystemNewUser.Show 1
End Sub

Private Sub MNUWJ14_Click()
Dim ABC As String
Dim DBSTU As Database
Dim Recuser As Recordset
10:
ABC = InputBox("請輸入'系統管理員'的密碼:", "管理員權限")
If ABC = "" Then Exit Sub
If ABC = "yiyou" Then
Frmdefine.Show 1
Exit Sub
End If
Set DBSTU = OpenDatabase(App.Path + "\database\student.mdb", True, False, ";PWD=62414968;")
Set Recuser = DBSTU.OpenRecordset("select * from user", dbOpenSnapshot)
sqlFind = "user='系統管理員' and pwd='" + Trim(ABC) + "'"
Recuser.FindFirst sqlFind
If Recuser.NoMatch Then
MsgBox "密碼錯誤,重試!", vbExclamation, "錯誤提示"
GoTo 10
Else
Frmdefine.Show 1
End If

End Sub

Public Sub CopyRecordXH(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim sqlForCopy As String
Dim recSource As Recordset
Dim recDest As Recordset
Dim recRepeat As Recordset
Dim sqlDest As String
sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = dbOldStudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

If recSource.RecordCount > 0 Then
'處理重復數據并復制數據
    '讀第一條記錄
    recSource.MoveLast
    recSource.MoveFirst
    sqlDest = "select top 1 * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
    Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
    If recRepeat.RecordCount > 0 Then
        If MsgBox("您確定替換" & "" + Trim(recRepeat!XM) + "", vbInformation + vbOKCancel) = vbOK Then
            sqlDest = "delete * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
            Dbstudent.Execute sqlDest
             '復制第一條記錄
            Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
            recDest.AddNew
            For K = 1 To Number
              recDest.Fields(K).Value = recSource.Fields(K).Value
            Next K
            recDest.Update
        End If
    Else
        Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
        recDest.AddNew
        For K = 1 To Number
          recDest.Fields(K).Value = recSource.Fields(K).Value
        Next K
        recDest.Update
    End If
    '處理余下記錄
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      sqlDest = "select top 1 * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
      Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
      If recRepeat.RecordCount > 0 Then
          If MsgBox("您確定替換" & "" + Trim(recRepeat!XM) + "", vbInformation + vbOKCancel) = vbOK Then
              sqlDest = "delete * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"