⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 数据sql执行器代码(access专用).asp

📁 较为详细的介绍了asp自定义的各种函数,方便asp的各种开发.
💻 ASP
字号:
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style>
<!--
FormItem { font-family: Tahoma, Arial, Helvetica; font-size: 8pt; color: #000000 }
TextArea { font-family: Arial, Helvetica; font-size: 10pt; color: #000000 } 

-->
</style>
</head>
<script language="javascript">

function confirmSQL(msg){
var SQL=document.sqlform.sql.value;
if ((SQL!="") & (SQL.toUpperCase().indexOf('SELECT')<0)){
if(confirm(msg))
document.sqlform.submit();
}
else 
document.sqlform.submit();
}
function showSQL(x) { 
sqlvalue = document.sqlform.sql.value; 

if (x == 0) { 
smsg = "\nSQL语法帮助:\n\n"; 
smsg = smsg + "1. 选取你想用的SQL语句并单击.\n"; 
smsg = smsg + "2. 修改SQL语句.\n"; 
alert(smsg); } 

else if (x == 1) { 
smsg = "SELECT 字段名, 字段名\n"; 
smsg = smsg + " FROM 表名\n"; 
smsg = smsg + " WHERE 字段名 = '值'\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 2) { 
smsg = "INSERT INTO 表名\n"; 
smsg = smsg + " (字段名, IntegerColumnName)\n"; 
smsg = smsg + " VALUES ('值', numericValue)\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 3) { 
smsg = "UPDATE tableName\n"; 
smsg = smsg + " SET 字段名 = 'value'\n"; 
smsg = smsg + " WHERE 字段 = '值'\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 4) { 
smsg = "DELETE 字段\n"; 
smsg = smsg + " FROM 表名\n"; 
smsg = smsg + " WHERE 字段名 = '值'\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 5) { 
smsg = "CREATE TABLE 表名\n"; 
smsg = smsg + " (字段名 varchar(20),\n"; 
smsg = smsg + " 字段名 char(20),\n"; 
smsg = smsg + " 字段名 integer)\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 6) { 
smsg = "DROP TABLE 表名\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
} 

else if (x == 7) { 
smsg = "SELECT a.字段名, b.字段名\n"; 
smsg = smsg + " FROM 表名 a, 表名 b\n"; 
smsg = smsg + " WHERE a.字段名 = b.字段名\n\n"; 
if (sqlvalue == "") { document.sqlform.sql.value = smsg; } 
else { 
document.sqlform.sql.value = document.sqlform.sql.value + smsg; } 
}

else if (x == 8) { 
document.sqlform.sql.value = "";
}

 

} 
</script>
<%
Set fso=Server.CreateObject("Scripting.FileSystemObject")
'########################
Function RelativePath(sPath)
'########################
RelativePath=sPath
'If Session("UseRootfolders") AND NOT Session("AllowMapDrives") Then If RelativePath="" Then RelativePath="\" Else RelativePath=Session("CurRFNum") & "|" & Replace(sPath,Session("RFPath")(Session("CurRFNum")),"",1,-1,1)
End Function


 

ItemsPerPage=20
' On Error resume next

a=Request("a")
If Request("TruncateAt")<>"" Then Session("TruncateAt")=CINT(Request("TruncateAt"))
If Session("TruncateAt")="" Then Session("TruncateAt")=25
f=Request("f")
If f="" then
locaMDB
End If
If a="showmdb" Then
showmdb f
Else
Response.Write "错误的参数: " & a
End If

'######################
SUB LocaMDB
'######################
Response.Write "<center><table border='1' cellpadding=6 cellspacing='0' bordercolor='#444444'>"
Response.Write "<tr><td align='center' bgcolor='000080'><font color=FFFFFF>"
Response.Write "<b>数据库定位</b></td></tr><tr><td bgcolor='#EEEEEE'>"
Response.Write "<Form name=loca>"
Response.Write "<input type=hidden name=a value=showmdb>"
Response.Write "<b>数据库的位置:<input type=file name=""f""><input type=submit value=""定位""><br><br>"
Response.Write "</Form></center>"
Response.End
END SUB
'########################
SUB ShowMDB(f)
'########################
On Error resume next
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & f
Set Conn= Server.CreateObject("ADODB.Connection")
Conn.Open ConnStr
If err<>0 Then ShowError("数据库打开错误!")
TableList="<Option selected value=''> 以下为可以编辑的表</option>"
Set RS = Conn.OpenSchema(20)
Do Until RS.EOF
If RS.Fields("TABLE_TYPE")= "TABLE" then
If NumTables=0 Then FirstTable=RS.Fields("TABLE_NAME")
NumTables=NumTables+1
TableList=TableList & "<Option>" & RS.Fields("TABLE_NAME") & "</option>"
End If
RS.MoveNext
Loop
RS.Close
Set RS=Nothing
Conn.close
Set Conn=Nothing
SQL=Trim(Request("SQL"))
%>

<%
Response.Write "<center><table border='1' cellpadding=6 cellspacing='0' bordercolor='#444444'>"
Response.Write "<tr><td align='center' bgcolor='000080'><font color=FFFFFF>"
Response.Write "<b>正在编辑数据库 " & fso.getfilename(f) & "</b></td></tr><tr><td bgcolor='#EEEEEE'>"
Response.Write "<Form name=sqlform>"
Response.Write "<b>" & "可用的表" & " (" & NumTables & "个)</b><br><Select Class=FormItem name=table onChange='this.form.submit()'>" & TableList & "</select>"&_
"<select Class=FormItem name=sqlhelp onclick=""showSQL(document.sqlform.sqlhelp.selectedIndex)"">"&_ 
"<option SELECTED>SQL帮助</option>"&_ 
"<option>查询</option> "&_ 
"<option>插入</option> "&_ 
"<option>更新</option> "&_ 
"<option>删除</option> "&_ 
"<option>建表</option> "&_ 
"<option>删表</option> "&_ 
"<option>关联查询</option> "&_ 
"<option>清空语句</option> "&_ 
"</select> "&_
"<br><br>"
table=request("Table")
If Table<>"" Then
Showtable=Table
FieldList=GetTableFieldList(f, table)
Response.Write " <b>" & "表中的字段" & " 在表" & table & "中 ("& UBound(Split(FieldList,"<Option")) & "个)</b><br><Select Class=FormItem>" & FieldList & "</select>"&_

"<br><br>"
Else
Showtable=FirstTable
End If

If SQL="" Then tSQL="Select * FROM " & ShowTable Else tSQL=SQL
Response.Write " <b>" & "运行SQL查询" & "</b><br>"&_
"<font size=2 color='ff0000'>" &"警告: 执行后将不能复原,请确认SQL查询语句可*!" & "</font><br>"&_
"<textarea name=sql Class=FormItem rows=8 cols=65>" & tSQL & "</textarea> "&_
"<input type=button Class=FormItem value='" & "执行" & "' onclick='javascript:confirmSQL(""执行该查询将修改数据库结构或记录!\n你确定要继续吗?\n"")'><br>"&_
"<font size=1 face=arial>" & "最大返回长度(chars)" & " <input type=input Class=FormItem name=TruncateAt size=4 value="&Session("TruncateAt")&"></font><br>"&_
"</table>"&_
"<input type=hidden name=f value='" & RelativePath(f) & "'>"&_
"<input type=hidden name=a value=showmdb>"&_
"</Form></center>"
If SQL<>"" AND Table="" Then DoSQL f,sql
End SUB
'########################
SUB DoSQL(f,sql)
'########################
If Application("Debugging")=False Then On Error resume next
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & f
Set Conn= Server.CreateObject("ADODB.Connection")
Conn.Open ConnStr
'######## SELECT
fe=server.urlencode(RelativePath(f))
If Instr(1,SQL,"SELECT",1)=1 Then
Set RS = Server.CreateObject("ADODB.Recordset")
Page=Cint(request("p"))
If page<1 Then page=1
RS.Open SQL, Conn, 3,3
RS.PageSize=ItemsPerPage
TotalPages=RS.PageCount
TotalItems=RS.recordCount
Response.Write "<b>" & "执行结果" & ": </b><font size=2>找到" & TotalItems & "个记录</font><br>"
If NOT RS.EOF Then
RS.AbsolutePage = Page
Response.Write "<Table cellspacing=1 cellpadding=1><tr>"
Response.Write "<td bgcolor=000080><font color=FFFFFF><b></b></td>"
For i = 0 to RS.Fields.Count-1
Response.Write "<td NoWrap bgcolor=000080 align=center><font color=FFFFFF><b>" & RS.Fields(i).name & "</b></td>"
Next
Response.Write "</tr>"
While n<RS.pageSize AND NOT RS.EOF
n=n+1
Response.Write "<tr>"
Response.Write "<td NoWrap bgcolor=EEEEEE> <b>&nbsp;" & (page-1)*RS.pageSize + n & "&nbsp;</b></td>"
For i= 0 to RS.Fields.Count-1
sVal=LeftTrue(RS.Fields(i),Session("TruncateAt")) 
Response.Write "<td NoWrap bgcolor=EEEEEE> &nbsp;"
Response.Write HTMLEncode(sVal)
Response.Write "&nbsp;</td>"
Next
RS.MoveNext
Response.Write "</tr>"
Wend
Response.Write "</table><br>"
eSQL=Server.URLEncode(SQL)
If Page>2 Then Response.Write "<a href=mdb.asp?a=showmdb&sql=" & eSQL& "&f=" & fe & "&p=1><font face='Webdings'>9</font></a>&nbsp;"
If Page>1 Then Response.Write "<a href=mdb.asp?a=showmdb&sql=" & eSQL & "&f=" & fe & "&p=" & page-1 & "><font face='Webdings'>7</font></a>&nbsp;"
If Totalpages>1 Then Response.Write "<font size=2 color='ff0000'>" & page & "/" & Totalpages & "</font>"
If Page<Totalpages Then Response.Write "<a href=mdb.asp?a=showmdb&sql=" & eSQL & "&f=" & fe & "&p=" & page+1 & "><font face='Webdings'>8</font></a>&nbsp;"
If Page+1<Totalpages Then Response.Write "<a href=mdb.asp?a=showmdb&sql=" & eSQL & "&f=" & fe & "&p=" & TotalPages & "><font face='Webdings'>:</font></a>&nbsp;"
End If
RS.Close
Set RS=Nothing
Else '######## Other query types
Conn.Execute(sql)
if Err <> 0 then
ShowError "SQL查询出错"& ": " & SQL 
else
Response.redirect("mdb.asp?a=showmdb" & "&f=" & fe)
end if
End If
Conn.close
Set Conn=Nothing
End SUB

'########################
Function GetTableFieldList(f,table)
'########################
On Error resume next
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & f
Set Conn= Server.CreateObject("ADODB.Connection")
Conn.Open ConnStr
Set RS = Conn.OpenSchema(4)
Do Until RS.EOF
If RS.Fields("TABLE_NAME")=Table Then
n=n+1
Select Case RS.Fields("DATA_TYPE")
Case 2 : DataType=("SmallInt")
Case 3 : DataType=("Long Integer")
Case 4 : DataType=("Single")
Case 5 : DataType=("Double")
Case 6 : DataType=("Currency")
Case 7 : DataType=("Date")
Case 11 : DataType=("Boolean")
Case 12 : DataType=("Variant")
Case 13 : DataType=("IUnknown")
Case 129 : DataType=("Char")
Case 130 : DataType=("WChar")
Case 131 : DataType=("Numeric")
Case 132 : DataType=("UserDefined")
Case 133 : DataType=("DBDate")
Case 134 : DataType=("DBTime")
Case 135 : DataType=("DBTimeStamp")
Case 200 : DataType=("VarChar")
Case 201 : DataType=("LongVarChar")
Case 202 : DataType=("VarWChar")
Case 204 : DataType=("VarBinary")
Case 205 : DataType=("LongVarBinary")
Case Else: DataType=("Unknown")
End Select
s=s & "<Option value='" & RS.Fields("COLUMN_NAME") & "'>" & RS.Fields("COLUMN_NAME") & " ("& DataType & ")</option>"
End If
RS.MoveNext
Loop
RS.Close
Set RS=Nothing
Conn.close
Set Conn=Nothing
GetTableFieldList=s
End Function

Function LeftTrue(str,n) 
If len(str)<=n/2 Then 
LeftTrue=str 
Else 
Dim TStr 
Dim l,t,c 
Dim i 
l=len(str) 
t=l 
TStr="" 
t=0 
for i=1 to l 
c=asc(mid(str,i,1)) 
If c<0 then c=c+65536 
If c>255 then 
t=t+2 
Else 
t=t+1 
End If 
If t>n Then exit for 
TStr=TStr&(mid(str,i,1)) 
next 
LeftTrue = TStr 
End If 
End Function 

function HTMLEncode(fString)

fString = replace(fString, ">", "&gt;")
fString = replace(fString, "<", "&lt;")

fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, CHR(10), "<BR>")
fString = Replace(fString, " ", "&nbsp;&nbsp;")
HTMLEncode = fString
end function

%>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -