代码改变世界

VB 增删改查

2020-09-11 22:11  idea555  阅读(396)  评论(0)    收藏  举报

Option Explicit

Private Sub Text2_Change()

End Sub

Private Sub Command1_Click()

If Text1(0).Text = "" Then
MsgBox ("请输入用户名")
Text1(0).SetFocus
Exit Sub
End If

If Text1(1).Text = "" Then
MsgBox ("请输入密码")
Text1(1).SetFocus
Exit Sub
End If

Dim objConn As ADODB.Connection
Dim objRS As ADODB.Recordset
Set objConn = New ADODB.Connection
Set objRS = New ADODB.Recordset
Dim userName As String
Dim password As String
userName = Trim(Text1(0).Text)
password = Trim(Text1(1).Text)

objConn.ConnectionString = "Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;User ID=sa;Initial Catalog=Test;Data Source=PC-20190830UKXS\SQL2014"
objConn.Open


objRS.CursorLocation = adUseClient
objRS.Open "select * from Admin where userName = '" & userName & "'", objConn, adOpenStatic, adLockReadOnly

If objRS.RecordCount > 0 Then
If (objRS!password <> password) Then
MsgBox ("密码错误")
Else
MsgBox ("登陆成功")
list.Show
Unload Me
End If
Else
MsgBox ("用户名不存在")
Text1(0).SetFocus
Exit Sub
End If


End Sub

 

 

Option Explicit

Private Sub Form_Load()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset

conn.ConnectionString = "Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;User ID=sa;Initial Catalog=Test;Data Source=PC-20190830UKXS\SQL2014"
conn.Open
rs.CursorLocation = adUseClient
rs.Open "select * from news", conn, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
Set DataGrid1.DataSource = rs
End If
End Sub



Option Explicit

Private Sub Command1_Click()
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;User ID=sa;Initial Catalog=Test;Data Source=PC-20190830UKXS\SQL2014"
conn.Open

Dim rs As New ADODB.Recordset
Dim sql As String
If Trim(Text1.Text) = "" Then
MsgBox "请输入标题", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If

If Trim(Text2.Text) = "" Then
MsgBox "请输入内容", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Exit Sub
End If

sql = "insert into news (title,content,createtime) values ('" & Text1.Text & "','" & Text2.Text & "',getdate())"
conn.Execute sql

MsgBox "插入成功"

rs.Close
conn.Close

End Sub

Private Sub Command2_Click()

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;User ID=sa;Initial Catalog=Test;Data Source=PC-20190830UKXS\SQL2014"
conn.Open
Dim rs As New ADODB.Recordset

If Trim(Text3.Text) = "" Then
MsgBox "请输入编号"
Text3.SetFocus
Exit Sub
End If

Dim sql As String
sql = "update news set title = '" & Text1.Text & "',content = '" & Text2.Text & "' where Id =" & Text3.Text
conn.Execute sql

MsgBox "修改成功"

End Sub

Private Sub Command3_Click()

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=SQLOLEDB.1;Password=123456;Persist Security Info=True;User ID=sa;Initial Catalog=Test;Data Source=PC-20190830UKXS\SQL2014"
conn.Open
Dim rs As New ADODB.Recordset

If Trim(Text3.Text) = "" Then
MsgBox "请输入编号"
Text3.SetFocus
Exit Sub
End If

Dim sql As String
sql = "delete from news where Id = " & Text3.Text
conn.Execute sql
MsgBox "删除成功"

End Sub