frmstudentinput.frm

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

      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "民族："
         Height          =   180
         Left            =   120
         TabIndex        =   5
         Top             =   1455
         Width           =   540
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "出生日期："
         Height          =   180
         Left            =   120
         TabIndex        =   4
         Top             =   2895
         Width           =   900
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "性别："
         Height          =   180
         Left            =   120
         TabIndex        =   3
         Top             =   1080
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "姓名："
         Height          =   180
         Left            =   120
         TabIndex        =   2
         Top             =   720
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         Caption         =   "学号："
         Height          =   180
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   540
      End
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   1215
      Left            =   360
      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
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   495
      Left            =   2400
      TabIndex        =   32
      Top             =   2640
      Width           =   1215
   End
End
Attribute VB_Name = "frmStudentInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim abc As String
Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1
Private Sub cmdAdd_Click()
On Error GoTo errMsg
If cobclass.Text = "" Then

   MsgBox "班别不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If

'学号
If Trim(txtID.Text) = "" Then
   MsgBox "学号不能为空，请核实！", vbOKOnly + vbExclamation, "系统提示"
   txtID.SetFocus
   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

Dim sql As String
sql = "Select * From Student Where ID='" & Trim(txtID.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If Not adoRS.EOF Then
   MsgBox "编号为：" & Trim(txtID.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
   txtID.SetFocus
   Exit Sub
End If

sql = ""
sql = "EXEC studentin"
sql = sql & " @id='" & Trim(txtID.Text) & "'"
sql = sql & ",@Name='" & Trim(txtname.Text) & "'"
sql = sql & ",@Sex='" & cobsex.Text & "'"
sql = sql & ",@Birthday='" & Format(dtBirthday.Value, "YYYY-MM-DD") & "'"
sql = sql & ",@Nation='" & cobNation.Text & "'"
sql = sql & ",@college='" & cobcollege.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 & "'"

adoCon.Execute (sql)
If CommonDialog1.FileTitle <> "" Then
Call s_SaveFile(CommonDialog1.FileName)
End If
Call FillControl
Image1.Picture = LoadPicture("")
abc = ""


MsgBox "录入成功！", vbOKOnly + vbInformation, "成功提示"
txtID.SetFocus

errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If

End Sub

Private Sub cmdCancel_Click()
On Error GoTo errMsg

Call FillControl
txtID.SetFocus

errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If

End Sub

Private Sub cmdQuit_Click()
Unload Me
frmmain.Show
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

   abc = CommonDialog1.FileTitle
   Image1.Picture = LoadPicture(abc)
End If
End Sub





Private Sub Form_Load()
On Error GoTo errMsg
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 200
Call FillControl

errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If
ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"

End Sub
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 college Order By Name")
cobcollege.Clear
Do While Not adoRS.EOF
  cobcollege.AddItem adoRS("Name")
  adoRS.MoveNext
Loop
cobcollege.ListIndex = 0
'学院
Set adoRS = adoCon.Execute("Select Name From Nation Order By Name")
cobNation.Clear
Do While Not adoRS.EOF
  cobNation.AddItem adoRS("Name")
  adoRS.MoveNext
Loop
cobNation.ListIndex = 0

'教师
Set adoRS = adoCon.Execute("Select Name From Teacher Order By Name")
cobteacher.Clear
Do While Not adoRS.EOF
  cobteacher.AddItem 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 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