网址管理系统

Dim x As Integer

Private Sub Command1_Click()
Dim sc As Integer
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
    MsgBox ("请输入完整的网站信息！")
Else
    sc = MsgBox("确实要添加这条记录吗？", vbOKCancel, "提示信息")
    If sc = 1 Then
        Dim cnn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim str As String
        Dim str1 As String
        Dim str2 As String
        Set cnn = New ADODB.Connection
        Set rs = New ADODB.Recordset
        str1 = "provider=microsoft.jet.oledb.4.0;"
        str = "Data Source=E:\vb\Access_db.mdb;"
        'str2 = "jet oledb:database password="
        cnn.Open str1 & str ' & str2
        rs.Open "select * from wzdz", cnn, 3, 3
        x = rs.RecordCount + 1
        rs.AddNew
        rs!网站名称 = Text1.Text
        rs!网站地址 = Text2.Text
        rs!网站描述 = Text3.Text
        rs!recordnum = x
        rs.Update
        cnn.Close
        MsgBox ("添加记录成功！")
        Adodc1.Refresh
    End If
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End If
End Sub

Private Sub Command2_Click()
If Not IsNumeric(Text4.Text) Or Val(Text4.Text) = 0 Then
MsgBox "记录号是大于0的自然数，请重新输入正确编号！"
Exit Sub
End If
If Text1.Text = "" And Text2.Text = "" And Text3.Text = "" Then
MsgBox "请输入完整的信息！"
Exit Sub
End If
Dim sc As Integer
sc = MsgBox("确实要修改这条记录吗？", vbOKCancel, "提示信息")
If sc = 1 Then
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim str As String
    Dim str1 As String
    Dim str2 As String
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    str1 = "provider=microsoft.jet.oledb.4.0;"
    str = "Data Source=E:\vb\Access_db.mdb;"
    'str2 = "jet oledb:database password="
    cnn.Open str1 & str ' & str2
    str2 = "select * from wzdz where 编号=" & Val(Text4.Text)
    rs.Open str2, cnn, 3, 3
    If rs!编号 = Val(Text4.Text) Then
        If Text1.Text <> "" Then
        rs!网站名称 = Text1.Text
        End If
        If Text2.Text <> "" Then
        rs!网站地址 = Text2.Text
        End If
        If Text3.Text <> "" Then
        rs!网站描述 = Text3.Text
        End If
        rs.Update
        rs.Close
        cnn.Close
        MsgBox ("修改记录成功！")
        Adodc1.Refresh
    Else
        MsgBox ("不存在此记录！")
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        rs.Close
        cnn.Close
        Exit Sub
    End If
End If
End Sub

Private Sub Command3_Click()
If Not IsNumeric(Text4.Text) Or Val(Text4.Text) = 0 Then
MsgBox "记录号是大于0的自然数，请重新输入正确编号！"
Exit Sub
End If
Dim sc As Integer
sc = MsgBox("确实要删除这条记录吗？", vbOKCancel, "提示信息")
If sc = 1 Then
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim str As String
    Dim str1 As String
    Dim str2 As String
    Dim y As Integer
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    str1 = "provider=microsoft.jet.oledb.4.0;"
    str = "Data Source=E:\vb\Access_db.mdb;"
    'str2 = "jet oledb:database password="
    cnn.Open str1 & str ' & str2
    str2 = "select * from wzdz where 编号=" & Val(Text4.Text)
    rs.Open str2, cnn, 3, 3
    If rs!编号 = Val(Text4.Text) Then
        y = rs!recordnum
        cnn.Execute "update wzdz set recordnum=recordnum-1 where recordnum >" & y
        '或者cnn.Execute "update wzdz set recordnum=recordnum-1 where recordnum > "&Val(y)&""
        '用execute提交的语句是字符串，所以这边用......"update wzdz set recordnum=recordnum-1 where recordnum>y"是不行的,可以改为"&val(y)&"
        rs.Delete
        rs.Close
        cnn.Close
        MsgBox ("删除记录成功！")
        Adodc1.Refresh
    Else
        MsgBox ("不存在此记录！")
        Text4.Text = ""
        rs.Close
        cnn.Close
        Exit Sub
    End If
End If
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub

Private Sub Command4_Click()
Dim sc As Integer
sc = MsgBox("确实要退出系统吗？", vbOKCancel, "提示信息")
If sc = 1 Then
End
End If
End Sub

Private Sub Form_Load()
x = 0
Form1.MS1.ColWidth(0) = 600
Form1.MS1.ColWidth(1) = 1000
Form1.MS1.ColWidth(2) = 2630
Form1.MS1.ColWidth(3) = 3800
Form1.MS1.ColWidth(4) = 900
Form1.Text1.Text = ""
Form1.Text2.Text = ""
Form1.Text3.Text = ""
Form1.Text4.Text = ""
'Dim cnn As ADODB.Connection
'Dim recordset As ADODB.recordset
'Dim connect_string As String
'Dim statestring As String
'Set cnn = New ADODB.Connection
'Set recordset = New ADODB.recordset
'connect_string = "dsn=access_db;UID=;psw="
'cnn.Open connect_string
'Select Case cnn.State
'    Case adstateclose
'        statestring = "adstateclosed"
'    Case adStateOpen
'        statestring = "adstateopen"
'End Select
'MsgBox "连接成功！", , statestring
'recordset.Open "select * from wzdz", cnn
'recordset.Close
End Sub