在线管理数据库 类

<%

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("无法建立，请检查错误信息<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.FileSystemObject")

        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 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

%>