脚本宝典收集整理的这篇文章主要介绍了在线管理数据库 类,脚本宝典觉得挺不错的,现在分享给大家,也给大家做个参考。
<%
Class&nbs
p;RLManDBCls
PRivate sDBPath, RLConn, sD
BTy
PE, sServerN
ame,
SUSErName, sPassword
P
ublic Count
Private Sub Class_In
ITialize()
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 str
VAR)
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.Reco
rdset")
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 Add
PrimaryKEY(ByVal TableName, ByVal ColumnName)
On Error Resume Next
TableName = Replace(Replace(TableName,"[",""),"]","")
RLConn.Execute("ALTER TABLE "& TableName & " ADD CONSTR
aiNT 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.Cata
LOG")
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("无法建立,请检查错误信息<
br>" & Err.number & "<br>" & 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.File
SystemObject")
If Err.number<>0 Then
ErrMsg("删除文件发生错误!请查看错误信息:" & Err.number & " " & Err.Description & "<br>")
Err.Clear
DeleteDBFile = False
End If
If DbExists(filespec) THen
call fso.DeleteFile(filespec)
DeleteDBFile = True
Else
ErrMsg("删除文件发生错误!请查看错误信息:" & Err.number & " " & Err.Description & "<br>")
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 oJetEn
gine
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 v
Archar(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空格F
rom 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
%>
脚本宝典总结
以上是脚本宝典为你收集整理的在线管理数据库 类全部内容,希望文章能够帮你解决在线管理数据库 类所遇到的问题。
如果觉得脚本宝典网站内容还不错,欢迎将脚本宝典推荐好友。
本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。