以ID为标识的数据库处理：
Dim strConn As String
Dim conn As ADODB.Connection
Private Sub connn()
On Error Resume Next
strConn = "Provider=Sqloledb;User ID=" & Text10.Text & ";Password=" & Text11.Text & ";Initial Catalog=" & Text9.Text & ";Data Source=" & Text8.Text & ""
Set conn = New ADODB.Connection
conn.Open strConn
If Err.Number = 0 Then
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
DataCombo1.Enabled = True
Text8.Locked = True
Text8.BackColor = &H8000000B
Text9.Locked = True
Text9.BackColor = &H8000000B
Text10.Locked = True
Text10.BackColor = &H8000000B
Text11.Locked = True
Text11.BackColor = &H8000000B
End If
If Err.Number <> 0 Then
MsgBox "连接数据库失败！！", vbOKOnly + vbExclamation, "数据库"
Exit Sub
End If
End Sub
Private Sub Command1_Click()
Dim rs1 As New ADODB.Recordset
Dim sql1 As String
If IsNumeric(Text5.Text) Then
If MsgBox("删除当前记录条数吗?", vbYesNo + vbQuestion, "删除数据") = vbYes Then
Set minid1 = conn.Execute("select min(id) from " & DataCombo1.Text & "")
findform = True
sql1 = "delete from " & DataCombo1.Text & " where id between 1 and '" & Trim(Text5.Text) & "'"
rs1.CursorLocation = adUseClient
rs1.Open sql1, conn, adOpenKeyset, adLockPessimistic
rs1.CursorLocation = adUseClient
If Text5.Text - minid1.Fields(0) + 1 > 0 Then
MsgBox "删除成功，删除记录条数为：" & Trim(Text5.Text - minid1.Fields(0) + 1) & "", vbOKOnly + vbExclamation, "删除记录"
Else: MsgBox "删除了0条记录", vbOKOnly + vbExclamation, "删除记录"
End If
Call DataCombo1_Change
End If
Else: MsgBox "请输入数据记录条数", vbOKOnly + vbExclamation, "提示"
Text5.SetFocus
End If
End Sub
Private Sub Command10_Click()
Set biaoshi = conn.Execute("Select OBJECTPROPERTY(OBJECT_ID('" & DataCombo1.Text & "'),'TableHasIdentity')")
If biaoshi.Fields(0) = 0 Then
On Error GoTo err11
conn.Execute ("ALTER TABLE " & DataCombo1.Text & " ADD ID1 bigint identity(1,1) not null")
conn.Execute ("SET IDENTITY_INSERT " & DataCombo1.Text & " ON")
conn.Execute ("update " & DataCombo1.Text & " set ID1=ID")
conn.Execute ("SET IDENTITY_INSERT " & DataCombo1.Text & " OFF")
err11:
conn.Execute ("ALTER TABLE " & DataCombo1.Text & " DROP COLUMN ID")
conn.Execute ("exec sp_rename '" & DataCombo1.Text & ".ID1','ID'")
MsgBox "已把ID设为标识", vbOKOnly + vbExclamation, "提示"
Call DataCombo1_Change
Else: MsgBox "ID已经为标识！！", vbOKOnly + vbExclamation, "提示"
End If
End Sub
Private Sub Command11_Click()
Call connn
End Sub
Private Sub Command12_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Locked = False
Text8.BackColor = &H80000005
Text9.Locked = False
Text9.BackColor = &H80000005
Text10.Locked = False
Text10.BackColor = &H80000005
Text11.Locked = False
Text11.BackColor = &H80000005
Text8.SetFocus
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = False
DataCombo1.Enabled = False
End Sub
Private Sub Command2_Click()
Dim rs2 As New ADODB.Recordset
Dim sql2 As String
If MsgBox("是否重新排序?", vbYesNo + vbQuestion, "排序") = vbYes Then
On Error GoTo err12
findform = True
sql2 = "update " & DataCombo1.Text & " set id=id-(select min(id) from " & DataCombo1.Text & ")+1"
rs2.CursorLocation = adUseClient
rs2.Open sql2, conn, adOpenKeyset, adLockPessimistic
Call DataCombo1_Change
MsgBox "排序成功！", vbOKOnly + vbExclamation, "提示"
End If
Exit Sub
err12: MsgBox "ID为标识,不能排序！！", vbOKOnly + vbExclamation, "提示"
End Sub
Private Sub Command6_Click()
Text6.Text = ""
Text6.SetFocus
End Sub
Private Sub Command8_Click()
Text7.Text = ""
Text7.SetFocus
End Sub
Private Sub Command9_Click()
conn.Execute ("ALTER TABLE " & DataCombo1.Text & " ADD ID_temp decimal")
conn.Execute ("UPDATE " & DataCombo1.Text & " SET ID_temp = ID ALTER TABLE " & DataCombo1.Text & " DROP COLUMN ID")
conn.Execute ("EXEC sp_rename N'" & DataCombo1.Text & ".ID_temp',N'ID',N'COLUMN'")
MsgBox "已把ID设为非标识", vbOKOnly + vbExclamation, "提示"
Call DataCombo1_Change
End Sub
Private Sub DataCombo1_Change()
On Error Resume Next
Dim rs As New ADODB.Recordset
Dim sql As String
findform = True
sql = "select * from " & DataCombo1.Text & " order by id"
rs.CursorLocation = adUseClient
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
Set DataGrid1.DataSource = rs
DataGrid1.Refresh
Set minid = conn.Execute("select min(id) from " & DataCombo1.Text & "")
Text1.Text = minid.Fields(0)
Set maxid = conn.Execute("select max(id) from " & DataCombo1.Text & "")
Text2.Text = maxid.Fields(0)
Set mindate = conn.Execute("select pdate from " & DataCombo1.Text & " where id=(select min(id) from " & DataCombo1.Text & ")")
Text3.Text = mindate.Fields(0)
Set maxdate = conn.Execute("select pdate from " & DataCombo1.Text & " where id=(select max(id) from " & DataCombo1.Text & ")")
Text4.Text = maxdate.Fields(0)
If Err.Number <> 0 Then
MsgBox "未连接数据库！！", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
Command1.Enabled = True
Command2.Enabled = True
Command9.Enabled = True
Command10.Enabled = True
End Sub
Private Sub DataCombo1_Click(Area As Integer)
Dim rs11 As New ADODB.Recordset
Dim sql11 As String
On Error Resume Next
findform = True
sql11 = "select name from sysobjects where xtype='u' and name<>'dtproperties' and name<>'fieldnametable'"
rs11.CursorLocation = adUseClient
rs11.Open sql11, conn, adOpenKeyset, adLockPessimistic
Set DataCombo1.RowSource = rs11
DataCombo1.ListField = "name"
If Err.Number <> 0 Then
MsgBox "未连接数据库！！", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
End Sub
Private Sub Command3_Click()
CommonDialog1.Filter = "备份文件(*.bak)|*.bak|文本文件(*.txt)|*.txt|ALL File(*.*)|*.*"
CommonDialog1.ShowSave
Text6.Text = CommonDialog1.FileName
End Sub
Private Sub Command4_Click()
CommonDialog2.Filter = "备份文件(*.bak)|*.bak|文本文件(*.txt)|*.txt|ALL File(*.*)|*.*"
CommonDialog2.ShowOpen
Text7.Text = CommonDialog2.FileName
End Sub
Private Sub Command5_Click()
Dim sql3 As String
If Text6.Text = "" Then
MsgBox "请您选择数据库备份的路径!", 64, "提示信息"
Else
If MsgBox("是否备份数据库?", vbYesNo + vbQuestion, "提示") = vbYes Then
sql3 = "backup DATABASE " & Text9.Text & " TO disk='" & Text6.Text & "'"
conn.Execute (sql3)
MsgBox "数据库备份成功!!", 64, "提示信息"
End If
End If
End Sub
Private Sub Command7_Click()
On Error GoTo err1
If Text7.Text = "" Then
MsgBox "请您选择数据库恢复的路径!", 64, "提示信息"
Else
If MsgBox("是否还原数据库?", vbYesNo + vbQuestion, "提示") = vbYes Then
sql = "RESTORE DATABASE " & Text9.Text & " from disk='" & Text7.Text & "'"
conn.Execute (sql)
MsgBox "数据库恢复成功!!", 64, "提示信息"
End If
End If
Exit Sub
err1:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = False
DataCombo1.Enabled = False
End Sub
kuRzqDXM.rar