在线数据库管理工具 1.5

本程序由成都分类信息网提供

在线数据库管理工具 1.5 <% if request("key") = "db" then session("dbtype") = request("dbtype") session("dbstr") = request("dbstr") response.redirect "?" end if if request("key") = "createdatabase" then call createdatabase() end if if session("dbtype") = "" or session("dbstr") = "" then %> <% response.End() end if '==================================================================建库 sub createdatabase() dim DBName,dbstr,myCat on error resume next DBName = request("dataname") dbstr = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & DBName Set myCat = Server.CreateObject( "ADOX.Catalog" ) myCat.Create dbstr if err <> 0 then response.write err.description session("dbtype") = "" session("dbstr") = "" response.write "" response.end end if session("dbtype") = "access" session("dbstr") = dbstr response.redirect "?" end sub '==================================================================调用链接函数 conn() function conn() dim conn1,connstr on error resume next select case session("dbtype") case "access" '==================================================================连接ACCESS数据库 dbope() connstr = session("dbstr") Set Conn1 = Server.CreateObject("ADODB.Connection") conn1.Open connstr case "sql" '==================================================================连接SQL数据库 dbope() set conn1 = Server.CreateObject("ADODB.Connection") conn1.open session("dbstr") end select if err <> 0 then response.write err.description session("dbtype") = "" session("dbstr") = "" response.write "" response.end end if set conn = conn1 end function Sub echo(str) Response.Write(str) End Sub Function IIf(var, val1, val2) If var = True Then IIf = val1 Else IIf = val2 End If End Function '正则表达式函数，用于删除注释 '------------------------------------- Function RegExpReplace(strng, patrn, replStr) Dim regEx,match,matches ' 建立变量。 Set regEx = New RegExp ' 建立正则表达式。 regEx.Pattern = patrn ' 设置模式。 regEx.IgnoreCase = True ' 设置是否区分大小写。 regEx.Global = True ' 设置全局可用性。 RegExpReplace = regEx.Replace(strng, replStr) ' 作替换。 End Function '==================================================================ADOVBS 常量声明 '---- DataTypeEnum Values ---- Const adEmpty = 0 Const adTinyInt = 16 Const adSmallInt = 2 Const adInteger = 3 Const adBigInt = 20 Const adUnsignedTinyInt = 17 Const adUnsignedSmallInt = 18 Const adUnsignedInt = 19 Const adUnsignedBigInt = 21 Const adSingle = 4 Const adDouble = 5 Const adCurrency = 6 Const adDecimal = 14 Const adNumeric = 131 Const adBoolean = 11 Const adError = 10 Const adUserDefined = 132 Const adVariant = 12 Const adIDispatch = 9 Const adIUnknown = 13 Const adGUID = 72 Const adDate = 7 Const adDBDate = 133 Const adDBTime = 134 Const adDBTimeStamp = 135 Const adBSTR = 8 Const adChar = 129 Const adVarChar = 200 Const adLongVarChar = 201 Const adWChar = 130 Const adVarWChar = 202 Const adLongVarWChar = 203 Const adBinary = 128 Const adVarBinary = 204 Const adLongVarBinary = 205 '---- FieldAttributeEnum Values ---- Const adFldMayDefer = &H00000002 Const adFldUpdatable = &H00000004 Const adFldUnknownUpdatable = &H00000008 Const adFldFixed = &H00000010 Const adFldIsNullable = &H00000020 Const adFldMayBeNull = &H00000040 Const adFldLong = &H00000080 Const adFldRowID = &H00000100 Const adFldRowVersion = &H00000200 Const adFldCacheDeferred = &H00001000 '---- SchemaEnum Values ---- '---- SchemaEnum Values ---- Const adSchemaProviderSpecific = -1 Const adSchemaAsserts = 0 Const adSchemaCatalogs = 1 Const adSchemaCharacterSets = 2 Const adSchemaCollations = 3 Const adSchemaColumns = 4 Const adSchemaCheckConstraints = 5 Const adSchemaConstraintColumnUsage = 6 Const adSchemaConstraintTableUsage = 7 Const adSchemaKeyColumnUsage = 8 Const adSchemaReferentialConstraints = 9 Const adSchemaTableConstraints = 10 Const adSchemaColumnsDomainUsage = 11 Const adSchemaIndexes = 12 Const adSchemaColumnPrivileges = 13 Const adSchemaTablePrivileges = 14 Const adSchemaUsagePrivileges = 15 Const adSchemaProcedures = 16 Const adSchemaSchemata = 17 Const adSchemaSQLLanguages = 18 Const adSchemaStatistics = 19 Const adSchemaTables = 20 Const adSchemaTranslations = 21 Const adSchemaProviderTypes = 22 Const adSchemaViews = 23 Const adSchemaViewColumnUsage = 24 Const adSchemaViewTableUsage = 25 Const adSchemaProcedureParameters = 26 Const adSchemaForeignKeys = 27 Const adSchemaPrimaryKeys = 28 Const adSchemaProcedureColumns = 29 Const adSchemaDBInfoKeywords = 30 Const adSchemaDBInfoLiterals = 31 Const adSchemaCubes = 32 Const adSchemaDimensions = 33 Const adSchemaHierarchies = 34 Const adSchemaLevels = 35 Const adSchemaMeasures = 36 Const adSchemaProperties = 37 Const adSchemaMembers = 38 Const adSchemaTrustees = 39 Const adSchemaFunctions = 40 Const adSchemaActions = 41 Const adSchemaCommands = 42 Const adSchemaSets = 43 '==================================================================返回字段类型函数 Function typ(field_type) 'field_type = 字段类型值 Select Case field_type case adEmpty:typ = "Empty" case adTinyInt:typ = "TinyInt" case adSmallInt:typ = "SmallInt" case adInteger:typ = "Integer" case adBigInt:typ = "BigInt" case adUnsignedTinyInt:typ = "TinyInt" 'UnsignedTinyInt case adUnsignedSmallInt:typ = "UnsignedSmallInt" case adUnsignedInt:typ = "UnsignedInt" case adUnsignedBigInt:typ = "UnsignedBigInt" case adSingle:typ = "Single" 'Single case adDouble:typ = "Double" 'Double case adCurrency:typ = "Money" 'Currency case adDecimal:typ = "Decimal" case adNumeric:typ = "Numeric" 'Numeric case adBoolean:typ = "Bit" 'Boolean case adError:typ = "Error" case adUserDefined:typ = "UserDefined" case adVariant:typ = "Variant" case adIDispatch:typ = "IDispatch" case adIUnknown:typ = "IUnknown" case adGUID:typ = "GUID" 'GUID case adDATE:typ = "DateTime" 'Date case adDBDate:typ = "DBDate" case adDBTime:typ = "DBTime" case adDBTimeStamp:typ = "DateTime" 'DBTimeStamp case adBSTR:typ = "BSTR" case adChar:typ = "Char" case adVarChar:typ = "VarChar" case adLongVarChar:typ = "LongVarChar" case adWChar:typ = "Text" 'WChar类型 SQL中为Text case adVarWChar:typ = "VarChar" 'VarWChar case adLongVarWChar:typ = "Text" 'LongVarWChar case adBinary:typ = "Binary" case adVarBinary:typ = "VarBinary" case adLongVarBinary:typ = "LongBinary"'LongVarBinary case adChapter:typ = "Chapter" case adPropVariant:typ = "PropVariant" case else:typ = "Unknown" end select End Function '==================================================================返回字段类型列表 Function fieldtypelist(n) dim strlist,str1,str2 strlist = "" echo strlist End Function Private Function GetUrl() Domain_Name = LCase(Request.ServerVariables("Server_Name")) Page_Name = LCase(Request.ServerVariables("Script_Name")) Quary_Name = LCase(Request.ServerVariables("Quary_String")) If Quary_Name ="" Then GetUrl = "http://"&Domain_Name&Page_Name Else GetUrl = "http://"&Domain_Name&Page_Name&"?"&Quary_Name End If End Function '==================================================================主界面 sub main(str) on error resume next %>

<% if str = "" then %>

导出所有表结构到SQL <% end if end sub '==================================================================创建表界面 sub add_table(table_name,field_num) 'table_name = 表名称 'field_num = 字段数 on error resume next if not IsNumeric(field_num) then echo "字段数必须是整数。" echo "" exit sub end if %>

创建表：<%=table_name%>

<% end sub '==================================================================构建创建表的SQL语句 sub create_table() dim sql,i,primarykey on error resume next sql = "CREATE TABLE ["&request("table_name")&"] (" for i = 1 to request("i") sql = sql & "[" & request("field_name")(i) & "] " & request("field_type")(i) if request("field_size")(i) <> "" then sql = sql & "(" & request("field_size")(i) & ")" end if if request("null")(i) = "NOT_NULL" then sql = sql & " not null" end if if request("autoincrement")(i) = "自动编号" then sql = sql & " identity" end if if request("primarykey")(i) = "primarykey" then primarykey = request("field_name")(i) end if 'if primarykey <> "" then sql = sql & "," 'end if next if primarykey<>"" then sql=sql&" primary key (["&primarykey&"]) " end if sql = sql & ")" sql = replace(sql,"()","") '构建空表 response.redirect "?key=sql&sql=" & sql end sub '==================================================================修改表名或字段名 2006-09-08 sub reobj() on error resume next Dim mydb,mytable,tablename tablename = request("tablename") Set mydb = Server.CreateObject("ADOX.Catalog") mydb.ActiveConnection = conn if request("obj") = "field" then '修改字段名 dim fieldsname,newfieldsname fieldsname = request("fieldsname") newfieldsname = request("newfieldsname") Set mytable = Server.CreateObject("ADOX.Table") Set mytable = mydb.Tables(tablename) mytable.Columns(fieldsname).Name = newfieldsname end if if request("obj") = "table" then '修改表名 dim newtablename newtablename = request("newtablename") mydb.Tables(tablename).Name = newtablename end if if err <> 0 then echo err.description echo "" exit sub end if if request("obj") = "field" then response.Redirect "?key=view&table_name=" & tablename else response.Redirect "?key=view&table_name=" & newtablename end if end sub sub dbope if session("dbope") <> 1 then %> <% session("dbope")=1 end if end sub '==================================================================查看表结构函数 sub view(table_name) 'table_name = 表名称 dim rs,sql,table,primary,primarykey,i,editstr,typs on error resume next table = table_name Set primary = Conn.OpenSchema(adSchemaPrimaryKeys,Array(empty, empty, table)) if primary("COLUMN_NAME") <> "" then primarykey = primary("COLUMN_NAME") end if primary.Close Set primary = Nothing %> 表：<%=table_name%>

<% if request("key") = "editfidlevi" then call editfidlevi() %> <% sql = "SELECT * FROM [" & table_name & "] " Set rs = Conn.Execute(sql) if err = 0 then For i = 0 to rs.fields.count-1 %> <% editstr = editstr&"" next %>

字段名	类型	设定大小	允许空	自动编号	主键	执行操作
<%=rs(i).name%>	<%=typ(rs(i).type)%>	<%=rs(i).definedsize%>	<%=iif((rs(i).Attributes and adFldIsNullable)=0,"No","Yes")%>	<%=iif(rs(i).Properties("ISAUTOINCREMENT") = True,"是","否")%>	<%=iif(rs(i).name = primarykey,"是","否")%>	修改删除

导出表结构浏览表记录删除表

<% '判断是否有主键 if primarykey = "" then echo "该表没有主键，执行操作可能会导致数据损坏或丢失。
" echo "你可以将：" echo " " echo "" echo "

" end if '显示修改字段名 echo " 改名为 " & chr(10) echo " " & chr(10) echo " 修改字段属性： <% end if next end sub '==================================================================执行修改字段属性 sub editfidle() on error resume next sql = "ALTER TABLE [" & request("table_name") & "] " sql = sql&"ALTER COLUMN [" & request("fidle") & "] " if request("field_type") <> "" then sql = sql & request("field_type") end if if request("size") <> "" then sql = sql & "(" & request("size") & ") " end if if request("null") = "" then sql = sql & " not null" end if if request("autoincrement") = "y" then sql = sql & " identity" end if sql = trim(sql) conn.execute(sql) response.redirect "?key=view&table_name="& request("table_name") end sub '==================================================================添加字段函数 sub addfield() on error resume next fldname = request("fldname") fldtype = request("field_type") fldsize = request("fldsize") fldnull = request("null") fldautoincrement = request("autoincrement") table_name = request("table_name") if fldname <> "" and fldtype <> "" then sql = "alter table [" & table_name & "] add ["&fldname&"] " & fldtype if fldsize <> "" then sql = sql & "(" & fldsize & ")" end if if fldnull <> "ON" then sql = sql & " not null" end if if fldautoincrement = "ON" then sql = sql & " identity" end if conn.execute(sql) response.redirect "?key=view&table_name=" & table_name else echo "输入数据错误！" end if if err <> 0 then echo err.description echo "" response.end end if end sub '==================================================================编辑数据 sub editdata() dim keys,names,values,action,rs,sql,tab on error resume next keys = request("primarykey") names = request("table_name") values = request("primarykeyvalue") action = request("action") Set rs = Server.CreateObject("Adodb.RecordSet") if action = "" or action = "save" or action = "new" then sql = "select * from " & names & " where " & keys & " = " & values end if if action = "pre" then sql = "select top 1 * from " & names & " where " & keys & " < " & values & " order by " & keys & " desc" end if if action = "next" then sql = "select top 1 * from " & names & " where " & keys & " > " & values & " order by " & keys & " asc" end if if action = "add" then sql = "Select * From [" & names & "]" end if rs.Open sql, conn, 1, 3 if rs.eof and action = "new" then sql = "Select * From [" & names & "]" rs.Open sql, conn, 1, 3 end if if action = "save" or action = "new" then If action = "new" Then rs.AddNew For Each tab In rs.Fields If Keys <> tab.Name Then rs(tab.Name) = Request.Form(tab.Name & "_Column") if err <> 0 then echo tab.name & err.description echo "" response.end end if End If Next rs.update end if echo "字段数据编辑
" echo "

" echo "

" end sub '==================================================================显示存储过程 sub showproc() dim sTableName,adox on error resume next echo "存储过程：" & Request("table_name") & "
" sTableName = Request("table_name") Set adox = Server.CreateObject("ADOX.Catalog") adox.ActiveConnection = Conn echo "
" if err <> 0 then echo err.description exit sub end if end sub '==================================================================分页导航 '分页导航 sub showNavBar (rs,page,pageUrl,pageSize) page = cint(page) %> <% if request("primarykey") <> "" and request("table_name") <> "" then %> <% end if %>

当前表：<%=request("table_name")%> &primarykey=<%=request("primarykey")%>&action=add">插入新记录

<% echo "共有" & rs.recordCount & "条纪录当前" & page & "/" & rs.PageCount & "页" if page > 1 then echo "首页 " echo "上页 " end if if (rs.PageCount > 1 and page < rs.PageCount) then echo "下页 " echo "末页 " end if echo "转到:第" echo "页" %>

<% end sub '==================================================================显示查询 sub showselect(sql) dim page,pageUrl,strdel,geturl pageSize = request("pageSize") '设置每页显示的记录数 if pageSize = "" or not isNumeric(pageSize) then pageSize = 50 '判断是否删除 if request("keylog") <> "" then strdel = "delete from " & request("table_name") & " where " & request("primarykey") & "=" & request("keylog") response.Write strdel conn.execute(strdel) geturl = "?" & replace(request.QueryString,"&keylog="&request("keylog"),"") response.Redirect geturl end if page = request("page") '设置当前显示的页数 if page="" or not isNumeric(page) then page=1 pageUrl = "?key=sql&sql=" & sql if request("primarykey") <> "" and request("table_name") <> "" then pageUrl = pageUrl & "&table_name=" & request("table_name") & "&primarykey=" & request("primarykey") end if '-------------------------- dim rs set rs = Server.CreateObject("ADODB.Recordset") rs.Open sql,conn,3 if not rs.eof then rs.pageSize = pageSize if cint(page) < 1 then page = 1 if cint(page) > rs.PageCount then page = rs.PageCount rs.absolutePage = page end if '显示分页导航 showNavBar rs,page,pageUrl,pageSize '------------------------------- echo "

" echo "" primarykey = request("primarykey") if primarykey <> "" and request("table_name") <> "" then echo "" end if for i = 0 to rs.fields.count - 1 '循环字段名 set field = rs.fields.item(i) echo "" next echo "" dim i,field,j do while not rs.eof and j < rs.pageSize '循环数据 echo "" if primarykey <> "" and request("table_name") <> "" then echo "" echo "" end if for i = 0 to rs.fields.count - 1 set field = rs.fields.item(i) if len(field.value) < 12 then echo "" else echo "" end if next echo "" rs.MoveNext j = j + 1 loop 'response.ContentType ="application/vnd.ms-excel"'生成EXCEL表格 echo "

操作	删	" & field.name & "
编辑	×	" & field.value & "	" & field.value & "

" end sub sub exesql(sql) on error resume next '==================================================================执行sql函数 if trim(request.form("SchemaTable")) <> "" then Call showSchema (adSchemaTables) if trim (request.form("SchemaColumn")) <> "" then Call showSchema(adSchemaColumns) if trim (request.form("SchemaProvider")) <> "" then Call showSchema(adSchemaProviderTypes) sql = trim(request("sql")) if sql = "" then exit sub sql = RegExpReplace(sql, "(--)(.)*\n", "") '替换注释 sql = RegExpReplace(sql, "\n[\s| ]*\r", "") '替换空行 sql = RegExpReplace(sql, "\n", "") '替换换行符 sql = RegExpReplace(sql, "\r", "") '替换回车符 if (LCase(left(sql,len("select"))) = "select") and instr(sql,"into") = 0 then Call showSelect (sql) if err <> 0 then echo "
" & err.description & "" response.end else '如果非select语句,允许执行多条以分号分隔的语句 dim aSql,iLoop aSql = split(sql,";") for iLoop = 0 to UBound(aSql) if trim(aSql(iLoop)) <> "" then conn.execute (aSql(iLoop)) if err <> 0 then echo "
" & err.description & "
" echo iLoop + 1 & "、" & aSql(iLoop) & "
" 'err.clear() '忽略错误 exit sub '中止执行 else echo "

" & iLoop + 1 & "、" & aSql(iLoop) & "

" end if end if next echo "

命令执行成功

" end if end sub '显示数据库信息 'QueryType有以下三个主要参数 'adSchemaTables 'adSchemaColumns 'adSchemaProviderTypes 'Call showSchema (adSchemaTables) sub showSchema(QueryType) dim rs 'set rs = conn.OpenSchema() set rs = conn.OpenSchema (QueryType) 'set rs = conn.OpenSchema (adSchemaProviderTypes) echo "

" for i = 0 to rs.fields.count - 1 '循环字段名 set field = rs.fields.item(i) echo "" next echo "" dim i,field do while not rs.eof '循环数据 echo "" for i = 0 to rs.fields.count - 1 set field = rs.fields.item(i) echo "" next echo "" rs.MoveNext loop echo "

" & field.name & "

" & field.value & "

" end sub %> <% '==================================================================导出SQL sub tosql(strt) 'strt = 0 导出结构 'strt = 1 导出内容 dim strsql if strt = "0" then table = request("table_name") echo "以下是表 " & request("table_name") & " 的结构: " echo "" strsql = getsql(table) end if if strt = "2" then echo "以下是数据库的结构: " echo "" set objSchema = Conn.OpenSchema(adSchemaTables) Do While Not objSchema.EOF if objSchema("TABLE_TYPE") = "TABLE" then table = objSchema("TABLE_NAME") strsql = strsql & getsql(table)'table & "|"'getsql(table) end if objSchema.MoveNext Loop objSchema.close end if echo "" conn.close end sub '================================================================== 输出表结构 function getsql(table) on error resume next getsql = "-- 表结构 " & table & " 的SQL语句。" & chr(10) dim primary,primarykey Set primary = Conn.OpenSchema(adSchemaPrimaryKeys,Array(empty,empty,table)) if primary("COLUMN_NAME") <> "" then primarykey = primary("COLUMN_NAME") end if primary.Close set primary = nothing tbl_struct = "CREATE TABLE [" & table & "] ( " & chr(10) sql = "SELECT * FROM " & table Set rs = Conn.Execute(sql) if err = 0 then for i = 0 to rs.fields.count-1 tbl_struct = tbl_struct & "[" & rs(i).name & "] " typs = typ(rs(i).type) if typs = "VARCHAR" or typs = "BINARY" or typs = "CHAR" then tbl_struct = tbl_struct & typs & "(" & rs(i).definedsize & ")" else tbl_struct = tbl_struct & typs & " " end if attrib = rs(i).attributes if (attrib and adFldIsNullable) = 0 then tbl_struct = tbl_struct&" NOT NULL" end if if rs(i).Properties("ISAUTOINCREMENT") = True then tbl_struct = tbl_struct & " IDENTITY" end if tbl_struct = tbl_struct & "," & chr(10) next if primarykey <> "" then tbl_struct = tbl_struct & "PRIMARY KEY ([" & primarykey & "]));" else len_of_sql = Len(tbl_struct) tbl_struct = Mid(tbl_struct,1,len_of_sql-2) tbl_struct = tbl_struct & ");" end if else tbl_struct = "CREATE TABLE [" & table & "];" end if getsql = getsql & tbl_struct & chr(10) & chr(10) end function sub help() echo "SQL 常用语句：

" echo "创建表：
" echo "CREATE TABLE [表名] (
" echo "[test1] int not null identity,
" echo "[test2] binary not null,
" echo "primary key ([test1]))

" echo "设置主键：ALTER TABLE [tablename] ADD PRIMARY KEY ([fieldname])

" echo "查询：select * from tablename where fieldname *** order by id desc

" echo "更新：update tanlename set fieldname = values,cn_name='values' where ID = 1

" echo "添加：insert into tanlename (fieldnam,fieldnam2)values (1,'values')

" echo "删除：delete from tanlename where fieldname = values

" echo "删除表：DROP TABLE 数据表名称

" echo "添加字段：ALTER TABLE [表名] ADD [字段名] NVARCHAR (50) NULL

" echo "删除字段：alter table [tablename] drop [fieldname]

" echo "修改字段：ALTER TABLE [表名] ALTER COLUMN [字段名] 类型(大小) NULL

" echo "新建约束：ALTER TABLE [表名] ADD CONSTRAINT 约束名 CHECK ([约束字段] <= '2000-1-1')

" echo "删除约束：ALTER TABLE [表名] DROP CONSTRAINT 约束名

" echo "新建默认值：ALTER TABLE [表名] ADD CONSTRAINT 默认值名 DEFAULT '51WINDOWS.NET' FOR [字段名]

" echo "删除默认值：ALTER TABLE [表名] DROP CONSTRAINT 默认值名

" end sub %>

表：主界面退出 Help
<% set objSchema = Conn.OpenSchema(adSchemaTables) Do While Not objSchema.EOF if objSchema("TABLE_TYPE") = "TABLE" then '输出表名 echo "" & objSchema("TABLE_NAME") & "
" end if objSchema.MoveNext Loop echo "所有视图：
" objSchema.MoveFirst Do While Not objSchema.EOF if objSchema("TABLE_TYPE") = "VIEW" then '输出表名 echo "" & objSchema("TABLE_NAME") & "
" end if objSchema.MoveNext Loop objSchema.Close set objSchema = nothing 'echo "存储过程：
" 'set objSchema = Conn.OpenSchema(adSchemaProcedures) 'Do While Not objSchema.EOF ' echo "" & objSchema("PROCEDURE_NAME") & "
" 'objSchema.MoveNext 'Loop 'objSchema.Close 'set objSchema = nothing %>

<% select case request("key") case "" '显示主界面 call main("") case "addtable" '显示创建表界面 call add_table(request("table_name"),request("field_num")) case "createtable" '执行创建表 call create_table() case "view" call view(request("table_name")) case "sql" call main("1") call exesql(trim(request("sql"))) case "addfield" call addfield() case "editfidlevi" call view(request("table_name")) case "editfidle" call editfidle() case "exit" session("dbtype") = "" session("dbstr") = "" session("db007pass") = "" response.redirect "?" case "tosql" call tosql(request("strt")) case "proc" call main("1") call showproc() case "help" call help() case "edit" call EditData() case "reobj" call reobj() end select %>

字段名	类型	大小	空值	自动编号	主键
	<% fieldtypelist(0) %>
>