程式師世界 >> 編程語言 >> 網頁編程 >> ASP編程 >> 關於ASP編程 >> 在線管理數據庫類

在線管理數據庫類

編輯：關於ASP編程

<%
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 & " 表中字段錯誤，請手動將數據庫中 " & ColumnName & " 字段建立，屬性為 "&ColumnType& "，原因" & 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 & " 表中字段屬性錯誤，請手動將數據庫中 " & ColumnName & " 字段更改為 " & ColumnType & " 屬性，原因" & 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 & " 表中字段錯誤，請手動將數據庫中 " & ColumnName & " 字段刪除，原因" & 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 ("更改表名錯誤，請手動將數據庫中 " & oldName & " 表名更改為 " & newName & "，原因" & 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 & " 表錯誤，請手動將數據庫中 " & TableName&" 表刪除，原因" & 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
%>