Nối Kết Cơ Sở Dữ Liệu Bằng VB 6.0

Bài Viết Chỉ Cách Viết Kết Nối CSDL Access bằng VB6.0 Mong Rằng Bài Viết Của Mình Giúp Các Ban Nối CSDL Access được dể dàng(toàn bằng mã lệnh), chứ không dùng công cụ trợ giúp ADO của VB6.o và đoạn mã viết bằng Kiểm Tra Ngày Tháng Năm. các bạn tham khảo nha.

Public Sub KetNoiDataEnvironment()
Dim db_name, str As String
db_name = App.Path & "\GIUPDO.MDB"
str = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & db_name & ""
Devm.DConection.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info = False;Data Source=" & db_name & ""
Devm.DConection.Open
cn1.Open str
End Sub

Public Sub KetNoi()
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\DOANTOTNGHIEP.mdb"
cn.CursorLocation = adUseClient
cn.Open
End Sub

Public Sub LienKet(Frm As Form, rs As ADODB.Recordset)
Dim ctrDieuKhien As Control
For Each ctrDieuKhien In Frm.Controls
If ctrDieuKhien.tag = 1 Then
Set ctrDieuKhien.DataSource = rs
ctrDieuKhien.DataMember = ""
ctrDieuKhien.DataField = Mid(ctrDieuKhien.Name, 4)
End If
Next
End Sub

Public Function KiemTraRecordset(rs As ADODB.Recordset) As Boolean
Select Case rs.CursorLocation
Case adOpenForwardOnly, adOpenDynamic, adOpenKeyset
KiemTraRecordset = rs.BOF And rs.EOF
Case adOpenStatic
KiemTraRecordset = (rs.RecordCount = 0)
End Select
End Function

Public Sub Them(rs As ADODB.Recordset)
rs.AddNew
End Sub

Public Sub Ghi(rs As ADODB.Recordset)
rs.Update
End Sub

Public Sub PhucHoi(Frm As Form, Optional tag = "1")
Dim ctrDieuKhien As Control
For Each ctrDieuKhien In Frm.Controls
If ctrDieuKhien.tag = tag Then
ctrDieuKhien.DataChanged = False
End If
Next
End Sub

Public Sub BoQua(Frm As Form, bmk As Variant, rs As ADODB.Recordset)
PhucHoi Frm
rs.CancelUpdate
If bmk > 0 Then
rs.Bookmark = bmk
Else
rs.Requery
End If
End Sub

Public Function KiemTraNgayThangNam(strdate As String) As String
Dim temp As Integer
Dim strTemp As String
temp = 3 'Kiem tra ngay
If IsNumeric(Left(strdate, 1)) Then
If IsNumeric(Mid(strdate, 2, 1)) Then
If Left(strdate, 2) <= 31 Then
'Kiem tra co dau "/"
If Mid(strdate, temp, 1) = "/" Then
'Kiem tra thang
If IsNumeric(Mid(strdate, temp + 1, 1)) Then
If IsNumeric(Mid(strdate, temp + 2, 1)) Then
If Mid(strdate, temp + 1, 2) <= 12 Then
'Kiem tra co dau "/"
If Mid(strdate, temp + 3, 1) = "/" Then
'Kiem tra nam
If Len(strdate) = 10 Then 'Kiem tra du dd/mm/yyyy

If IsDate(strdate) Then
If Mid(strdate, temp + 4, 4) >= 1900 Then 'Kiem tra nam co >1900
'Kiem tra lon hon 18 tuoi

Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
GoTo BaoLoi
End If
Else
BaoLoi:
KiemTraNgayThangNam = "1"
End If
End Function

Public Function KiemTraTuoi(strdate As String) As String
b = Format(Date, "dd/mm/yyyy")
s1 = Left(b, 2)
s2 = Mid(b, 4, 2)
s3 = Mid(b, 7, 4)

a = (strdate)
a1 = Left(a, 2)
a2 = Mid(a, 4, 2)
a3 = Mid(a, 7, 4)
'Tinh toan
c1 = s1 - a1
c2 = s2 - a2
c3 = s3 - a3
'So sanh
If c3 > 18 Then
GoTo Dung
Else
If c3 = 18 Then
If c2 < 0 Then
GoTo Dung
Else
If c2 = 0 Then
If c1 <= 0 Then
GoTo Dung
Else
If c1 > 0 Then
GoTo BaoLoi
End If
End If
Else
BaoLoi:
KiemTraTuoi = "1"
Exit Function
End If
End If
Else
GoTo BaoLoi
End If
Dung:
KiemTraTuoi = "0"
End If
End Function


Email: tech@hungnga.com.vn
Thứ Sáu, 10/06/2005 08:33
53 👨 4.765
0 Bình luận
Sắp xếp theo