frmstudentupdate.frm

用VB实现的一个学生管理系统

         BackColor       =   &H00FFFFFF&
         Caption         =   "家长姓名："
         Height          =   180
         Left            =   240
         TabIndex        =   22
         Top             =   4695
         Width           =   900
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "家长电话："
         Height          =   180
         Left            =   240
         TabIndex        =   21
         Top             =   5055
         Width           =   900
      End
      Begin VB.Label Label14 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "家长地址："
         Height          =   180
         Left            =   240
         TabIndex        =   20
         Top             =   5415
         Width           =   900
      End
      Begin VB.Label Label15 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "邮政编码："
         Height          =   180
         Left            =   240
         TabIndex        =   19
         Top             =   5775
         Width           =   900
      End
      Begin VB.Label Label16 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "备注："
         Height          =   180
         Left            =   240
         TabIndex        =   18
         Top             =   6135
         Width           =   540
      End
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   1215
      Left            =   480
      TabIndex        =   42
      Top             =   -120
      Width           =   5175
      _cx             =   9128
      _cy             =   2143
      FlashVars       =   ""
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      AllowScriptAccess=   ""
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
      MovieData       =   ""
      SeamlessTabbing =   -1  'True
      Profile         =   0   'False
      ProfileAddress  =   ""
      ProfilePort     =   0
   End
End
Attribute VB_Name = "FrmStudentUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim aID As String
Dim aclass As String
Dim abc1 As String
Private Sub FillControl()
txtID.Text = ""
txtname.Text = ""
With cobsex
  .Clear
  .AddItem "男"
  .AddItem "女"
  .ListIndex = 0
End With
With cobinyear
 .Clear
 For i = 1990 To 2020
 .AddItem i & "年"
 Next i
    .ListIndex = 0
End With

dtBirthday.Value = Now

'民族
Set adoRS = adoCon.Execute("Select Name From Nation Order By Name")
cobNation.Clear
Do While Not adoRS.EOF
  cobNation.AddItem Trim(adoRS("Name"))
  adoRS.MoveNext
Loop
cobNation.ListIndex = 0

'学院
Set adoRS = adoCon.Execute("Select Name From college Order By Name")
cobcollege.Clear
Do While Not adoRS.EOF
  cobcollege.AddItem Trim(adoRS("Name"))
  adoRS.MoveNext
Loop
cobcollege.ListIndex = 0


'教师
Set adoRS = adoCon.Execute("Select Name From Teacher Order By Name")
cobteacher.Clear
Do While Not adoRS.EOF
  cobteacher.AddItem Trim(adoRS("Name"))
  adoRS.MoveNext
Loop
cobteacher.ListIndex = 0

txtPhone.Text = ""
txtStatusID.Text = ""
txtEmail.Text = ""
txtHouseName.Text = ""
txtHousePhone.Text = ""
txtHouseAddress.Text = ""
txtPostCode.Text = ""
txtMemo.Text = ""
End Sub
Private Sub fillRecord()
 Dim sql As String
 sql = "select * from Student where ID='" & frmUpdateID.sID & "'"
 Set adoRS = adoCon.Execute(sql)
 txtID.Text = Trim(adoRS("ID"))
 aID = Trim(adoRS("ID"))
 txtname.Text = Trim(adoRS("name"))
 cobsex.Text = Trim(adoRS("Sex"))
 cobcollege.Text = Trim(adoRS("College"))
 cobSpeciality.Text = Trim(adoRS("Speciality"))
 cobclass.Text = Trim(adoRS("Class"))
 cobteacher.Text = Trim(adoRS("Teacher"))
 cobinyear.Text = Trim(adoRS("Inyear"))
 cobNation.Text = Trim(adoRS("Nation"))
 dtBirthday.Value = Trim(adoRS("Birthday"))
 txtPhone.Text = Trim(adoRS("Phone"))
 txtStatusID.Text = Trim(adoRS("Statusid"))
 txtEmail.Text = Trim(adoRS("Email"))
 txtHouseName.Text = Trim(adoRS("HouseName"))
 txtHousePhone.Text = Trim(adoRS("HousePhone"))
 txtHouseAddress.Text = Trim(adoRS("HouseAddress"))
 txtPostCode.Text = Trim(adoRS("PostCode"))
 txtMemo.Text = Trim(adoRS("Memo"))
 Call s_ReadFile
 
 Set adoRS = Nothing
End Sub

Private Sub cmdCancel_Click()
  fillRecord
End Sub

Private Sub cmdnext_Click()
 Shell "cmd.exe /k del " & App.Path & "\test1.jpg ", vbHide
Unload Me
frmUpdateID.Show
End Sub

Private Sub cmdQuit_Click()
Unload Me

End Sub

Private Sub cmdupdate_Click()
Dim sql As String
On Error GoTo errMsg
sql = MsgBox("你真的要修改当前数据吗，请慎重处理！", vbInformation _
     + vbOKCancel + vbDefaultButton2, "系统提示")
If sql = vbCancel Then
  Exit Sub
End If
If cobclass.Text = "" Then

   MsgBox "班别不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
'姓名
If Trim(txtname.Text) = "" Then
   MsgBox "姓名不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
   txtname.SetFocus
   Exit Sub
End If
'出生日期
If (Year(Now) - Year(dtBirthday.Value)) < 15 Or (Year(Now) - Year(dtBirthday.Value)) > 30 Then
   MsgBox "输入的出生日期应保证在15--30岁间！", vbOKOnly + vbExclamation, "系统提示"
   dtBirthday.SetFocus
   Exit Sub
End If

'电子信箱
If Trim(txtEmail.Text) <> "" Then

  If txtEmail.Text Like "?*@??*.???*" = False Then
    MsgBox "输入的邮箱不是有效的信箱，请核实！", vbOKOnly + vbExclamation, "系统提示"
    txtEmail.SetFocus
    Exit Sub
  End If
End If

'邮政编码
If Trim(txtPostCode.Text) <> "" Then
    If Len(Trim(txtPostCode.Text)) <> 6 Or Not (txtPostCode.Text Like "[0-9][0-9][0-9][0-9][0-9][0-9]") Then
     MsgBox "邮政编码输入不正确，必须是6位数字，请核实！", vbOKOnly + vbExclamation, "系统提示"
     txtPostCode.SetFocus
     Exit Sub
    End If
End If
sql = ""
sql = "update student set id='" & txtID.Text & "',"
sql = sql & "Name='" & txtname.Text & "',"
sql = sql & "Sex='" & cobsex.Text & "',"
sql = sql & "Birthday='" & Format(dtBirthday.Value, "YYYY-MM-DD") & "',"
sql = sql & "Nation='" & cobNation.Text & "',"
sql = sql & "Speciality='" & cobSpeciality.Text & "',"
sql = sql & "Class='" & cobclass.Text & "',"
sql = sql & "Teacher='" & cobteacher.Text & "',"
sql = sql & "Inyear='" & cobinyear.Text & "',"
sql = sql & "Phone='" & txtPhone.Text & "',"
sql = sql & "StatusID='" & txtStatusID.Text & "',"
sql = sql & "Email='" & txtEmail.Text & "',"
sql = sql & "HouseName='" & txtHouseName.Text & "',"
sql = sql & "HousePhone='" & txtHousePhone.Text & "',"
sql = sql & "HouseAddress='" & txtHouseAddress.Text & "',"
sql = sql & "PostCode='" & txtPostCode.Text & "',"
sql = sql & "Memo='" & txtMemo.Text & "',"
sql = sql & "Photo='" & abc1 & "'"
sql = sql & " Where id='" & Trim(aID) & "'"
adoCon.Execute (sql)
If CommonDialog1.FileTitle <> "" Then
Call s_SaveFile(CommonDialog1.FileName)
End If

sql = MsgBox("修改成功！", vbInformation _
     + vbOK, "系统提示")
cmdCancel.Enabled = False
errMsg:
  If err.Number <> 0 Then
     MsgBox err.Description, , "系统错误"
  End If
  
End Sub
Private Sub cobcollege_Click()
'专业
sql = ""
sql = "select 专业 from Spcollege where  学院='" & Trim(cobcollege.Text) & "'"
Set adoRS = adoCon.Execute(sql)

cobSpeciality.Clear
Do While Not adoRS.EOF
  cobSpeciality.AddItem Trim(adoRS("专业"))
  adoRS.MoveNext
Loop
cobSpeciality.ListIndex = 0
End Sub


Private Sub cobSpeciality_Click()
'班级
sql = ""
sql = "select 班级 from Spclass where  专业='" & cobSpeciality.Text & "'"
Set adoRS = adoCon.Execute(sql)

cobclass.Clear
Do While Not adoRS.EOF
  cobclass.AddItem Trim(adoRS("班级"))
  adoRS.MoveNext
Loop

End Sub

Private Sub Command1_Click()
   CommonDialog1.ShowOpen
If CommonDialog1.FileTitle <> "" Then
   abc1 = CommonDialog1.FileTitle
   Image1.Picture = LoadPicture(abc1)
End If
End Sub


Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 200
ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"
 Shell "cmd.exe /k del " & App.Path & "\test1.jpg ", vbHide
    FillControl
   
    fillRecord
    s_ReadFile
End Sub
Sub s_ReadFile()
    Dim iStm As ADODB.Stream
    Dim iRe As ADODB.Recordset
    '打开表
Set iRe = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection
con.ConnectionString = "provider=sqloledb.1;Server=(local);Uid=sa;Pwd=;Database=MyDB"
con.Open

'得到最新添加的纪录
    iRe.Open "select photo from student where ID='" & frmUpdateID.sID & "'", con, adOpenKeyset, adLockReadOnly
    '保存到文件
    Set iStm = New ADODB.Stream
 
   
On Error Resume Next
 With iStm
        .Mode = adModeReadWrite
        .Type = adTypeBinary
        .Open
        .Write iRe("photo")
'这里注意了,如果当前目录下存在test1.jpg,会报一个文件写入失败的错误.
        .SaveToFile App.Path & "\test1.jpg"
    End With

   On Error Resume Next
    Image1.Picture = LoadPicture(App.Path & "\test1.jpg")


   '关闭对象
    iRe.Close
    iStm.Close
    con.Close
    
End Sub
 Sub s_SaveFile(lujin As String)
    Dim iStm As ADODB.Stream
    Dim iRe As ADODB.Recordset
    Dim iConcstr As String
Dim con As ADODB.Connection
Set con = New ADODB.Connection
con.ConnectionString = "provider=sqloledb.1;Server=(local);Uid=sa;Pwd=;Database=MyDB"
con.Open
    '读取文件到内容
    Set iStm = New ADODB.Stream
    With iStm
        .Type = adTypeBinary   '二进制模式
        .Open
        .LoadFromFile lujin
    End With
   
' iStm.Read
    '打开保存文件的表
    Set iRe = New ADODB.Recordset
    With iRe
        .Open "select * from Student where ID='" & txtID.Text & "'", con, 1, 3
        .Fields("photo") = iStm.Read
       .Update
    End With


   '完成后关闭对象
    iRe.Close
    iStm.Close
    con.Close
End Sub