code VB

Màu nền
Font chữ
Font size
Chiều cao dòng

Dim Sql As String

Dim hsID As Integer

Private Sub btluu_Click()

If Len(txtten.Text) = 0 Or Len(txtngaysinh.Text) = 0 Then

    MsgBox "Chua nhap User hoac Password ! Kiem tra lai"

    ElseIf Not IsDate(txtngaysinh.Text) Then

        MsgBox "vui long nhap ngay cho dung"

    Else

    If hsID = 0 Then

        Sql = "select * from hocsinh where hoten='" & txtten.Text & "'"

        If LayData(rs, Sql) Then

        If Not rs.EOF Then

            MsgBox "ho ten nay co roi !!!"

        Exit Sub

         End If

         End If

 

        If LayData(rs, "select * from hocsinh") Then

            rs.AddNew

            rs.Fields("hoten") = txtten.Text

            rs.Fields("ngaysinh") = txtngaysinh.Text

            rs.Update

            rs.MoveLast

            List1.AddItem txtten.Text

            List1.ItemData(List1.NewIndex) = rs!ID

           

        End If

       

    Else

        Sql = "select * from hocsinh wherehoten") = txtten.Text

            rs.Fields("ngaysinh") = txtngaysinh.Text

            rs.Update

            End If

        End If

       

    End If

      

       End If

       rs.Requery

End Sub

Private Sub btmoi_Click()

Dim Ctl As Control

For Each Ctl In Controls

  If TypeOf Ctl Is TextBox Then

    Ctl.Text = ""

  End If

Next

hsID = 0

List1.ListIndex = -1

lbxl = ""

txtten.SetFocus

End Sub

Private Sub Command1_Click()

lbxl = ATrim(StrConv(txtten.Text, vbProperCase))

End Sub

Private Sub Form_Load()

dbAppName = App.Path & "\my.mdb"

MoCSDL ketnoiDB, dbAppName

If LayData(rs, "select * from hocsinh order by ngaysinh DESC") Then

    With List1

      .Clear

      Do While Not rs.EOF

       

        .AddItem rs.Fields("hoten") & vbNullString

        .ItemData(.NewIndex) = rs.Fields("ID")

        rs.MoveNext

      Loop

    End With

  End If

End Sub

Private Sub List1_Click()

Dim Ctl As Control

If List1.ListIndex > -1 Then

 

  hsID = List1.ItemData(List1.ListIndex)

  If rs.RecordCount > 0 Then

    rs.MoveFirst

    rs.Filter = "ID=" & hsID

    If Not rs.EOF Then

      For Each Ctl In Controls

        If TypeOf Ctl Is TextBox Then

          Ctl.Text = rs.Fields(Ctl.DataField) & vbNullString

        End If

      Next

    End If

    End If

End If

End Sub

Private Function ATrim(ByVal Name As String) As String

Name = LTrim(RTrim(Name))

Do While InStr(Name, "  ") <> 0

Name = Replace(Name, "  ", " ")

Loop

ATrim = Name

End Function

KET NOI CO SO DU LIEU

Option Explicit

Public rs As Recordset

Public ketnoiDB As ADODB.Connection

Public dbAppName As String ', Sql As String

Public SqlStr As String

Public rs1 As Recordset

Public Function MoCSDL(dbConn As ADODB.Connection, m_dbName As String) As Boolean

On Error GoTo errH:

   Set dbConn = New ADODB.Connection

   With dbConn

      .Provider = "Microsoft.Jet.OLEDB.4.0"

      .Properties("Jet OLEDB:Database Password") = ""

      .Mode = adModeReadWrite

      .Open m_dbName

   End With

   MoCSDL = True

   'MsgBox "Connect Successfull !", vbOKOnly, "Information"

Exit Function

errH:

    MoCSDL = False

    BaoLoi Err.Description & " (" & Err.Number & ")-MoCSDL (" & m_dbName & ")"

    Exit Function

End Function

Public Function LayData(m_rs As Recordset, Sql As String) As Boolean

On Error GoTo errg

Set m_rs = New ADODB.Recordset

m_rs.Open Sql, ketnoiDB, adOpenStatic, adLockOptimistic

LayData = True

Exit Function

errg:

  LayData = False

  BaoLoi Err.Description & " (" & Err.Number & ")-getrecord"

  Exit Function

End Function

Public Sub BaoLoi(vData As String)

Screen.MousePointer = 0

MsgBox "Co Loi Xay Ra"

End Sub

Bạn đang đọc truyện trên: Truyen2U.Net