在线管理数据库类代码,ASP代码库,德仔网

代码语言
代码分类
【ASP】在线管理数据库类
作者: / 发布于2010/12/30/ 762
在线管理数据类
<div>Class RLManDBCls 
Private sDBPath, RLConn, sDBType, sServerName, sUserName, sPassword 
Public Count 
Private Sub Class_Initialize() 
sDBType = "" 
End Sub 
Private Sub Class_Terminate() 
If IsObject(RlConn) Then 
RlConn.Close 
Set RlConn = Nothing 
End if 
End Sub 
Public Property Let DBType(ByVal strVar) 
sDBType = strVar 
End Property 
Public Property Let ServerName(ByVal strVar) 
sServerName = strVar 
End Property 
Public Property Let UserName(ByVal strVar) 
sUserName = strVar 
End Property 
Public Property Let Password(ByVal strVar) 
sPassword = strVar 
End Property 
'设置数据库路径 
Public Property Let DBPath(ByVal strVar) 
sDBPath = strVar 
Select Case sDBType 
Case "SQL" 
StrServer = sServerName '数据库服务器名 
StrUid = sUserName '您的登录帐号 
StrSaPwd = sPassword '您的登录密码 
StrDbName = sDBPath '您的数据库名称 
sDBPath = "driver={SQL server};server=" & StrServer & ";uid=" & StrUid & ";pwd=" & StrSaPwd & ";database=" & StrDbName 
Case "ACCESS","" 
sDBPath = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(sDBPath) 
End Select 
CheckData RLConn,sDbPath 
End Property 

'检查数据库链接，（变量名，连接字串） 
Private Sub CheckData(DataConn,ConnStr) 
On Error Resume Next 
Set DataConn = Server.CreateObject("ADODB.Connection") 
DataConn.Open ConnStr 
If Err Then 
Err.Clear 
Set DataConn = Nothing 
ErrMsg("数据库连接出错:" & Replace(ConnStr,"\","\\") & "，\n请检查连接字串，确认您输入的数据库信息是否正确。") 
Response.End 
End If 
End Sub 
'检查表是否存在 
Function CheckTable(TableName) 
On Error Resume Next 
RLConn.Execute("select * From " & TableName) 
If Err.Number <> 0 Then 
Err.Clear() 
Call ErrMsg("错误提示：" & Err.Description) 
CheckTable = False 
Else 
CheckTable = True 
End If 
End Function 

'错误提示信息（消息） 
Private Sub ErrMsg(msg) 
Response.Write msg 
Response.Flush 
End Sub 
'---------------------------------------字段值的操作----------------------------------------------- 
'修改字段的值 
Public Sub upColumn(ByVal TableName, ByVal ColumnName, ByVal ValueText,ByVal WhereStr) 
On Error Resume Next 
If WhereStr <> "" Then 
If InStr(WhereStr,"Where ")<=0 Then 
WhereStr = "Where " & WhereStr 
End if 
Else 
WhereStr = "" 
End if 
RLConn.Execute("update " & TableName & " set " & ColumnName & "=" & ValueText & " " & WhereStr) 
If Err.Number <> 0 Then 
Call ErrMsg("错误提示：" & Err.Description) 
Err.Clear() 
End If 

End Sub 

'执行SQL语句 
Public Sub Execute(StrSql) 
Set RsCount=Server.CreateObject("ADODB.RecordSet") 
On Error Resume Next 
RsCount = RLConn.Execute(StrSql) 
If Left(StrSql,12) = "Select Count" Then Count = RsCount(0) 
If Err.Number <> 0 Then 
Call ErrMsg("错误提示：" & Err.Description) 
Err.Clear() 
End If 
RsCount.Close 
Set RsCount = Nothing 
End Sub 
'---------------------------------------索引(Index),视图（View）,主键操作----------------------------------------------- 
'添加字段索引 
Public Function AddIndex(ByVal TableName, ByVal IndexName, ByVal ValueText) 
On Error Resume Next 
RLConn.Execute("CREATE INDEX " & IndexName & " ON [" & TableName & "]([" & ValueText & "])") 
If Err.Number <> 0 Then 
Call ErrMsg ("在 " & TableName & " 表新建" & IndexName & "索引错误，原因" & Err.Description & "请手工修改该索引。") 
Err.Clear() 
AddIndex = False 
Else 
AddIndex = True 
End If 
End Function 

'删除表索引 
Public Function DelIndex(ByVal TableName, ByVal IndexName) 
On Error Resume Next 
RLConn.Execute("drop空格INDEX [" & TableName & "]." & IndexName) 
If Err.Number <> 0 Then 
Call ErrMsg ("在 " & TableName & " 表删除" & IndexName & "索引错误，原因" & Err.Description & "请手工删除该索引。") 
Err.Clear() 
DelIndex = False 
Else 
DelIndex = True 
End If 
End Function 
'更改表TableName的定义把字段ColumnName设为主键 
Public Function AddPRIMARYKEY(ByVal TableName, ByVal ColumnName) 
On Error Resume Next 
TableName = Replace(Replace(TableName,"[",""),"]","") 
RLConn.Execute("ALTER TABLE "& TableName & " ADD CONSTRAINT PK_"&TableName&" PRIMARY KEY (" & ColumnName & ")") 
If Err.Number <> 0 Then 
Call ErrMsg ("在 " & TableName & " 将字段" & ColumnName & " 添加为主键时出错，原因 " & Err.Description & "请手工修改该字段属性。") 
Err.Clear() 
AddPRIMARYKEY = False 
Else 
AddPRIMARYKEY = True 
End If 
End Function 
'更改表TableName的定义把字段ColumnName主键的定义删除 
Public Function DelPRIMARYKEY(ByVal TableName, ByVal ColumnName) 
On Error Resume Next 
RLConn.Execute("ALTER TABLE "& TableName & " drop空格PRIMARY KEY (" & ColumnName & ")") 
If Err.Number <> 0 Then 
Call ErrMsg ("在 " & TableName & " 将字段" & ColumnName & " 主键的定义删除时出错，原因" & Err.Description & "请手工修改该字段属性。") 
Err.Clear() 
DelPRIMARYKEY = False 
Else 
DelPRIMARYKEY = True 
End If 
End Function 
'检查主键是否存在，返回该表的主键名 
Function GetPrimaryKey(TableName) 
on error Resume Next 
Dim RsPrimary 
GetPrimaryKey = "" 
Set RsPrimary = RLConn.OpenSchema(28,Array(Empty,Empty,TableName)) 
If Not RsPrimary.Eof Then GetPrimaryKey = RsPrimary("COLUMN_NAME") 
Set RsPrimary = Nothing 
If Err.Number <> 0 Then 
Call ErrMsg("数据库不支持检测数据表 " & TableName & " 的主键。原因 ：" & Err.Description) 
Err.Clear() 
End If 
End Function 
'---------------------------------------表结构操作----------------------------------------------- 
'添加新字段 
Public Function AddColumn(TableName,ColumnName,ColumnType) 
On Error Resume Next 
RLConn.Execute("Alter Table [" & TableName & "] Add [" & ColumnName & "] " & ColumnType & "") 
If Err Then 
ErrMsg ("新建 " & TableName & " 表中字段错误，请手动将数据库中 <B>" & ColumnName & "</B> 字段建立，属性为 <B>"&ColumnType& "</B>，原因" & Err.Description) 
Err.Clear 
AddColumn = False 
Else 
AddColumn = True 
End If 
End Function 
'更改字段通用函数 
Public Function ModColumn(TableName,ColumnName,ColumnType) 
On Error Resume Next 
RLConn.Execute("Alter Table [" & TableName & "] Alter Column [" & ColumnName & "] " & ColumnType & "") 
If Err Then 
Call ErrMsg ("更改 " & TableName & " 表中字段属性错误，请手动将数据库中 <B>" & ColumnName & "</B> 字段更改为 <B>" & ColumnType & "</B> 属性，原因" & Err.Description) 
Err.Clear 
ModColumn = False 
Else 
ModColumn = True 
End If 
End Function 
'删除字段通用函数 
Public Function DelColumn(TableName,ColumnName) 
On Error Resume Next 
If sDBType = "SQL" THen 
RLConn.Execute("Alter Table [" & TableName & "] drop空格Column [" & ColumnName & "]") 
Else 
RLConn.Execute("Alter Table [" & TableName & "] drop空格[" & ColumnName & "]") 
End if 
If Err Then 
Call ErrMsg ("删除 " & TableName & " 表中字段错误，请手动将数据库中 <B>" & ColumnName & "</B> 字段删除，原因" & Err.Description) 
Err.Clear 
DelColumn = False 
Else 
DelColumn = True 
End If 
End Function 
'---------------------------------------表操作--------------------------------------------------- 
'打开表名对象 
Private Sub ReNameTableConn() 
On Error Resume Next 
Set objADOXDatabase = Server.CreateObject("ADOX.Catalog") 
objADOXDatabase.ActiveConnection = ConnStr 
If Err Then 
ErrMsg("建立更改表名对象出错，您所要升级的空间不支持此对象，您很可能需要手动更改表名，原因" & Err.Description) 
Response.End 
Err.Clear 
End If 
End Sub 
'关闭表名对象 
Private Sub CloseReNameTableConn() 
Set objADOXDatabase = Nothing 
Conn.Close 
Set Conn=Nothing 
End Sub 
'更改数据库表名，入口参数：老表名、新表名 
Public Function RenameTable(oldName, newName) 
On Error Resume Next 
Call ReNameTableConn 
objADOXDatabase.Tables(oldName).Name = newName 
If Err Then 
Call ErrMsg ("更改表名错误，请手动将数据库中 <B>" & oldName & "</B> 表名更改为 < B>" & newName & "</B>，原因" & Err.Description) 
Err.Clear 
RenameTable = False 
Else 
RenameTable = True 
End If 
Call CloseReNameTableConn 
End Function 
'删除表通用函数 
Public Function DelTable(TableName) 
On Error Resume Next 
RLConn.Execute("drop空格Table [" & TableName & "]") 
If Err Then 
ErrMsg ("删除 " & TableName & " 表错误，请手动将数据库中 <B>" & TableName&"</B> 表删除，原因" & Err.Description) 
Err.Clear 
DelTable = False 
Else 
DelTable = True 
End If 
End Function 

'建立新表 
Public Function CreateTable(ByVal TableName,ByVal FieldList) 
Dim StrSql 
If sDBType = "SQL" THen 
StrSql = "CREATE TABLE [" & TableName & "]( " & FieldList & ")" 
Else 
StrSql = "CREATE TABLE [" & TableName & "]" 
End if 
RLConn.Execute(StrSql) 
If Err.Number <> 0 Then 
Call ErrMsg("新建 " & TableName & " 表错误，原因" & Err.Description & "") 
Err.Clear() 
CreateTable = False 
Else 
CreateTable = True 
End If 
End Function 


'---------------------------------------数据库操作----------------------------------------------- 

'建立数据库文件 
Public function CreateDBfile(byVal dbFileName,byVal SavePath) 
On error resume Next 
SavePath = Replace(SavePath,"/","\") 
If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\" 
If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName))) 
If DbExists(AppPath() & SavePath & dbFileName) Then 
ErrMsg("对不起，该数据库已经存在!" & AppPath() & SavePath & dbFileName) 
CreateDBfile = False 
Else 
Response.Write AppPath() & SavePath & dbFileName 
Dim Ca 
Set Ca = Server.CreateObject("ADOX.Catalog") 
If Err.number<>0 Then 
ErrMsg("无法建立，请检查错误信息" & Err.number & "" & Err.Description) 
Err.Clear 
CreateDBfile = False 
Exit function 
End If 
call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AppPath() & SavePath & dbFileName) 
Set Ca = Nothing 
CreateDBfile = True 
End If 
End function 

'查找数据库文件是否存在 
Private function DbExists(byVal dbPath) 
On Error resume Next 
Dim c 
Set c = Server.CreateObject("ADODB.Connection") 
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath 
If Err.number<>0 Then 
Err.Clear 
DbExists = false 
else 
DbExists = True 
End If 
set c = nothing 
End function 
'取当前真实路径 
Private function AppPath() 
AppPath = Server.MapPath("./") 
If Right(AppPath,1) = "\" THen 
AppPath = AppPath 
ELse 
AppPath = AppPath & "\" 
End if 
End function 

'删除一个数据库文件 
Public function DeleteDBFile(filespec) 
filespec = AppPath() & filespec 
Dim fso 
Set fso = CreateObject("Scripting.FileSystemObject") 
If Err.number<>0 Then 
ErrMsg("删除文件发生错误!请查看错误信息：" & Err.number & " " & Err.Description & "") 
Err.Clear 
DeleteDBFile = False 
End If 
If DbExists(filespec) THen 
call fso.DeleteFile(filespec) 
DeleteDBFile = True 
Else 
ErrMsg("删除文件发生错误!请查看错误信息:" & Err.number & " " & Err.Description & "") 
DeleteDBFile = False 
Exit Function 
End if 
Set fso = Nothing 
End function 

'修改一个数据库名 
Public function RenameDBFile(filespec1,filespec2) 
filespec1 = AppPath() & filespec1:filespec2 = AppPath() & filespec2 
Dim fso 
Set fso = CreateObject("Scripting.FileSystemObject") 
If Err.number<>0 Then 
ErrMsg("修改文件名时发生错误!请查看错误信息:" & Err.number & " " & Err.Description) 
Err.Clear 
RenameDBFile = False 
End If 
If DbExists(filespec1) THen 
call fso.CopyFile(filespec1,filespec2,True) 
call fso.DeleteFile(filespec1) 
RenameDBFile = True 
Else 
ErrMsg("源文件不存在！！！") 
RenameDBFile = False 
Exit Function 
End if 
Set fso = Nothing 
End function 
'压缩数据库 
Public Function CompactDBFile(strDBFileName) 
Dim Jet_Conn_Partial 
Dim SourceConn 
Dim DestConn 
Dim oJetEngine 
Dim oFSO 

Jet_Conn_Partial = "Provider=Microsoft.Jet.OLEDB.4.0; Data source=" 

SourceConn = Jet_Conn_Partial & AppPath() & strDBFileName 
DestConn = Jet_Conn_Partial & AppPath() & "Temp" & strDBFileName 
Set oFSO = Server.CreateObject("Scripting.FileSystemObject") 
Set oJetEngine = Server.CreateObject("JRO.JetEngine") 

With oFSO 
If Not .FileExists( AppPath() & strDBFileName) Then 
ErrMsg ("数据库文件未找到！！！！" ) 
Stop 
CompactDBFile = False 
Exit Function 
Else 
If .FileExists( AppPath() & "Temp" & strDBFileName) Then 
ErrMsg("不知道的错误！！！") 
.DeleteFile ( AppPath() & "Temp" & strDBFileName) 
CompactDBFile = False 
Exit Function 
End If 
End If 
End With 

With oJetEngine 
.CompactDatabase SourceConn, DestConn 
End With 

oFSO.DeleteFile AppPath() & strDBFileName 
oFSO.MoveFile AppPath() & "Temp" & strDBFileName,AppPath() & strDBFileName 

Set oFSO = Nothing 
Set oJetEngine = Nothing 
CompactDBFile = True 
End Function 
End Class 
Dim ManDb 
Set ManDb = New RLManDBCls 
'//---------连接SQL数据库-------------- 
'ManDb.DBType = "SQL" 
'ManDb.ServerName = "TAO-KUIZU" 
'ManDb.UserName = "sa" 
'ManDb.Password = "123456" 
'ManDb.DBPath = "hhstuss" 
'ManDb.CreateTable "cexo255","id int Not Null PRIMARY KEY, Name varchar(20) Not Null" '建立表（表名） 
'ManDb.ReNameTable "cexo255","cexo2552" '表改名（旧表名，新表名）(用组件) 
'ManDb.DelTable "cexo255" '删除表（表名） 
'ManDb.AddColumn "cexo255", "Sex", "varchar(2) null" '建立表结构（表名，字段名，数据类型） 
'ManDb.ModColumn "cexo255", "name", "int Not null" '修改表结构（表名，字段名，新数据类型）_ 
'ManDb.DelColumn "cexo255", "Sex" '删除表结构（表名，字段名） 
'ManDb.AddIndex "cexo255", "i_ID", "ID" '建立表索引（表名，索引名，索引字段名） 
'ManDb.DelIndex "cexo255", "i_ID" '删除表索引（表名，索引名） 
'ManDb.AddPRIMARYKEY "cexo255","name" '建立表主键（表名，主键字段名） 
'ManDb.DelPRIMARYKEY "cexo255","name" '删除表主键（表名，主键字段名）_ 
'Response.Write ManDb.GetPrimaryKey("cexo255") '取表的主键（表名） 
'ManDb.upColumn "cexo255","id",12345,"name = 1" '修改字段的值 
'ManDb.Execute "insert空格into cexo255(id,Name) values (2,2)" '添加记录 
'ManDb.Execute "Update cexo255 Set id = 3 Where Name = 2" '修改记录 
'ManDb.Execute "delete空格From cexo255 Where Name = 2" '删除记录 
'ManDb.Execute("Select Count(*) From cexo255"):Response.Write ManDb.Count '统计记录个数 
'If ManDb.CheckTable("StudInfo") THen Response.Write "StudInfo表存在！！！" Else Response.Write "StudInfo表不存在！！！" 
'//-----------End-------------------------- 
'//---------连接Access数据库-------------- 
ManDb.DBType = "ACCESS" 
ManDb.DBPath = "test.mdb" 
'ManDb.CreateDBfile "test2.mdb","" '建立数据库（数据库名，保存路径） 
'ManDb.DeleteDBFile("test2.mdb") '删除数据库（数据库名） 
'ManDb.RenameDBFile "test2.mdb","test3.mdb" '数据库改名（旧数据库名，新数据库名） 
'ManDb.CompactDBFile("test3.mdb") '压缩数据库（数据库名） 
'ManDb.CreateTable "dw","" '建立表（表名） 
'ManDb.ReNameTable "dw","dw2" '表改名（旧表名，新表名）(用组件)_ 
'ManDb.DelTable "dw" '删除表（表名） 
'ManDb.AddColumn "cexo255", "name", "varchar(255) Not null" '建立表结构（表名，字段名，数据类型） 
'ManDb.ModColumn "cexo255", "name", "int Not null" '修改表结构（表名，字段名，新数据类型） 
'ManDb.DelColumn "cexo255", "name" '删除表结构（表名，字段名） 
'ManDb.AddIndex "cexo255", "UserID", "ID" '建立表索引（表名，索引名，索引字段名） 
'ManDb.DelIndex "cexo255", "UserID" '删除表索引（表名，索引名）_ 
'ManDb.AddPRIMARYKEY "cexo255","id" '建立表主键（表名，主键字段名） 
'ManDb.DelPRIMARYKEY "cexo255","id" '删除表主键（表名，主键字段名）_ 
'Response.Write ManDb.GetPrimaryKey("cexo255") '取表的主键（表名） 
'ManDb.upColumn "cexo255","id","12345","id = '12'" '修改字段的值 
'ManDb.Execute "insert空格into cexo255(id) values ('789')" '添加记录 
'ManDb.Execute "Update cexo255 Set id = 'wxf' Where id = '789'" '修改记录 
'ManDb.Execute "delete空格From cexo255 Where id = 'wxf'" '删除记录 
ManDb.Execute("Select Count(*) From cexo255"):Response.Write ManDb.Count '统计记录个数 
'If ManDb.CheckTable("StudInfo") THen Response.Write "StudInfo表存在！！！" Else Response.Write "StudInfo表不存在！！！" 
'//-----------End-------------------------- 
Set ManDb = Nothing 
</div>
评论列表
本站所提供的代码，版权归原作者所有，若有侵犯作者版权，请与我们联系，我们将立即删除或修改。谢谢!
本站所有代码发布及提供者。
试试其它关键字
　管理数据库　
同语言下
可能有用的
贡献的其它代码Label