Thông báo kết quả học tập của học sinh qua điện thoại

c sinh ngay khi hệ thống đang hoạt động Cho phép thu lại tiếng nói của người dùng Hạn chế : Vì chương trình sử dụng giao tiếp là modem nên tại một thời điểm, hệ thống chỉ tiếp nhận được một cuộc gọi. Tuy nhiên, hệ thống chỉ hoạt động trong một trường học nên điều này có thể chấp nhận được. Cơ sở dữ liệu được cài đặt bằng Access nên chưa được mã hóa để bảo mật Vì thời gian có hạn nên tiếng nói thu vào chưa được lọc để đạt chất lượng cao hơn Bảng chỉ mục chưa được tối ưu Hướng phát triển : Hỗ trợ telephony card nhằm kết nối với nhiều cuộc gọi tới ở cùng thời điểm. Mã hóa cơ sở dữ liệu Access hoặc thay thế bằng hệ quản trị cơ sở dữ liệu khác như Oracle, SQL Server, ... để tăng cường khả năng bào mật Mở rộng chương trình cập nhật dữ liệu ở dạng bảng (lưới) nhằm cho phép thấy nhiều mẫu tin cùng lúc Thêm một số chức năng cho chương trình thu âm để người dùng linh động hơn trong việc thu tiếng nói như : giảm độ ồn, chỉnh sửa trực tiếp sóng âm thanh ở dạng đồ họa, ... Tạo lại bảng chỉ mục để tìm kiếm nhanh hơn PHẦN 5 KẾT LUẬN Chương trình “Thông báo kết quả học tập của học sinh qua điện thoại” đã được hoàn thiện, có thể cài đặt để chạy trên bất kỳ hệ điều hành Windows 32-bit nào. Với những yêu cầu đặt ra của đề tài, chương trình đã giải quyết được và cho ra kết quả như mong muốn. Chương trình này có thể ứng dụng cho các trường học phổ thông. Đề tài “Thông báo kết quả học tập của học sinh qua điện thoại” là một đề tài rất hay và thiết thực. Trong quá trình nghiên cứu, tìm hiểu, em đã có dịp ôn lại rất nhiều kiến thức đã học như : phân tích thiết kế hệ thống thông tin quản lý, cài đặt, kết nối và truy xuất cơ sở dữ liệu, tạo và xử lý file âm thanh và các kỹ thuật lập trình trong Visual Basic. Song song đó, em cũng được biết thêm nhiều điều mới như các kiến thức liên quan đến lập trình giao tiếp giữa điện thoại và máy tính (TAPI), lập trình giao tiếp với multimedia. Từ những kiến thức thu thập được , em đã hiểu được phần nào về hoạt động của các hộp thư thoại ( voice mail) và các hệ thống trả lời tự động (answering machine) mà hiện nay được sử dụng rất nhiều. Tuy đề tài đã được khép lại nhưng vẫn còn nhiều vấn đề cần được nghiên cứu và phát triển thêm nhằm mở rộng chương trình như : sử dụng telephony card để trả lời nhiều cuộc gọi ở cùng thời điểm, mở rộng cơ sở dữ liệu và tăng cường chức năng bảo mật, xử lý nhiều hơn tiếng nói được thu vào nhằm cho chất lượng cao hơn, vv... Đó là những mục tiêu phát triển mà bất cứ một chương trình nào cũng có. PHỤ LỤCMÃ NGUỒNTHỰC HIỆNMỘT SỐCÔNG VIỆC CHÍNH 1. CHƯƠNG TRÌNH CHÍNH Mở cơ sở dữ liệu : 'Mo CSDL san sang cho viec tra loi 'Tra ve True neu mo thanh cong Private Function Open_Database() As Boolean 'Load database If File_Exist(SourcePath + "KQHT.mdb") Then Set DB = OpenDatabase(SourcePath + DBName) Set VRS = DB.OpenRecordset("tblVOICEINDEX", dbOpenTable) VRS.Index = "idxChuoi" Open_Database = True Else Open_Database = False End If End Function Đóng cơ sở dữ liệu : Private Sub Close_Database() VRS.Close DB.Close End Sub Khởi tạo TAPI : 'Khoi tao TAPI 'Tra ve False neu co loi Private Function Init_TAPI() As Boolean Dim Loi As Long Loi = lineInitialize(hTAPI, App.hInstance, AddressOf LineCallBack, App.EXEName, TotalLines) If Loi < 0 Then MsgBox "Không thể khởi tạo thư viện TAPI !", vbCritical, Title Init_TAPI = False Else Init_TAPI = True End If End Function Chờ cuộc gọi tới : 'Cho doi 1 cuoc goi toi 'Tra ve thong bao loi neu co Public Function Wait_Call() As String Dim Loi As Long Wait_Call = vbNullString 'Mo Line If Not Open_Line() Then Wait_Call = "Không thể dùng modem được chọn !" Exit Function End If 'Dang ky cac Message cho Line Loi = lineSetStatusMessages(hLine, ALL_TAPIMESSAGES, 0) If Loi < 0 Then Wait_Call = "Không thể tạo sự kiện để nhận cuộc gọi !" Call Close_Line Exit Function End If frmKQHT.imgStatus.Picture = LoadResPicture("System_On", vbResBitmap) 'Function lineCallBack se duoc goi khi chuong reo End Function Mở line hiện tại : 'Mo Line hien tai voi CurLineID ‘Tra ve True neu thanh cong Private Function Open_Line() As Boolean Dim Loi As Long Dim NegoVersion As Long 'Version lay duoc sau khi Negotiate Dim plineExtenID As lineExtensionID Call lineNegotiateAPIVersion(hTAPI, CurLineID, LOW_TAPIVERSION, HIGH_TAPIVERSION, NegoVersion, plineExtenID) If lineOpen(hTAPI, CurLineID, hLine, NegoVersion, Unused, _ Unused, LINECALLPRIVILEGE_OWNER, _ LINEMEDIAMODE_AUTOMATEDVOICE, Unused) < 0 Then 'Error Open_Line = False Else Open_Line = True End If End Function Ngắt kết nối của cuộc gọi hiên tại : 'Ngat ket noi cuoc goi hien tai Public Sub Disconnect() If Playing Then Call Stop_Playing Call Wait End If Call Drop_Call Call Close_Line ' Dong file wave sau khi doc xong du lieu file wave If Not frmKQHT.mnuRecord.Checked Then Call Close_VoiceFiles frmKQHT.mnuRecord.Enabled = True 'Neu KHONG phai do nhan nut STOP de disconnect thi 'tao Line moi de nhan cuoc goi khac If frmKQHT.cmdStop.Tag "clicked" Then Call Wait_Call End Sub Hủy và giải phóng cuộc gọi hiện tại : 'Huy bo cuoc goi hien tai Private Sub Drop_Call() If hCall 0 Then Call lineDrop(hCall, "", 0) Call lineDeallocateCall(hCall) hCall = 0 End If End Sub Đóng line hiện tại : 'Dong Line hien tai Private Sub Close_Line() If hLine 0 Then Call lineClose(hLine) hLine = 0 End If End Sub Kết thúc TAPI : Private Sub ShutDown_TAPI() Call lineShutdown(hTAPI) End Sub Tiếp nhận các sự kiện của TAPI : 'Xu ly cac su kien TAPI Public Function LineCallBack(ByVal dwDevice As Long, ByVal dwMsg As Long, ByVal dwCallbackInstance As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long, ByVal dwParam3 As Long) As Long On Error GoTo Thoat Select Case dwMsg Case LINE_LINEDEVSTATE 'Thong diep cho trang thai cua LINE Call LineDevStateProc(dwDevice, dwCallbackInstance, dwParam1, dwParam2, dwParam3) Case LINE_CALLSTATE 'Thong diep cho trang thai cua CALL Call LineCallStateProc(dwDevice, dwCallbackInstance, dwParam1, dwParam2, dwParam3) Case LINE_MONITORDIGITS 'Thong diep cho tin hieu DTMF gui toi Call Receive_DTMF(dwParam1) End Select Exit Function Thoat: Call Disconnect End Function Tiếp nhận các sự kiện liên quan đến cuộc gọi (call) : 'Xu ly cac su kien trang thai cua CALL 'hCall = dwDevice 'hCallback = hCallbackInstance 'CallState = dwParam1 Private Sub LineCallStateProc(ByVal dwDevice As Long, ByVal hCallbackInstance As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long, ByVal dwParam3 As Long) Select Case dwParam1 Case LINECALLSTATE_OFFERING: 'Tin hieu co cuoc goi toi hCall = dwDevice Case LINECALLSTATE_CONNECTED: Call After_Connected Case LINECALLSTATE_DISCONNECTED: 'Xay ra khi cuoc goi bi ngat Call Disconnect Case LINECALLSTATE_IDLE Call Disconnect End Select End Sub Tiếp nhận các sự kiện liên quan đến line : 'Xu ly cac su lien trang thai cua LINE 'hLine = dwDevice 'hCallback = hCallbackInstance 'DeviceState = dwParam1 Private Sub LineDevStateProc(ByVal dwDevice As Long, ByVal hCallbackInstance As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Long, ByVal dwParam3 As Long) Select Case dwParam1 Case LINEDEVSTATE_RINGING: 'Chuong reo --> So chuong = dwParam3 frmKQHT.imgStatus.Picture = LoadResPicture("System_Ring", vbResBitmap) If dwParam3 >= Rings Then Call Answer_Call End Select End Sub Kết nối với cuộc gọi tới : 'Tra loi cuoc goi toi Private Sub Answer_Call() Dim Loi As Long Loi = lineAnswer(hCall, "", 0) If Loi < 0 Then Call Disconnect End If End Sub Sau khi kết nối thành công : ‘Sau khi ket noi, mo file voice va phat loi chao Private Sub After_Connected() If Not frmKQHT.mnuRecord.Checked Then 'Neu KHONG dang chay ctr Record frmKQHT.mnuRecord.Enabled = False If Open_VoiceFiles() = True Then frmKQHT.imgStatus.Picture = LoadResPicture("System_Hangup", vbResBitmap) PhutHT = 0 frmKQHT.timCall.Enabled = True Call Welcome Else frmKQHT.cmdStop = True MsgBox "Không thể mở các file *.sam", vbSystemModal + vbCritical, Title End If Else 'Dang cap nhat tieng noi, thong bao busy frmKQHT.imgStatus.Picture = LoadResPicture("System_Hangup", vbResBitmap) If Load_WaitFile() = True Then Call Start_Playing(1000) End If End Sub Mở các file *.sam : 'Mo cac file Voice de doc du lieu ‘Tra ve True neu thanh cong Public Function Open_VoiceFiles() As Boolean Dim pmmIOInfo As mmIOInfo Dim c As Byte Dim Handle As Long Open_VoiceFiles = False For c = Asc("@") To Asc("Z") If Dir(SourcePath + Chr(c) + ".sam") = vbNullString Then Exit Function Handle = mmioOpen(SourcePath + Chr(c) + ".sam", pmmIOInfo, MMIO_READ) If Handle 0 Then hVoiceFile(c - 63) = Handle Else Exit Function Next Open_VoiceFiles = True End Function Nạp dữ liệu tiếng nói vào bộ nhớ : 'Load data from file into mem Public Function Load_VoiceFiles(Chuoi As String) As Boolean Dim Loi As Long, OldDataSize As Long, TotalDataSize As Long Dim arrChuoi() As ChuoiVoice 'Mang cac chuoi con va nhung thong tin cua chung Dim arrChuoiCon() As String 'Mang chuoi con, chi co ten chuoi Dim TenChuoi As String Dim i As Long, LastIndex As Long Dim Found As Boolean 'Bao hieu co tim thay 1 chuoi nao trong CSDL khong ? 'Tach chuoi me thanh cac chuoi con arrChuoiCon = Split(Chuoi, Cach, , vbTextCompare) Found = False Load_VoiceFiles = False LastIndex = UBound(arrChuoiCon) ReDim arrChuoi(LastIndex) TotalDataSize = 0 'Tim thong tin chuoi trong CSDL For i = LBound(arrChuoiCon) To LastIndex VRS.Seek "=", arrChuoiCon(i) If VRS.NoMatch = False Then 'Found arrChuoi(i).hVoiceFile = hVoiceFile(Asc(UCase(VRS!Nhom)) - 63) arrChuoi(i).FileOffset = VRS!FileOffset arrChuoi(i).DataSize = VRS!DataSize TotalDataSize = TotalDataSize + VRS!DataSize Found = True 'Chi can co 1 voice End If Next i 'Neu khong co voice nao thi thoat If Not Found Then Exit Function 'Cap phat bo nho hMem = GlobalAlloc(GMEM_ZEROINIT, TotalDataSize) pWaveBuffer = GlobalLock(hMem) TotalSamples = TotalDataSize 'Doc du lieu OldDataSize = 0 For i = LBound(arrChuoiCon) To LastIndex If (arrChuoi(i).hVoiceFile 0) Then 'Co tu nay Call mmioSeek(arrChuoi(i).hVoiceFile, arrChuoi(i).FileOffset, SEEK_SET) Loi = mmioRead(arrChuoi(i).hVoiceFile, pWaveBuffer + OldDataSize, arrChuoi(i).DataSize) If (Loi = -1) Then hMem = GlobalFree(hMem) Exit Function End If OldDataSize = OldDataSize + arrChuoi(i).DataSize 'Tong so byte da doc vao mem End If Next Load_VoiceFiles = True Thoat: End Function Phát tiếng nói : 'Bat dau phat voice da co trong mem Public Sub Start_Playing(LoopCount As Long) Dim OpenFlag As Long Dim Loi As Long Dim ErrMsg As String * 200 'Thiet lap flag de mo waveout device If WaveOutID = -1 Then 'Neu ra sound card OpenFlag = CALLBACK_FUNCTION Else OpenFlag = CALLBACK_FUNCTION Or WAVE_MAPPED End If 'Set format With pWaveFormat .cbSize = 0 .nAvgBytesPerSec = 11025 .nBlockAlign = 1 .nChannels = 1 .nSamplesPerSec = 11025 .wBitsPerSample = 8 .wFormatTag = 1 End With Loi = waveOutOpen(hWaveOut, WaveOutID, pWaveFormat, AddressOf waveOutProc, 0, OpenFlag) If Loi 0 Then hMem = GlobalFree(hMem) Exit Sub End If 'Chuan bi du lieu am thanh de phat ra pWaveHeader.lpData = pWaveBuffer pWaveHeader.dwBufferLength = TotalSamples * pWaveFormat.nBlockAlign pWaveHeader.dwFlags = 0 pWaveHeader.dwLoops = LoopCount - 1 'So lan lap lai , dem lui Loi = waveOutPrepareHeader(hWaveOut, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then Call Close_WaveOut hMem = GlobalFree(hMem) Exit Sub End If 'Bat dau phat am thanh Loi = waveOutWrite(hWaveOut, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then Call Close_WaveOut hMem = GlobalFree(hMem) Else Playing = True End If 'Sub waveOutProc se duoc goi khi phat xong End Sub Ngừng phát tiếng nói : Public Sub Stop_Playing() pWaveHeader.dwLoops = 0 Call waveOutReset(hWaveOut) 'Sub waveOutProc se duoc goi de tiep tuc End Sub Tiếp nhận các sự kiện của thiết bị phát âm thanh : 'Xu ly su kien cua WaveOut Private Sub waveOutProc(ByVal hwo As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long) On Error Resume Next If uMsg = MM_WOM_DONE Then frmKQHT.timWaveOut.Enabled = True End If End Sub Lấy ID của thiết bị phát âm thanh : 'Lay ID cua thiet bi de phat am thanh Public Function Get_WaveOutID(DeviceClass As String) As Boolean Dim Loi As Long Dim pVarString As varString pVarString.dwTotalSize = Len(pVarString) Loi = lineGetID(hLine, 0, hCall, LINECALLSELECT_CALL, pVarString, DeviceClass) If Loi < 0 Then Get_WaveOutID = False Else If pVarString.dwStringOffset = 0 Then 'Nothing Get_WaveOutID = False Exit Function Else 'Lay ID WaveOutID = pVarString.dwData Get_WaveOutID = True End If End If End Function Nhận mã DTMF : 'Nhan cac ma DTMF tu lineCallBack Public Sub Receive_DTMF(Phim As Long) PhutHT = 0 'Reset thoi gian roi If Playing Then Call Stop_Playing 'Dinh nghia lai ma phim Select Case Phim Case &H30 To &H39: Phim = Phim And &HF Case &H2A: Phim = Phim_SAO '* If (Status STATUS_MaHS) Then Goto_Menu Exit Sub End If Case &H23: Phim = Phim_# '# End Select 'Cac thao tac khac Select Case Status Case STATUS_MaHS 'Neu dang nhan ma so Call Receive_MaHS(Phim) Case STATUS_NGHIHOC Call Receive_Thang(Phim) Case STATUS_VIPHAM Call Receive_Thang(Phim) Case STATUS_KQKIEMTRA Call Receive_Thang(Phim) Case STATUS_KQTHI Call Receive_HocKy(Phim) Case STATUS_KQTHANG Call Receive_Thang(Phim) Case STATUS_KQHOCKY Call Receive_HocKy(Phim) Case STATUS_KQNAMHOC Case STATUS_HOCSINH Case STATUS_NAMHOC Call Receive_NamHoc(Phim) Case STATUS_MENU Call Menu(Phim) End Select End Sub Menu với các phím bấm tương ứng : Private Sub Menu(Phim As Long) Select Case Phim Case Phim_# ''#: Nhap ma so khac Call Nhap_MaHS Case 1 Status = STATUS_NGHIHOC Call Nhap_Thang(Status) Case 2 Status = STATUS_VIPHAM Call Nhap_Thang(Status) Case 3 Status = STATUS_KQKIEMTRA Call Nhap_Thang(Status) Case 4 Status = STATUS_KQTHI Call Nhap_HocKy(Status) Case 5 Status = STATUS_KQTHANG Call Nhap_Thang(Status) Case 6 Status = STATUS_KQHOCKY Call Nhap_HocKy(Status) Case 7 Status = STATUS_KQNAMHOC Call Monitor_DTMF(False) Call Get_KQNamHoc Case 8 Status = STATUS_HOCSINH Call Monitor_DTMF(False) Call Get_Info_HS Case 9 Status = STATUS_NAMHOC Call Nhap_NamHoc Case Phim_SAO ' *: Thoat Call Play_Voice1("@tạm_biệt") Call Wait Call Disconnect End Select End Sub Nhận mã số học sinh : 'Nhan ma so hoc sinh Private Sub Receive_MaHS(Phim As Long) Dim Chuoi As String Select Case Phim Case 0 To 9 DTMFBuffer = DTMFBuffer & Phim If Len(DTMFBuffer) = 7 Then 'Neu ma so da du 7 ky tu Call Monitor_DTMF(False) If Check_MaHS() = True Then ' tim thay hoc sinh MaHS = DTMFBuffer Chuoi = "@đã_nhập_mã_số " + Convert_MaHS2VoiceString(MaHS) Call Play_Voice1(Chuoi) Call Wait Call Goto_Menu Else 'khong co hoc sinh Chuoi = "@không_có_mã_số " + Convert_MaHS2VoiceString(DTMFBuffer) Call Play_Voice1(Chuoi) Call Wait Call Nhap_MaHS End If End If Case Phim_# '# 'Nhap lai Call Nhap_MaHS Case Phim_SAO '* If MaHS = vbNullString Then Call Play_Voice1("@chưa_nhập_mã_số") Call Wait Call Nhap_MaHS Else Call Goto_Menu End If End Select End Sub Nhận năm học : 'Nhan nam hoc mac dinh cho phien lam viec Private Sub Receive_NamHoc(Phim As Long) Select Case Phim Case 0 To 9 DTMFBuffer = DTMFBuffer & Phim If Len(DTMFBuffer) = 4 Then 'Neu year da du 4 chu so Call Monitor_DTMF(False) TenNamHoc = Check_NamHoc(DTMFBuffer) 'Ktra co nam hoc nay chua ? MaNH = DTMFBuffer If DTMFBuffer vbNullString Then 'Neu tim thay co nam hoc nay MaNH = DTMFBuffer 'Thiet lap MaNH mac dinh TenNH(0) = CInt(Left(TenNamHoc, 4)) TenNH(1) = CInt(Right(TenNamHoc, 4)) Chuoi = "@ñaõ_choïn_naêm_hoïc " & Split_Number(TenNH(0)) & Cach _ & Split_Number(TenNH(1)) Call Play_Voice1(Chuoi) Call Wait Call Goto_Menu Else If TenNamHoc = "error" Then 'Neu nam hoc khong hop le DTMFBuffer = vbNullString Chuoi = "@lỗi_năm_học" Else 'Neu chua co nam hoc nay Chuoi = "@chưa_có_năm_học " & Split_Number(CInt(TenNamHoc)) _ & Cach & Split_Number(CInt(TenNamHoc) + 1) End If 'TenNamHoc Call Play_Voice1(Chuoi) Call Wait Call Nhap_NamHoc End If 'DTMFBuffer End If 'len(DTMFBuffer) End Select End Sub Nhận tháng : 'Nhan ten thang Private Sub Receive_Thang(Phim As Long) Dim Thang As Byte Select Case Phim Case 0 To 9 DTMFBuffer = DTMFBuffer & Phim If Len(DTMFBuffer) = 2 Then Call Monitor_DTMF(False) Thang = CByte(DTMFBuffer) If ((Thang >= 1) And (Thang = 9) And (Thang <= 12)) Then Select Case Status Case STATUS_KQTHANG: Call Get_KQThang(Thang) Case STATUS_KQKIEMTRA: Call Get_KQKiemTra(Thang) Case STATUS_NGHIHOC: Call Get_NghiHoc(Thang) Case STATUS_VIPHAM: Call Get_ViPham(Thang) End Select Else Call Play_Voice1("@lỗi_tháng") Call Wait Call Nhap_Thang(Status) End If End If End Select End Sub Nhận học kỳ : 'Nhan ten hoc ky Private Sub Receive_HocKy(Phim As Long) 'Chi co the la hoc ky 1 hoac 2 Call Monitor_DTMF(False) Select Case Phim Case 1, 2 If Status = STATUS_KQHOCKY Then Call Get_KQHocKy(Phim) Else 'Status =STATUS_KQTHI Call Get_KQThi(Phim) End If Case Else Call Play_Voice1("@lỗi_học_kỳ") Call Wait Call Nhap_HocKy(Status) End Select End Sub Giám sát để thu nhận các mã DTMF : 'Giam sat cac ma DTMF 'dwDigitModes = 0 --> Ngung giam sat 'On=True: giam sat - Off=False: ngung giam sat Public Sub Monitor_DTMF(OnOff As Boolean) Dim Loi As Long Dim DigitModes As Long If OnOff = True Then DigitModes = LINEDIGITMODE_DTMF Else DigitModes = 0 Loi = lineMonitorDigits(hCall, DigitModes) If Loi < 0 Then 'Co the cuoc goi bi ngat Call Disconnect End If End Sub Lấy thông tin về các lần nghỉ học : 'thong bao thong tin ve NGHI HOC Public Sub Get_NghiHoc(ByVal Thang As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String, GiayPhep As String Dim Chuoi As String Dim NgayNH As String Dim DauThang As String, CuoiThang$ If (Thang >= 9) Then DauThang = "#" & Thang & "/1/" & TenNH(0) & "#" If Thang < 12 Then CuoiThang = "#" & Thang + 1 & "/1/" & TenNH(0) & "#" Else CuoiThang = "#1/1/" & TenNH(1) & "#" End If Else DauThang = "#" & Thang & "/1/" & TenNH(1) & "#" CuoiThang = "#" & Thang + 1 & "/1/" & TenNH(1) & "#" End If 'Loc theo ma HS SQL = "SELECT tblLYDO.TenLD, tblNGHIHOC.SoNgayNH, " _ + " tblNGHIHOC.GiayPhep, tblNGHIHOC.NgayNH " _ + " FROM tblLYDO INNER JOIN tblNGHIHOC " _ + " ON tblLYDO.MaLD = tblNGHIHOC.MaLD " _ + " WHERE (tblNGHIHOC.MaHS = '" + MaHS + "')" Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo ngay nghi hoc SQL = "(tblNGHIHOC.NgayNH >= " + DauThang + ")" _ + " AND (tblNGHIHOC.NgayNH <= " + CuoiThang + ")" RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close 'Sort RS1.Sort = "tblNGHIHOC.NgayNH " Set RS = RS1.OpenRecordset RS1.Close If RS.EOF Then 'Neu khong co nghi hoc vao ngay nay '@không_có_nghỉ_học = @không_có_nghỉ_học_trong_tháng Chuoi = "@học_sinh" + Im200 + HoTenHS + Im400 + "@không_có_nghỉ_học " _ & Thang & Im400 + "@năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) Else '@các_lần_nghỉ_học = @các_lần_nghỉ_học_trong_tháng Chuoi = "@các_lần_nghỉ_học " & Thang & Im200 + "@của_học_sinh" _ + Im200 + HoTenHS Do While Not RS.EOF NgayNH = CStr(RS!NgayNH) If RS!GiayPhep = True Then GiayPhep = "@có_phép" Else GiayPhep = "@không_phép" Chuoi = Chuoi + Im800 + "ngày" + Im200 & Day(NgayNH) _ & " tháng " & Month(NgayNH) & Im200 + "năm" _ + Im200 & Year(NgayNH) & Im400 + "@số_ngày_nghỉ" _ + Im200 & RS!SoNgayNH & Im200 & "ngày" _ + Im400 + GiayPhep + Im400 + "@lý_do" + Im200 + RS!TenLD RS.MoveNext Loop End If Chuoi = Chuoi + " @về_menu" RS.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy thông tin về các lần vi phạm nội quy : 'thong bao ve loi vi pham Public Sub Get_ViPham(ByVal Thang As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String Dim Chuoi As String Dim NgayVP As String Dim DauThang As String, CuoiThang$ 'Tim gioi han dau va cuoi cua thang If (Thang >= 9) Then DauThang = "#" & Thang & "/1/" & TenNH(0) & "#" If Thang < 12 Then CuoiThang = "#" & Thang + 1 & "/1/" & TenNH(0) & "#" Else CuoiThang = "#1/1/" & TenNH(1) & "#" End If Else DauThang = "#" & Thang & "/1/" & TenNH(1) & "#" CuoiThang = "#" & Thang + 1 & "/1/" & TenNH(1) & "#" End If SQL = "SELECT tblLOI.TenLoi, tblVIPHAM.LanVP, " _ + " tblVIPHAM.NgayVP " _ + " FROM tblVIPHAM INNER JOIN tblLOI " _ + " ON tblLOI.MaLoi = tblVIPHAM.MaLoi " _ + " WHERE (tblVIPHAM.MaHS = '" + MaHS + "')" Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo ngay vi pham SQL = "(tblVIPHAM.NgayVP >= " + DauThang + ")" _ + " AND (tblVIPHAM.NgayVP <= " + CuoiThang + ")" RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close 'Sort RS1.Sort = " tblVIPHAM.NgayVP , tblVIPHAM.LanVP " Set RS = RS1.OpenRecordset RS1.Close If RS.EOF Then 'Neu khong co vi pham vao ngay nay '@không_có_vi_phạm = @không_có_vi_phạm_trong_tháng Chuoi = "@học_sinh" + Im200 + HoTenHS + Im400 + "@không_có_vi_phạm " _ & Thang & Im400 + "@năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) Else '@các_lần_vi_phạm = @các_lần_vi_phạm_trong_tháng Chuoi = "@các_lần_vi_phạm " & Thang & Im200 + "@của_học_sinh" _ + Im200 + HoTenHS Do While Not RS.EOF NgayVP = CStr(RS!NgayVP) Chuoi = Chuoi + Im800 + "ngày " & Day(NgayVP) _ & " tháng " & Month(NgayVP) & Im200 + "năm " _ & Year(NgayVP) & Im400 + "@lỗi_vi_phạm" _ + Im200 + RS!TenLoi RS.MoveNext Loop End If Chuoi = Chuoi + " @về_menu" RS.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy kết quả cuối năm học : Public Sub Get_KQNamHoc() Dim RS As Recordset, RS1 As Recordset Dim SQL As String, GiayPhep As String, Chuoi As String SQL = "SELECT tblKQNAMHOC.DTBNH, tblKQNAMHOC.HangNH," _ & " tblHOCLUC.TenHL, tblHANHKIEM.TenHK, tblKQNAMHOC.MaNH " _ & " FROM tblHANHKIEM " _ & " INNER JOIN (tblHOCLUC " _ & " INNER JOIN tblKQNAMHOC " _ & " ON tblHOCLUC.MaHL = tblKQNAMHOC.MaHL)" _ & " ON tblHANHKIEM.MaHK=tblKQNAMHOC.MaHK" _ & " WHERE (tblKQNAMHOC.MaHS='" + MaHS + "') " Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo nam hoc RS.Filter = " (tblKQNAMHOC.MaNH='" + MaNH + "')" Set RS1 = RS.OpenRecordset RS.Close If RS1.EOF Then 'Neu khong co ket qua Chuoi = "@chưa_có_KQ_cuối_năm_học" + Im200 & TenNH(0) _ + Im400 & TenNH(1) + Im400 + "@của_học_sinh" _ + Im200 + HoTenHS Else Chuoi = "@KQ_cuối_năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) & Im400 + "@của_học_sinh" _ + Im200 + HoTenHS + Im800 + "@điểm_trung_bình" _ + Im200 + Split_FloatNumber(RS1!DTBNH) + Im400 _ + "hạng" + Im200 & RS1!HangNH & Im400 _ + "@học_lực" + Im200 + RS1!TenHL + Im400 + "@hạnh_kiểm" _ + Im200 + RS1!TenHK End If Chuoi = Chuoi + " @về_menu" RS1.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy kết quả cuối học kỳ : Public Sub Get_KQHocKy(ByVal TenHKy As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String, Chuoi As String SQL = "SELECT tblKQHOCKY.DTBHKy, " _ & " tblKQHOCKY.HangHKy, tblHOCLUC.TenHL, tblHANHKIEM.TenHK, " _ & " tblKQHOCKY.TenHKy, tblKQHOCKY.MaNH" _ & " FROM tblHANHKIEM " _ & " INNER JOIN (tblHOCLUC " _ & " INNER JOIN tblKQHOCKY " _ & " ON tblHOCLUC.MaHL = tblKQHOCKY.MaHL)" _ & " ON tblHANHKIEM.MaHK=tblKQHOCKY.MaHK " _ & " WHERE (tblKQHOCKY.MaHS='" + MaHS + "') " Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo nam hoc va hoc ky SQL = " (tblKQHOCKY.TenHKy=" & TenHKy & ") AND " _ & " (tblKQHOCKY.MaNH='" & MaNH & "')" RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close If RS1.EOF Then 'Neu khong co ket qua Chuoi = "@chưa_có_KQ_của_học_kỳ " & TenHKy _ & Im400 + "@năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) & Im400 + "@của_học_sinh" _ + Im200 + HoTenHS Else Chuoi = "@KQ_của_học_kỳ " & TenHKy & Im400 _ + "@năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) & Im400 _ & "@của_học_sinh" + Im200 + HoTenHS + Im800 _ + "@điểm_trung_bình" + Im200 + Split_FloatNumber(RS1!DTBHKy) _ + Im400 + "hạng" + Im400 & RS1!HangHKy _ & Im400 + "@học_lực" + Im200 + RS1!TenHL + Im400 _ + "@hạnh_kiểm" & Im200 & RS1!TenHK End If Chuoi = Chuoi + " @về_menu" RS1.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy kết quả cuối tháng : Public Sub Get_KQThang(ByVal TenThang As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String, Chuoi As String SQL = "SELECT tblKQTHANG.DTBThang, tblKQTHANG.HangThang, " _ & " tblHOCLUC.TenHL, tblHANHKIEM.TenHK, " _ & "tblKQTHANG.TenThang, tblKQTHANG.MaNH" _ & " FROM tblHANHKIEM " _ & " INNER JOIN (tblHOCLUC " _ & " INNER JOIN tblKQTHANG " _ & " ON tblHOCLUC.MaHL = tblKQTHANG.MaHL)" _ & " ON tblHANHKIEM.MaHK=tblKQTHANG.MaHK " _ & " WHERE (tblKQTHANG.MaHS='" + MaHS + "') " Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo nam hoc va thang SQL = " (tblKQTHANG.TenThang=" & TenThang & ") AND " _ & " (tblKQTHANG.MaNH='" & MaNH & "')" RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close If RS1.EOF Then 'Neu khong co ket qua Chuoi = "@chưa_có_KQ_của_tháng " & TenThang _ & Im400 + "@năm_học" + Im200 & TenNH(0) & Im400 _ & TenNH(1) & Im400 + "@của_học_sinh" + Im200 + HoTenHS Else Chuoi = "@KQ_của_tháng " & TenThang _ & Im400 + "@năm_học" + Im200 & TenNH(0) _ & Im400 & TenNH(1) & Im400 + "@của_học_sinh" _ + Im200 + HoTenHS + Im400 + "@điểm_trung_bình" + Im200 _ + Split_FloatNumber(RS1!DTBThang) + Im400 + "hạng" + Im200 _ & RS1!HangThang & Im400 + "@học_lực" + Im200 _ + RS1!TenHL + Im400 + "@hạnh_kiểm" + Im200 + RS1!TenHK End If Chuoi = Chuoi + " @về_menu" RS1.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy kết quả thi học kỳ : Public Sub Get_KQThi(ByVal HKThi As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String, Chuoi As String SQL = "SELECT tblKQTHI.DiemThi, tblMONHOC.TenMH, " _ + "tblKQTHI.HKThi, tblKQTHI.MaNH, tblKQTHI.MaMH" _ + " FROM tblMONHOC " _ + " INNER JOIN tblKQTHI " _ + " ON tblMONHOC.MaMH=tblKQTHI.MaMH " _ + " WHERE (tblKQTHI.MaHS='" + MaHS + "')" Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo nam hoc va hoc ky SQL = " (tblKQTHI.HKThi=" & HKThi & ") AND " _ + " (tblKQTHI.MaNH='" & MaNH & "') " RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close 'Sort RS1.Sort = "tblKQTHI.MaMH" Set RS = RS1.OpenRecordset RS1.Close If RS.EOF Then 'Neu khong co ket qua 'chưa có điểm thi = chưa có điểm thi của các môn học của học kỳ Chuoi = "@chưa_có_điểm_thi " & HKThi & Im400 + "@năm_học" _ + Im200 & TenNH(0) & Im400 & TenNH(1) _ & Im400 + "@của_học_sinh" + Im200 + HoTenHS Else 'điểm thi = điểm thi của các môn học của học kỳ Chuoi = "@điểm_thi " & HKThi & Im400 + "@năm_học" + Im200 _ & TenNH(0) & Im400 & TenNH(1) & Im400 _ + "@của_học_sinh" + Im200 + HoTenHS Do While Not RS.EOF Chuoi = Chuoi + Im800 + RS!TenMH + Im400 _ + Split_FloatNumber(RS!DiemThi) RS.MoveNext Loop End If Chuoi = Chuoi + " @về_menu" RS.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy kết quả kiểm tra trong tháng : Public Sub Get_KQKiemTra(ByVal ThangKT As Byte) Dim RS As Recordset, RS1 As Recordset Dim SQL As String, Chuoi As String Dim CurTenMH As String, CurTenLoaiKT As String, CurLanKT As String SQL = "SELECT tblKQKIEMTRA.DiemKT, tblMONHOC.TenMH, " _ & " tblKQKIEMTRA.LanKT, tblLOAIKT.TenLoaiKT, tblKQKIEMTRA.MaNH, " _ & "tblKQKIEMTRA.ThangKT, tblKQKIEMTRA.MaMH" _ & " FROM tblLOAIKT " _ & " INNER JOIN (tblMONHOC " _ & " INNER JOIN tblKQKIEMTRA " _ & " ON tblMONHOC.MaMH=tblKQKIEMTRA.MaMH) " _ & " ON tblLOAIKT.MaLoaiKT=tblKQKIEMTRA.MaLoaiKT " _ & " WHERE (tblKQKIEMTRA.MaHS='" + MaHS + "') " Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) 'Loc theo nam hoc va thang SQL = " (tblKQKIEMTRA.ThangKT=" & ThangKT & ") AND " _ & " (tblKQKIEMTRA.MaNH='" & MaNH & "')" RS.Filter = SQL Set RS1 = RS.OpenRecordset RS.Close 'Sort RS1.Sort = "tblKQKIEMTRA.MaMH, tblLOAIKT.TenLoaiKT DESC, tblKQKIEMTRA.LanKT" Set RS = RS1.OpenRecordset RS1.Close If RS.EOF Then 'Neu khong co ket qua 'chưa có điểm kiểm tra = chưa có điểm kiểm tra của các môn học của tháng Chuoi = "@chưa_có_điểm_kiểm_tra " + Im200 & ThangKT _ & Im400 + "@năm_học" + Im200 & TenNH(0) & Im400 _ & TenNH(1) & Im400 + "@của_học_sinh" + Im200 + HoTenHS Else ''điểm kiểm tra = điểm kiểm tra của các môn học của tháng Chuoi = "@điểm_kiểm_tra " & ThangKT & Im400 _ + "@năm_học" + Im200 & TenNH(0) & Im400 _ & TenNH(1) & Im400 + "@của_học_sinh" + Im200 + HoTenHS Do While Not RS.EOF CurTenMH = RS!TenMH Chuoi = Chuoi + Im800 + "môn " + Im200 + CurTenMH Do While RS!TenMH = CurTenMH CurTenLoaiKT = RS!TenLoaiKT Chuoi = Chuoi + Im800 + "@kiểm_tra " + CurTenLoaiKT Do While (RS!TenLoaiKT = CurTenLoaiKT) And (RS!TenMH = CurTenMH) CurLanKT = RS!LanKT Chuoi = Chuoi + Im800 + "lần " + CurLanKT Chuoi = Chuoi + Im400 + Split_FloatNumber(RS!DiemKT) RS.MoveNext If RS.EOF Then GoTo Thoat Loop Loop Loop End If Thoat: Chuoi = Chuoi + " @về_menu" RS.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub Lấy thông tin chi tiết về học sinh : Public Sub Get_Info_HS() Dim RS As Recordset Dim SQL As String, Chuoi As String, GT As String SQL = "SELECT tblHOCSINH.NgS, tblHOCSINH.GT, tblNOISINH.TenNS, " _ & " tblLOP.TenLOP, tblKHOI.TenKhoi " _ & " FROM tblNOISINH " _ & " INNER JOIN (tblKHOI " _ & " INNER JOIN (tblLOP " _ & " INNER JOIN (tblHOCSINH " _ & " INNER JOIN tblHS_LOP " _ & " ON tblHOCSINH.MaHS = tblHS_LOP.MaHS) " _ & " ON tblLOP.MaLop = tblHS_LOP.MaLop) " _ & " ON tblKHOI.TenKhoi = tblLOP.TenKhoi) " _ & " ON tblNOISINH.MaNS = tblHOCSINH.MaNS " _ & " WHERE tblHOCSINH.MaHS='" + MaHS + "'" Set RS = DB.OpenRecordset(SQL, dbOpenDynaset, dbReadOnly) If Not RS.EOF Then 'Neu co If RS!GT = True Then GT = "nam" Else GT = "nữ" 'thông tin chi tiết = thông tin chi tiết của học sinh Chuoi = "@thông_tin_chi_tiết" + Im200 + HoTenHS + Im400 _ & "@ngày_sinh" + Im200 & Day(RS!NgS) & " tháng " _ & Month(RS!NgS) & Im200 + " năm " & Year(RS!NgS) _ & Im400 + "@giới_tính" + Im200 + GT + Im400 + "@nơi_sinh" _ + Im200 + RS!TenNS + Im400 + "@là_học_sinh_của_lớp" + Im200 _ + Split_TenLop(RS!TenKhoi, RS!TenLop) + Im400 + "@năm_học" _ + Im200 & TenNH(0) & Im400 & TenNH(1) End If Chuoi = Chuoi + " @về_menu" RS.Close Call Monitor_DTMF(True) Call Play_Voice(Chuoi) End Sub 2. CHƯƠNG TRÌNH CẬP NHẬT DỮ LIỆU Lấy học sinh trong lớp hiện tại : 'Chon hoc sinh trong lop hien tai Private Function Load_HocSinh() As Boolean Dim SQL As String SQL = "SELECT tblHOCSINH.MaHS, tblHOCSINH.HoHS, tblHOCSINH.TenHS, " _ & " tblHOCSINH.NgS , tblHOCSINH.GT, tblHOCSINH.MaNS " _ & " FROM tblHOCSINH " _ & " INNER JOIN tblHS_LOP " _ & " ON tblHOCSINH.MaHS = tblHS_LOP.MaHS " _ & " WHERE (tblHS_LOP.MaNH ='" + frmMain.DBcboNH.BoundText + "')" _ & " AND (tblHS_LOP.MaLop = " + frmMain.DBcboLop.BoundText + ")" Set rsHS = DB.OpenRecordset(SQL) Load_HocSinh = Not rsHS.EOF End Function Thêm học sinh mới : Private Sub cmdNew_Click() On Error GoTo Thoat RecHT = rsHS.AbsolutePosition 'Luu vtri cu de quay lai rsHS.AddNew Call Lock_Data(False) Call Enable_Buttons(False) cmdUpdate.Enabled = True cmdDel.Enabled = True Call Clear_Data(False) txtMaHS = Generate_MaHS txtHoHS.SetFocus Adding = True Thoat: End Sub Sửa đổi thông tin của học sinh : 'Sua doi du lieu cua record hien tai Private Sub cmdEdit_Click() On Error GoTo Thoat Call Enable_Buttons(False) cmdUpdate.Enabled = True Call Lock_Data(False) txtMaHS = rsHS!MaHS txtHoHS.SetFocus rsHS.Edit Thoat: End Sub Lưu học sinh mới vào cơ sở dữ liệu : 'Luu du lieu vao cac table Private Function Save_Data() As Boolean Dim SQL As String rsHS!MaHS = txtMaHS rsHS!HoHS = txtHoHS rsHS!TenHS = txtTenHS rsHS!NgS = txtNgS.Tag rsHS!GT = cboGT.ListIndex - 1 rsHS!MaNS = DBcboNS.BoundText rsHS.Update If Adding Then 'Update tblHS_LOP SQL = "INSERT INTO tblHS_LOP(MaHS,MaLop,MaNH) " _ + " VALUES('" + txtMaHS + "'," _ + frmMain.DBcboLop.BoundText + ",'" + frmMain.DBcboNH.BoundText + "')" DB.Execute SQL End If End Function Xóa học sinh : Private Sub Delete_HS() Dim SQL As String Dim RS As Recordset 'Xoa 1 record trong tblHS_LOP RecHT = rsHS.AbsolutePosition If RecHT = rsHS.RecordCount - 1 Then RecHT = RecHT - 1 SQL = "DELETE FROM tblHS_LOP " _ + " WHERE (MaHS='" + txtMaHS.Text + "') " _ + " AND (MaLop=" + frmMain.DBcboLop.BoundText + ") " _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" DB.Execute SQL 'Ktra neu hoc sinh nay khong con thuoc 1 lop nao nua thi xoa khoi tblHOCSINH SQL = "SELECT MaHS FROM tblHS_LOP " _ + " WHERE (MaHS='" + txtMaHS.Text + "') " Set RS = DB.OpenRecordset(SQL) If RS.EOF Then 'HS khong con thuoc lop nao nua --> XOA SQL = "DELETE FROM tblHOCSINH " _ + " WHERE (MaHS='" + txtMaHS.Text + "') " DB.Execute SQL End If RS.Close End Sub Chuyển học sinh sang lớp khác : 'Chuyen HS qua lop khac Private Sub cmdMove_Click() Dim SQL As String On Error GoTo Thoat cmdMove.Tag = vbNullString 'Se nhan MaLop frmMove.Show vbModal, frmMain If (cmdMove.Tag vbNullString) And (cmdMove.Tag frmMain.DBcboLop.BoundText) Then RecHT = rsHS.AbsolutePosition If RecHT = rsHS.RecordCount - 1 Then RecHT = RecHT - 1 'Update tblHS_LOP SQL = "UPDATE tblHS_LOP SET MaLop=" + cmdMove.Tag _ + " WHERE (MaHS='" + txtMaHS + "') AND (MaLop=" + frmMain.DBcboLop.BoundText _ + ") AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" DB.Execute SQL 'Refresh data If Load_HocSinh() = True Then rsHS.MoveLast 'refresh completely rsHS.AbsolutePosition = RecHT Call Show_Data Else ' nothing Call Show_NoData End If End If Thoat: End Sub Thêm học sinh ở năm học cũ vào năm học mới : 'Them cac HS o nam hoc cu vao lop hien tai Private Sub cmdHSCu_Click() Dim RS As DAO.Recordset Dim SQL As String Dim NHCu As Integer Dim MaNHCu As String On Error GoTo Thoat 'Ktra nam hoc truoc co hay khong ? NHCu = CInt(Left(frmMain.DBcboNH.Text, 4)) - 1 MaNHCu = Right(CStr(NHCu), 2) SQL = "SELECT * FROM tblNAMHOC WHERE MaNH='" + MaNHCu + "'" Set RS = DB.OpenRecordset(SQL) If (NHCu < 1980) Or (RS.EOF) Then MsgBox "Kh«ng t×m thÊy n¨m häc " & NHCu & " - " & NHCu + 1 RS.Close Else cmdHSCu.Tag = RS!TenNH RS.Close frmHSCu.Show vbModal, frmMain End If Thoat: End Sub Nạp kết quả cuối học kỳ : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT * " _ + " FROM tblKQHOCKY " _ + " WHERE (tblKQHOCKY.MaHS ='" + txtMaHS + "')" _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" _ + " ORDER BY TenHKy" Set rsKQHK = DB.OpenRecordset(SQL) Load_KQ = Not rsKQHK.EOF End Function Nạp kết quả cuối năm học : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT * " _ + " FROM tblKQNAMHOC " _ + " WHERE (tblKQNAMHOC.MaHS ='" + txtMaHS + "')" _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" Set rsKQNH = DB.OpenRecordset(SQL) Load_KQ = Not rsKQNH.EOF End Function Nạp kết quả cuối tháng : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT * " _ + " FROM tblKQTHANG " _ + " WHERE (tblKQTHANG.MaHS ='" + txtMaHS + "')" _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" _ + " ORDER BY TenThang" Set rsKQThang = DB.OpenRecordset(SQL) Load_KQ = Not rsKQThang.EOF End Function Nạp kết quả kiểm tra : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT tblKQKIEMTRA.MaHS, tblKQKIEMTRA.ThangKT, tblKQKIEMTRA.MaMH, " _ + " tblKQKIEMTRA.MaNH , tblKQKIEMTRA.DiemKT, " _ + " tblKQKIEMTRA.MaLoaiKT, tblKQKIEMTRA.LanKT " _ + " FROM tblKQKIEMTRA " _ + " WHERE (tblKQKIEMTRA.MaHS ='" + txtMaHS + "')" _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" _ + " ORDER BY ThangKT, MaMH, MaLoaiKT, LanKT" Set rsKT = DB.OpenRecordset(SQL) Load_KQ = Not rsKT.EOF End Function Nạp kết quả thi : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT tblKQTHI.MaHS, tblKQTHI.HKThi, tblKQTHI.MaMH, " _ + " tblKQTHI.MaNH , tblKQTHI.DiemThi " _ + " FROM tblKQTHI " _ + " WHERE (tblKQTHI.MaHS ='" + txtMaHS + "')" _ + " AND (MaNH='" + frmMain.DBcboNH.BoundText + "')" _ + " ORDER BY HKThi, MaMH" Set rsThi = DB.OpenRecordset(SQL) Load_KQ = Not rsThi.EOF End Function Nạp các lần nghỉ học : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT tblNGHIHOC.MaHS, tblNGHIHOC.NgayNH, tblNGHIHOC.SoNgayNH, " _ + " tblNGHIHOC.GiayPhep , tblNGHIHOC.MaLD " _ + " FROM tblNGHIHOC " _ + " WHERE (tblNGHIHOC.MaHS ='" + txtMaHS + "')" _ + " ORDER BY NgayNH " Set rsNgH = DB.OpenRecordset(SQL) Load_KQ = Not rsNgH.EOF End Function Nạp các lần vi phạm : 'Chon cac ket qua cua hoc sinh hien tai Private Function Load_KQ() As Boolean Dim SQL As String SQL = "SELECT tblVIPHAM.MaHS, tblVIPHAM.NgayVP, " _ + " tblVIPHAM.LanVP, tblVIPHAM.MaLoi " _ + " FROM tblVIPHAM " _ + " WHERE (tblVIPHAM.MaHS ='" + txtMaHS + "')" _ + " ORDER BY NgayVP, LanVP " Set rsVP = DB.OpenRecordset(SQL) Load_KQ = Not rsVP.EOF End Function 3. CHƯƠNG TRÌNH THU TIẾNG NÓI Tạo vùng đệm để thu âm : 'Chuan bi vung dem va header de thu Private Function Prepare_Buffer(BufferSize As Long) As Boolean Dim Loi As Long Dim hData As Long 'Cap phat bo nho de luu cac mau am thanh hData = GlobalAlloc(GPTR, BufferSize) If hData = 0 Then MsgBox "Không thể cấp phát bộ nhớ !", vbCritical, "Thu" Prepare_Buffer = False Exit Function End If 'Tro toi vung nho vua cap phat pWaveHeader.lpData = GlobalLock(hData) If pWaveHeader.lpData = 0 Then MsgBox "Không thể lấy địa chỉ vùng nhớ được cấp phát !", vbCritical, "Thu" hData = GlobalFree(hData) Prepare_Buffer = False Exit Function End If pWaveHeader.dwBufferLength = BufferSize Loi = waveInPrepareHeader(hWaveIn, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then MsgBox "Lỗi : waveInPrepareHeader", vbCritical, "Thu" hData = GlobalFree(hData) Prepare_Buffer = False Exit Function End If Loi = waveInAddBuffer(hWaveIn, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then MsgBox "Lỗi : waveInAddBuffer", vbCritical, "Thu" hData = GlobalFree(hData) Call waveInUnprepareHeader(hWaveIn, pWaveHeader, Len(pWaveHeader)) Prepare_Buffer = False Exit Function End If 'Luu handle cua vung nho cac sample pWaveHeader.dwUser = hData Prepare_Buffer = True End Function Thu âm thanh : 'Bat dau thu am thanh Public Sub Start_Record() Dim BufferSize As Long Dim Loi As Long With pWaveFormat .cbSize = 0 .nAvgBytesPerSec = BytesPerSec .nBlockAlign = 1 .nChannels = 1 .nSamplesPerSec = BytesPerSec .wBitsPerSample = 8 .wFormatTag = 1 End With BufferSize = MaxTime * pWaveFormat.nSamplesPerSec '=Tong so sample = Tong so byte bo nho can cap phat Loi = waveInOpen(hWaveIn, SoundCard, pWaveFormat, AddressOf waveInProc, 0, CALLBACK_FUNCTION) If Loi 0 Then MsgBox "Lỗi : waveInOpen", vbCritical, "Thu" Call Enable_Buttons(True) Exit Sub End If If Prepare_Buffer(BufferSize) = False Then 'Loi Call waveInClose(hWaveIn) Call Enable_Buttons(True) Exit Sub End If 'Bat dau thu Loi = waveInStart(hWaveIn) If Loi 0 Then MsgBox "Lỗi : waveInStart", vbCritical, "Thu" Loi = waveInClose(hWaveIn) Call Enable_Buttons(True) Exit Sub End If 'Sub waveInProc will be called when finish recording End Sub Tiếp nhận các sự kiện của thiết bị thu âm : 'This sub will be called when finish recording Private Sub waveInProc(ByVal hwi As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef dwParam1 As Long, ByVal dwParam2 As Long) Select Case uMsg Case MM_WIM_DATA frmRecord.Timer1.Enabled = True End Select End Sub Lưu dữ liệu tiếng nói vào file *.sam : 'Ghi du lieu am thanh vao file Private Function Save_Voice() As Boolean Dim FileNum As Long, arrData() As Byte Dim Loi As Long Dim Res As VbMsgBoxResult Save_Voice = False 'Dinh vtri o cuoi file de ghi If Dir(SourcePath + VoiceFName, vbNormal) = vbNullString Then NewFileOffset = 1 'Offset bat dau tu 1 de ghi AddNew = True Else 'Ghi tiep vao file da co roi RS.Seek "=", Trim(txtChuoi) If RS.NoMatch = False Then 'Neu da thu roi thi xoa, sau do thu lai Res = MsgBox("Từ này đã được thu rồi. Bạn có muốn thu lại ?", vbQuestion + vbYesNo + vbDefaultButton2, "Thu") If Res = vbNo Then Exit Function proBar.Max = proBar.Max + 2 Call Remove_Voice(RS!FileOffset, RS!DataSize) AddNew = False Else AddNew = True End If NewFileOffset = FileLen(SourcePath + VoiceFName) + 1 'Di chuyen toi cuoi file End If 'Chuyen du lieu vao mang NewDataSize = pWaveHeader.dwBytesRecorded ReDim arrData(NewDataSize - 1) CopyMemory arrData(0), pWaveHeader.lpData, NewDataSize proBar.Value = proBar.Value + 1 'Cat bo silence o dau va cuoi Call Truncate(arrData()) NewDataSize = UBound(arrData) + 1 proBar.Value = proBar.Value + 1 'Ghi vao file FileNum = FreeFile Open SourcePath + VoiceFName For Binary Access Write As #FileNum Put #FileNum, NewFileOffset, arrData() Close #FileNum proBar.Value = proBar.Value + 1 Save_Voice = True End Function Cập nhật lại bảng chỉ mục sau khi xóa : 'Update FileOffset sau khi remove Voice 'Update all FileOffset > Current FileOffset Private Sub Update_Index(OldFileOffset As Long, OldDataSize As Long) Dim SQL As String SQL = "UPDATE tblVOICEINDEX SET FileOffset=FileOffset - " _ & OldDataSize & " WHERE (Nhom = '" + Nhom + "')" _ & " AND (FileOffset > " & OldFileOffset & ")" DB.Execute SQL End Sub Ghi mới vào bảng chỉ mục sau khi thu xong : 'Ghi index cua am thanh vua thu vao CSDL Private Sub Write_Index() If AddNew = True Then RS.AddNew RS!Chuoi = txtChuoi.Tag RS!Nhom = Nhom Else RS.Edit End If RS!FileOffset = NewFileOffset - 1 'Offset bat dau tu 0 khi doc ra de phat RS!DataSize = NewDataSize RS.Update End Sub Lấy thông tin của một từ đã được thu từ bảng chỉ mục : 'Lay FileOffset va DataSize trong CSDL Public Function Get_Offset_Size(ByRef FileOffset As Long, ByRef DataSize As Long) As Boolean RS.Seek "=", frmRecord.txtChuoi.Tag If RS.NoMatch Then Get_Offset_Size = False MsgBox "Chuỗi này chưa được thu !", vbCritical, Title Else FileOffset = RS!FileOffset DataSize = RS!DataSize Get_Offset_Size = True End If End Function Thêm khoảng thời gian im lặng: 'Chen them 1 khoang im lang vao dau/cuoi loi noi Private Sub Insert_Silence() Dim FileOffset As Long, DataSize As Long Dim BeforeSize As Long, AfterSize As Long 'So byte im lang can dung truoc va sau Dim i As Long Dim FileNum As Integer Dim arrData() As Byte, arrTemp() As Byte 'Tinh kich thuoc du lieu BeforeSize = Val(txtBefore) * BytesPerSec \ 1000 'Thoi gian theo milisecond AfterSize = Val(txtAfter) * BytesPerSec \ 1000 If (BeforeSize = 0) And (AfterSize = 0) Then GoTo Thoat If Get_Offset_Size(FileOffset, DataSize) = False Then GoTo Thoat NewDataSize = BeforeSize + DataSize + AfterSize 'se ghi vao CSDL ReDim arrData(NewDataSize - 1) Call Fill_Silence(arrData(), BeforeSize, AfterSize) 'Doc du lieu vao mang ReDim arrTemp(DataSize - 1) FileNum = FreeFile Open SourcePath + VoiceFName For Binary Access Read As #FileNum Get #FileNum, FileOffset + 1, arrTemp Close FileNum For i = 0 To DataSize - 1 arrData(BeforeSize + i) = arrTemp(i) Next proBar.Value = proBar.Value + 1 'Xoa bo doan du lieu cu trong CSDL Call Remove_Voice(FileOffset, DataSize) proBar.Value = proBar.Value + 1 'Ghi lai du lieu vao cuoi file voice FileNum = FreeFile Open SourcePath + VoiceFName For Binary Access Write As #FileNum NewFileOffset = LOF(FileNum) + 1 Put #FileNum, NewFileOffset, arrData Close #FileNum proBar.Value = proBar.Value + 1 'Cap nhat vao CSDL AddNew = False 'Cap nhat Call Write_Index Thoat: End Sub Xóa một đoạn âm thanh đã thu : 'Loai bo doan am thanh da co 'Offset danh tu 1 khi ghi file va danh tu 0 khi doc file de phat Private Sub Remove_Voice(OldFileOffset As Long, OldDataSize As Long) Dim FileNum_R, FileNum_W As Long Dim DataSize1 As Long, DataSize2 As Long Dim arrData() As Byte 'Mo file OldFileOffset = OldFileOffset + 1 'Offset danh tu 1 FileNum_R = FreeFile Open SourcePath + VoiceFName For Binary Access Read As #FileNum_R FileNum_W = FreeFile Open SourcePath + NewFName For Binary Access Write As #FileNum_W 'Tinh kich thuoc 2 doan du lieu dau va cuoi DataSize1 = OldFileOffset - 1 DataSize2 = FileLen(SourcePath + VoiceFName) - DataSize1 - OldDataSize 'Doc va ghi lai doan du lieu dau If DataSize1 > 0 Then 'Neu khong phai la first record ReDim arrData(DataSize1 - 1) Get #FileNum_R, , arrData Put #FileNum_W, , arrData End If proBar.Value = proBar.Value + 1 'Doc va ghi lai doan du lieu cuoi If DataSize2 > 0 Then 'Neu khong phai la last record ReDim arrData(DataSize2 - 1) Get #FileNum_R, OldFileOffset + OldDataSize, arrData Put #FileNum_W, , arrData End If Close #FileNum_R Close #FileNum_W 'Xoa file cu va doi ten file moi Kill SourcePath + VoiceFName Name SourcePath + NewFName As SourcePath + VoiceFName proBar.Value = proBar.Value + 1 'Update index table Call Update_Index(OldFileOffset - 1, OldDataSize) End Sub Nạp dữ liệu tiếng nói vào bộ nhớ để phát : 'Load data from database into memmory Private Function Loaded_VoiceFile() As Boolean Dim FileOffset As Long, DataSize As Long, hFile As Long, Loi As Long Dim pmmIOInfo As mmIOInfo 'Tim thong tin chuoi trong CSDL If Get_Offset_Size(FileOffset, DataSize) = False Then Call Enable_Buttons(True) Exit Function End If 'Ktra file voice co khong ? If File_Exist(SourcePath + VoiceFName) = False Then Call Enable_Buttons(True) Exit Function End If 'Mo file Voice de doc du lieu hFile = mmioOpen(SourcePath + VoiceFName, pmmIOInfo, MMIO_READ) Loi = mmioSeek(hFile, FileOffset, SEEK_SET) If Loi = -1 Then MsgBox "File '" + SourcePath + VoiceFName + "' không hợp lệ !", vbCritical, "Phát" Call mmioClose(hFile, 0) Call Enable_Buttons(True) Exit Function End If 'Cap phat bo nho hMem = GlobalAlloc(GMEM_ZEROINIT, DataSize) pWaveBuffer = GlobalLock(hMem) 'Doc du lieu voice Loi = mmioRead(hFile, pWaveBuffer, DataSize) If Loi = -1 Then MsgBox "Không đọc được file '" + SourcePath + VoiceFName + "'", vbCritical, "Phát" hMem = GlobalFree(hMem) Call mmioClose(hFile, 0) Call Enable_Buttons(True) Exit Function End If ' Dong file wave sau khi doc xong du lieu file wave Loi = mmioClose(hFile, 0) 'Set format for playing TotalSamples = DataSize With pWaveFormat .cbSize = 0 .nAvgBytesPerSec = BytesPerSec .nBlockAlign = 1 .nChannels = 1 .nSamplesPerSec = BytesPerSec .wBitsPerSample = 8 .wFormatTag = 1 End With Loaded_VoiceFile = True End Function Phát tiếng nói : 'Bat dau phat Private Sub Start_Playing() Dim Loi As Long Dim ErrMsg As String * 200 Loi = waveOutOpen(hWaveOut, SoundCard, pWaveFormat, AddressOf waveOutProc, 0, CALLBACK_FUNCTION) If Loi 0 Then hMem = GlobalFree(hMem) Call waveOutGetErrorText(Loi, ErrMsg, Len(ErrMsg)) MsgBox "Lỗi : waveOutOpen : " & ErrMsg, vbCritical, "Phát" Call waveOutClose(hWaveOut) Call Enable_Buttons(True) Exit Sub End If 'Chuan bi header cua am thanh de phat ra pWaveHeader.lpData = pWaveBuffer pWaveHeader.dwBufferLength = TotalSamples * pWaveFormat.nBlockAlign pWaveHeader.dwFlags = 0 pWaveHeader.dwLoops = 0 Loi = waveOutPrepareHeader(hWaveOut, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then hMem = GlobalFree(hMem) Call waveOutGetErrorText(Loi, ErrMsg, Len(ErrMsg)) MsgBox "Lỗi : waveOutPrepareHeader : " & ErrMsg, vbCritical, "Phát" Call Enable_Buttons(True) Call waveOutClose(hWaveOut) Exit Sub End If 'Bat dau phat am thanh Loi = waveOutWrite(hWaveOut, pWaveHeader, Len(pWaveHeader)) If Loi 0 Then hMem = GlobalFree(hMem) Call waveOutGetErrorText(Loi, ErrMsg, Len(ErrMsg)) MsgBox "Lỗi : waveOutWrite : " & ErrMsg, vbCritical, "Phát" Call Enable_Buttons(True) Call waveOutClose(hWaveOut) End If 'Sub waveOutProc will be called when finish playing End Sub Tiếp nhận các sự kiện của thiết bị phát âm : 'This sub will be called when finish playing Public Sub waveOutProc(ByVal hwo As Long, ByVal uMsg As Long, ByVal dwInstance As Long, ByRef hdr As WAVEHDR, ByVal dwParam2 As Long) If uMsg = MM_WOM_DONE Then frmRecord.Timer1.Enabled = True End If End Sub TÀI LIỆU THAM KHẢO CDs MSDN 10/2001 E-book : “MAPI, SAPI, and TAPI Developer's Guide” (Michael Amundsen - TAPI reference ( TAPI description ( TAPI reference and examples ( The Canonical WAVE File Format ( Audio Interchange File Format ( Modem truyền số liệu (Nguyễn Hồng Sơn - Hoàng Đức Hải) Visual Basic - Lập trình cơ sở dữ liệu Bí quyết lập trình Visual Basic 6.0 (Nguyễn Tiến - Đặng Xuân Hường - Nguyễn Văn Hoài - Trương Ngọc Vân) MỤC LỤC