frmstudent.frm

这是一个用vb写的学生管理系统

          cmdFirst.Enabled = False
      Else
          cmdPrevious.Enabled = True
          cmdFirst.Enabled = True
      End If
      ''假如处于记录的尾部
      If .EOF Then
          If Not .BOF Then DataEnv.rsStudent.MoveLast
          cmdNext.Enabled = False
          cmdLast.Enabled = False
      Else
          cmdNext.Enabled = True
          cmdLast.Enabled = True
      End If
    End With
    mstrFileName = ""
End Sub

Private Sub cboDep_Click()
    Dim rsClass As New ADODB.Recordset
    Dim strSQL
    '根据所选的系的不同，采用不同的SQL语句
    If cboDep.ItemData(cboDep.ListIndex) = 0 Then
        strSQL = "select * from 班级信息表"
    Else
        strSQL = "select * from 班级信息表 where dept_id=" & cboDep.ItemData(cboDep.ListIndex)
    End If
    rsClass.Open strSQL, DataEnv.Con
    '将所查到的rsClass中的内容来填充cboClass
    cboClass.Clear
    cboClass.AddItem "全部"
    While Not rsClass.EOF
        cboClass.AddItem rsClass("Name")
        rsClass.MoveNext
    Wend
    cboClass.ListIndex = 0
    
    rsClass.Close
    Set rsClass = Nothing
End Sub

Private Sub cmdAdd_Click()
   '添加记录
   fraSeek.Enabled = False
   fraBrowse.Enabled = False
   grdScan.Enabled = False
   DataEnv.rsStudent.AddNew
   dtpBirth.Value = "1980-01-01"
   fraInfo.Enabled = True
   fraBrowse.Enabled = False
   cmdAdd.Enabled = False
   cmdEdit.Enabled = False
   cmdDelete.Enabled = False
   cmdUpdate.Enabled = True
   cmdReport.Caption = "取消"
   cmdReport.Enabled = True
   mbClose = False                   '不能关闭窗口
End Sub

Private Sub cmdDelete_Click()
    '如果出错，则显示错误代码
  On Error GoTo errHandler
  If MsgBox("要删除记录?", vbYesNo + vbQuestion + vbDefaultButton2, "确认") = vbYes Then
        '通过在DataEnv.Con中执行SQL命令，来删除记录
      DataEnv.Con.Execute "delete from 学生信息表 where serial ='" & txtSerial & "'"
      DataEnv.rsStudent.MoveNext
      If DataEnv.rsStudent.EOF Then DataEnv.rsStudent.MoveLast
      '刷新用户导航的网格控件
      Call RefreshGrid
  End If
  Exit Sub
errHandler:
  MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdEdit_Click()
    '编辑记录之前，需要设置其他控件的Enabled属性
    fraSeek.Enabled = False
    fraBrowse.Enabled = False
    grdScan.Enabled = False
    fraInfo.Enabled = True
    cmdAdd.Enabled = False
    cmdEdit.Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = True
    cmdReport.Caption = "取消"    ''更改cmdReport标题
    cmdReport.Enabled = True
    mbClose = False              '出于编辑状态，则用户不能关闭窗口
End Sub

Private Sub cmdFirst_Click()
    '移动到记录的头部，并改变各个浏览按钮的状态
    DataEnv.rssqlSeek.MoveFirst
    DataEnv.rssqlSeek.MovePrevious
    Call ChangeBrowseState
End Sub

Private Sub cmdLast_Click()
    '移动到记录的尾部，并改变各个浏览按钮的状态
    DataEnv.rssqlSeek.MoveLast
    DataEnv.rssqlSeek.MoveNext
    Call ChangeBrowseState
End Sub

Private Sub cmdList_Click()
    '针对所选的班级，列出班级中所有的学籍信息
    Dim strSQL
    If cboClass.Text = "全部" Then
        strSQL = " from 学生信息表 order by serial"
    Else
        strSQL = " from 学生信息表 where class='" & cboClass & "' order by serial"
    End If
    DataEnv.rsStudent.Close
    DataEnv.rsStudent.Open "select * " & strSQL
    DataEnv.rssqlSeek.Close
    DataEnv.rssqlSeek.Open "select serial, name " & strSQL
    '刷新用户导航的网格控件，并且根据记录集中记录的数目，来改变各个浏览按钮的状态。
    Call RefreshGrid
    Call ChangeBrowseState
    Call grdScan_Change
End Sub

Private Sub cmdNext_Click()     '移动到记录的下一条
    DataEnv.rssqlSeek.MoveNext
    Call ChangeBrowseState
End Sub

Private Sub cmdPrevious_Click() '移动到记录的上一条
    DataEnv.rssqlSeek.MovePrevious
    Call ChangeBrowseState
End Sub

Private Sub cmdReport_Click()
   On Error Resume Next
   If cmdReport.Caption = "取消" Then
      '取消所使用的更新更新
      DataEnv.rsStudent.CancelUpdate
      '重新显示原来数据集中的内容
      If DataEnv.rsStudent.BOF Then
         DataEnv.rsStudent.MoveFirst
      Else
         DataEnv.rsStudent.MovePrevious
         DataEnv.rsStudent.MoveNext
      End If
      Call RefreshBinding
      Call ChangeBrowseState
      fraSeek.Enabled = True
      fraBrowse.Enabled = True
      fraInfo.Enabled = False
      grdScan.Enabled = True
      cmdReport.Caption = "报表(R)"
      mbClose = True
   Else
    '生成报表
      Dim strSQL As String
      DataEnv.rsrptStudent.Close
      strSQL = "select * from 学生信息表 where serial = '" & txtSerial.Text & "'"
      DataEnv.rsrptStudent.Open strSQL
      rptStudent.Show
   End If
End Sub



Private Sub cmdSelectPhoto_Click()
    On Error GoTo errHandler:
    dlgSelect.DialogTitle = "选择该学生的照片"
    dlgSelect.Filter = "所有图形文件|*.bmp;*.dib;*.gif;*.jpg;*.ico|位图文件(*.bmp;*.dib)" & _
            "|*.bmp;*.dib|GIF文件(*.gif)|*.gif|JPEG文件(*.jpg)|*.jpg|图标文件(*.ico)|*.ico"
    dlgSelect.ShowOpen
    If dlgSelect.FileName = "" Then Exit Sub
    imgPhoto.Picture = LoadPicture(dlgSelect.FileName)
    mstrFileName = dlgSelect.FileName
    Exit Sub
errHandler:
    MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdUpdate_Click()
    '更新所添加或者修改的记录
   On Error GoTo errHandler:
   Dim str As String
   str = txtSerial.Text
   With DataEnv.rsStudent
      .Fields("Serial") = txtSerial.Text
      .Fields("name") = txtName.Text
      .Fields("sex") = cboSex.Text
      .Fields("class") = dcbClass.Text
      .Fields("birthday") = dtpBirth.Value
      .Fields("tel") = txtTelephone.Text
      .Fields("address") = txtAddress.Text
      .Fields("resume") = txtResume.Text
      If mstrFileName <> "" Then Call WriteImage(.Fields("photo"), mstrFileName)
      .Update
   End With
   cmdReport.Caption = "报表(&R)"
   cmdUpdate.Enabled = False
   fraInfo.Enabled = False
   mbClose = True
   If DataEnv.rssqlSeek.State = adStateClosed Then DataEnv.rssqlSeek.Open
   '刷新右端用以导航的网格控件
   Call RefreshGrid
   '根据记录集中记录的个数，改变各个按钮的状态
   Call ChangeBrowseState
   '定位到刚刚添加或者修改过的记录
   DataEnv.rssqlSeek.MoveFirst
   DataEnv.rssqlSeek.Find "serial='" & str & "'"
   fraSeek.Enabled = True
   fraBrowse.Enabled = True
   grdScan.Enabled = True
   Exit Sub
errHandler:
  MsgBox Err.Description, vbCritical, " 错误"
End Sub

Private Sub dcbClass_Click(Area As Integer)
  If txtSerial = "" Then
     txtSerial = dcbClass.Text
  End If
End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not mbClose Then
        MsgBox "数据正被修改，窗口不能关闭", vbCritical, "错误"
        Cancel = True
    End If
End Sub









Private Sub grdScan_Change()
   If grdScan.ApproxCount > 0 Then
        Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
   End If
End Sub

Private Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   '当前行改变，则动态改变所要显示的记录
   If LastRow <> grdScan.Bookmark Then
      If grdScan.ApproxCount > 0 Then
         Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
      End If
   End If
End Sub

Private Sub WriteImage(ByRef Fld As ADODB.Field, DiskFile As String)
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim i As Long '定义循环变量
    
    Const BLOCKSIZE = 4096 '每次读写块的大小
    
    SourceFile = FreeFile '提供一个尚未使用的文件号
    Open DiskFile For Binary Access Read As SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
        Close SourceFile
        MsgBox DiskFile & "无 内 容 或 不 存 在 !"
    Else
        NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
        LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
        Fld.Value = Null
        ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
        For i = 1 To NumBlocks
            Get SourceFile, , byteData() ' 读到内存块中
            Fld.AppendChunk byteData() '写入FLD
        Next i
        
        ReDim byteData(LeftOver) '重新定义数据块的大小
        Get SourceFile, , byteData() '读到内存块中
        Fld.AppendChunk byteData() '写入FLD
        Close SourceFile '关闭源文件
    End If
End Sub

Private Function ReadImage(blobColumn As ADODB.Field) As String
    '取得一个临时性文件
    Dim strFileName As String
    strFileName = "ImageTmp"

    Dim FileNumber      As Integer      '文件号
    Dim DataLen             As Long         '文件长度
    Dim Chunks              As Long         '数据块数
    Dim ChunkAry()      As Byte         '数据块数组
    Dim ChunkSize       As Long         '数据块大小
    Dim Fragment        As Long         '零碎数据大小
    Dim lngI                As Long '计数器
    
    On Error GoTo errHander
    
    ChunkSize = 2048                    '定义块大小为 2K
    If IsNull(blobColumn) Then Exit Function

    DataLen = blobColumn.ActualSize         '获得图像大小
    If DataLen < 8 Then Exit Function   '图像大小小于8字节时认为不是图像信息
        FileNumber = FreeFile               '产生随机的文件号
    Open strFileName For Binary Access Write As FileNumber     '打开存放图像数据文件
    Chunks = DataLen \ ChunkSize        '数据块数
    Fragment = DataLen Mod ChunkSize    '零碎数据
    If Fragment > 0 Then            '有零碎数据，则先读该数据
            ReDim ChunkAry(Fragment - 1)
            ChunkAry = blobColumn.GetChunk(Fragment)
            Put FileNumber, , ChunkAry      '写入文件
    End If

    ReDim ChunkAry(ChunkSize - 1)             '为数据块重新开辟空间
    For lngI = 1 To Chunks                              '循环读出所有块
            ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
            Put FileNumber, , ChunkAry()    '将数据块写入文件中
    Next lngI
    Close FileNumber            '关闭文件
    
    ReadImage = strFileName
    
    Exit Function
    
errHander:
    ReadImage = ""
End Function