[code]<!--#include file="const.asp" -->
<%
"============================================================================================================================
"函数列表：
"1： 建立数据库的连接 ConnOpen(DataBaseConnectStr,DBType,Conn_object)
"2： 断开数据库的连接 ConnClose(Conn_object)
"3： 防止SQL注入 SafeRequest(paraName,paraType)
"4： 格式化日期 DateFormat(dateStr,dateType)
"5： 显示错误提示 ShowErr(errStr)
"6： 查询字符串中特定数据 SelectStr(contentStr,patternStr,patternNum)
"7： 过滤指定字符 Leach(contentStr,badWords)
"8： 远程文件内容抓取 Seize(urlStr)
"9： 数据流编码处理 BytesToBstr(body,cset)
"10： 编码cookies codeCookie(contentStr)
"11： 解码cookies DecodeCookie(contentStr)
"12： 检验数据提交来源是否合法 ChkPost()
"13： 个性化加密 MyEncrypt(StrPassword)
"14： 禁止浏览器缓存本页 NoBuffer()
"15： 网页格式化输入文本 HTMLEncode(fString)
"16： 从头部截取字符串的指定长度(按字符数算) GotTopic(Str,StrLen)
"17： 检测验证码 CheckRadomPass(RadomPass)
"18： 生成验证码 GetCode()
"19： 获取客户端操作系统版本 GetSystem()
"20： 数据库事务处理 ConnManage(Conn_object)
"21： 快速排序（递归） QuickSort(arr,Low,High)
"22： 将数组的元素以特定字符串连起来 arr_join(arr,character)
"23： 返回字符串以某分割符分割的数目 count_character(str,character)
"24： 截取含有分割符的字符串中指定数目的字符串 inter_str_by_character_num(str,character,start,num)
"25： 利用Stream下载文件 downloadFile(strFile)
"26： 返回信息 send_back(ResultWords)
"27： 获取错误信息 get_err()
"28： 与SafeRequest相反 SafeResponse(content)
"29： 保存远程图片 SaveRemoteFile(LocalFileName,RemoteFileUrl)
"30： ...
dim language_arr(10)
language_arr(0) = "数据库连接的参数设置错误！"
language_arr(1) = "数据库连接的类型参数设置错误！"
language_arr(2) = "数据库连接失败！"
language_arr(3) = "非法的参数值！"
language_arr(4) = "参数值不是有效的日期格式！"
language_arr(5) = "操作失败！"
language_arr(6) = "栏目有重名！"
language_arr(7) = "栏目名称为空！"
language_arr(8) = "栏目文件夹创建失败！"
language_arr(9) = "您没有此权限！"
"============================================================================================================================
"函数ID：1
"函数作用：建立数据库的连接
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-15 10：28
"修改时间：
"传人参数：
" connectStr：数据库连接字符串
" connectType：数据库类别-数字型，0为Access,1为MS SQL
"返回值：
"============================================================================================================================
sub ConnOpen(DataBaseConnectStr,DBType,Conn_object)
Set Conn_object = Server.Createobject("adodb.connection")
if DataBaseConnectStr = "" then call ShowErr(language_arr(0))
if DBType = 0 then
Conn_object.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DataBaseConnectStr
elseif DBType = 1 then
Conn_object.Open "Provider=SQLOLEDB.1;" & DataBaseConnectStr
else
call ShowErr(language_arr(1))
end if
err.clear
end sub
"============================================================================================================================
"函数ID：2
"函数作用：断开数据库的连接
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 15:10
"修改时间：
"传人参数：
"返回值：
"============================================================================================================================
Sub ConnClose(Conn_object)
Conn_object.close
set Conn_object = nothing
End sub
"============================================================================================================================
"函数ID：3
"函数作用：防止SQL注入
"作者名称：http://news.dvbbs.net/info...
"建立时间：2006-2-16 15:32
"修改时间：
"传人参数：
" paraName:参数名称-字符型
" paraType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
"返回值：
" 过滤后的字符串
"============================================================================================================================
Function SafeRequest(paraName,paraType)
dim paraValue
paraValue = Request(paraName)
select case paraType
case 0
paraValue = replace(paraValue,""","[system:34]")
paraValue = replace(paraValue,"=","[system:61]")
case 1
if not IsNumeric(paraValue) then call ShowErr(language_arr(3))
case -1
if not IsNumeric(paraValue) then call ShowErr(language_arr(3))
if paraValue = "" then paraValue = 0
case else
if len(paraValue) > paraType then call ShowErr(language_arr(3))
paraValue = replace(paraValue,""","[system:34]")
paraValue = replace(paraValue,"=","[system:61]")
end select
SafeRequest = paraValue
End function
"============================================================================================================================
"函数ID：4
"函数作用：格式化日期
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 15:45
"修改时间：
"传人参数：
" dateStr:日期字符串
" paraType:日期类型-数字型
"返回值：
" 格式化后的日期
"============================================================================================================================
Function DateFormat(dateStr,dateType)
Dim dateString
if IsDate(dateStr) = False then
call ShowErr(language_arr(4))
end if
Select Case dateType
Case "1"
dateString = Year(dateStr)&"-"&Month(dateStr)&"-"&Day(dateStr)
Case "2"
dateString = Year(dateStr)&"."&Month(dateStr)&"."&Day(dateStr)
Case "3"
dateString = Year(dateStr)&"/"&Month(dateStr)&"/"&Day(dateStr)
Case "4"
dateString = Month(dateStr)&"/"&Day(dateStr)&"/"&Year(dateStr)
Case "5"
dateString = Day(dateStr)&"/"&Month(dateStr)&"/"&Year(dateStr)
Case "6"
dateString = Month(dateStr)&"-"&Day(dateStr)&"-"&Year(dateStr)
Case "7"
dateString = Month(dateStr)&"."&Day(dateStr)&"."&Year(dateStr)
Case "8"
dateString = Month(dateStr)&"-"&Day(dateStr)
Case "9"
dateString = Month(dateStr)&"/"&Day(dateStr)
Case "10"
dateString = Month(dateStr)&"."&Day(dateStr)
Case "11"
dateString = Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7)
Case "12"
dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8)
case "13"
dateString = Day(dateStr)&language_arr(7)&Hour(dateStr)&language_arr(8)
Case "14"
dateString = Hour(dateStr)&language_arr(8)&Minute(dateStr)&language_arr(9)
Case "15"
dateString = Hour(dateStr)&":"&Minute(dateStr)
Case "16"
dateString = Year(dateStr)&language_arr(5)&Month(dateStr)&language_arr(6)&Day(dateStr)&language_arr(7)
Case Else
dateString = dateStr
End Select
DateFormat = dateString
End Function
"============================================================================================================================
"函数ID：5
"函数作用：显示错误提示
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:29
"修改时间：
"传人参数：
" errStr:错误提示-字符型
"返回值：返回提交页面
"============================================================================================================================
sub ShowErr(errStr)
Response.Write("<script>alert("""&errStr&""");location.href=""javascript:history.back()"";</script>")
Response.End
End sub
"============================================================================================================================
"函数ID：6
"函数作用：查询字符串中特定数据
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:40
"修改时间：
"传人参数：
" contentStr:查询字符串
" patternStr:匹配式字符串
" patternNum:查询定位-数字型
"返回值：
" 找不到返回false
" patternNum为-1返回所有匹配字符串并以[10]隔开
" 否则返回指定位置的字符串
"============================================================================================================================
Function SelectStr(contentStr,patternStr,patternNum)
dim objRegExp,matches,matche
if contentStr = "" then
call ShowErr(language_arr(12))
end if
Set objRegExp=new RegExp "建立正则表达式
objRegExp.pattern = patternStr "设置模式
objRegExp.IgnoreCase =False "设置是否区分字符大小写
objRegExp.Global=true "设置全局可用性
objRegExp.pattern = patternStr "匹配式
if objRegExp.test(contentStr) = false then "全局匹配
SelectStr = false
else
Set matches = objRegExp.Execute(contentStr) "执行搜索
if patternNum = -1 then
for each matche in matches
SelectStr = SelectStr &"[10]"& matche.value
next
else
SelectStr = matches.Item(patternNum).value
end if
end if
Set objRegExp=Nothing
End Function
"============================================================================================================================
"函数ID：7
"函数作用：过滤指定字符
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:59
"修改时间：
"传人参数：
" contentStr:源字符串
" badWords:要过滤的字符串，若数目大于1则用英文状态的"^"隔开
"返回值：
" 返回过滤后的字符串
"============================================================================================================================
Function Leach(contentStr,badWords)
dim badWordsArr,i
badWordsArr = Split(badWords,"^")
for i = 0 to UBound(badWordsArr)
contentStr = replace(contentStr,badWordsArr(i),"")
next
leach = contentStr
end Function
"============================================================================================================================
"函数ID：8
"函数作用：远程文件内容抓取
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 17:24
"修改时间：
"传人参数：
" urlStr:远程文件地址
"返回值：
" 返回远程文件内容
"============================================================================================================================
function Seize(urlStr)
dim connect
if urlStr = "" then
call ShowErr(language_arr(13))
else
Set connect = CreateObject("Microsoft.XMLHTTP") "建立XMLHTTP对象
connect.open "GET",urlStr,false "设置参数，通信方式为get，请求为同步，后面还有两个可选属性：userID，password用于用户验证
connect.send() "数据发送，Send方法的参数类型可以是字符串、DOM树或任意数据流
Seize = BytesToBStr(connect.responseBody,"GB2312") "返回信息，编码为中文
set connect = nothing
end if
end function
"============================================================================================================================
"函数ID：9
"函数作用：数据流编码处理
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 17:30
"修改时间：
"传人参数：
" body:数据内容
" cset:编码格式
"返回值：
" 编码处理后的信息
"============================================================================================================================
Function BytesToBstr(body,cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1 "以二进制模式打开
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
"============================================================================================================================
"函数ID：10
"函数作用：编码cookies
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 17:36
"修改时间：
"传人参数：
" contentStr:数据内容
"返回值：
" 编码处理后的信息，字符以"a"隔开
"============================================================================================================================
Function codeCookie(contentStr)
Dim i,returnStr
For i = Len(contentStr) to 1 Step -1
returnStr = returnStr & Ascw(Mid(contentStr,i,1))
If (i <> 1) Then returnStr = returnStr & "a"
Next
CodeCookie = returnStr
End Function
"============================================================================================================================
"函数ID：11
"函数作用：解码cookies
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-17 16:58
"修改时间：
"传人参数：
" contentStr:数据内容
"返回值：
" 解码处理后的信息
"============================================================================================================================
Function DecodeCookie(contentStr)
Dim i
Dim StrArr,StrRtn
StrArr = Split(contentStr,"a")
For i = 0 to UBound(StrArr)
If isNumeric(StrArr(i)) = True Then
StrRtn = Chrw(StrArr(i)) & StrRtn
Else
StrRtn = contentStr
Exit Function
End If
Next
DecodeCookie = StrRtn
End Function
"============================================================================================================================
"函数ID：12
"函数作用：检验数据提交来源是否合法
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-18 18:55
"修改时间：
"传人参数：
"
"返回值：
" Boolean
"============================================================================================================================
Function ChkPost()
Dim server_v1,server_v2
Chkpost=False
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True
End Function
"============================================================================================================================
"函数ID：13
"函数作用：个性化加密
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-25 15:12
"修改时间：
"传人参数：
" StrPassword：需加密的数据
"返回值：
" 加密后的数据
"============================================================================================================================
Function MyEncrypt(StrPassword)
Dim StrLen,StrLeft,StrRight,n
n = 8
StrPassword = MD5(StrPassword)
StrLen = len(StrPassword)
StrLeft = left(StrPassword,n)
StrRight = right(StrPassword,StrLen-n)
MyEncrypt = StrRight&StrLeft
End function
"============================================================================================================================
"函数ID：14
"函数作用：禁止浏览器缓存本页
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 2:45
"修改时间：
"传人参数：
"返回值：
"============================================================================================================================
Sub NoBuffer()
Response.expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma","no-cache"
Response.addHeader "cache-control","private"
Response.CacheControl = "no-cache"
end sub
"============================================================================================================================
"函数ID：15
"函数作用：网页格式化输入文本
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 2:50
"修改时间：
"传人参数：
" fString：源字符串
"返回值：格式化后的字符串
"============================================================================================================================
function HTMLEncode(fString)
if not isnull(fString) then
fString = replace(fString, ">", "&gt;")
fString = replace(fString, "<", "&lt;")
fString = Replace(fString, CHR(32)&CHR(32), "&nbsp;&nbsp;")
fString = Replace(fString, CHR(9), "&nbsp;")
fString = Replace(fString, CHR(34), "&quot;")
fString = Replace(fString, CHR(39), "&#39;")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, CHR(10), "<BR>")
HTMLEncode = fString
end if
end function
"============================================================================================================================
"函数ID：16
"函数作用：从头部截取字符串的指定长度(按字符数算)
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 3:04
"修改时间：
"传人参数：
" Str：源字符串
" StrLen：长度
"返回值：截取得到的字符串
"============================================================================================================================
Function GotTopic(Str,StrLen)
Dim l,t,c, i,LableStr,regEx,Match,Matches,focus,last_str
if IsNull(Str) then
GotTopic = ""
Exit Function
end if
if Str = "" then
GotTopic=""
Exit Function
end if
Set regEx = New RegExp
regEx.Pattern = "\[[^\[\]]*\]"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(Str)
For Each Match in Matches
LableStr = LableStr & Match.Value
Next
Str = regEx.Replace(Str,"")
Str=Replace(Replace(Replace(Replace(Str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<")
l=len(str)
t=0
strlen=Clng(strLen)
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t = strLen-2 then
focus = i
last_str = ".."
end if
if t = strLen-1 then
focus = i
last_str = "."
end if
if t>=strlen then
GotTopic=left(str,focus)&last_str
exit for
else
GotTopic=str
end if
next
GotTopic = Replace(Replace(Replace(Replace(GotTopic," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;") & LableStr
end function
"============================================================================================================================
"函数ID：17
"函数作用：检测验证码
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 3:09
"修改时间：
"传人参数：
" RadomPass：输入的验证码
"返回值：
"============================================================================================================================
Sub CheckRadomPass(RadomPass)
if radompass = "" then
call ShowErr(language_arr(14))
elseif Session("GetCode") = "9999" then
Session("GetCode")=""
elseif Session("GetCode") = "" then
call ShowErr(language_arr(15))
elseif cstr(Session("GetCode"))<>radompass then
call ShowErr(language_arr(16))
end if
Session("GetCode")=""
End sub
"============================================================================================================================
"函数ID：18
"函数作用：生成验证码
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 3:16
"修改时间：
"传人参数：
"返回值：
"============================================================================================================================
Function GetCode()
Dim TestObj
On Error Resume Next
Set TestObj = Server.CreateObject("Adodb.Stream")
Set TestObj = Nothing
If Err Then
Dim TempNum
Randomize timer
TempNum = cint(8999*Rnd+1000)
Session("GetCode") = TempNum
GetCode = Session("GetCode")
Else
GetCode = "<img src="""&Site_Url&"inc/GetCode.asp"">"
End If
End Function
"============================================================================================================================
"函数ID：19
"函数作用：获取客户端操作系统版本
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 3:21
"修改时间：
"传人参数：
"返回值：操作系统版本名称
"============================================================================================================================
Function GetSystem()
dim System
System = Request.ServerVariables("HTTP_USER_AGENT")
if Instr(System,"Windows NT 5.2") then
System = "Win2003"
elseif Instr(System,"Windows NT 5.0") then
System="Win2000"
elseif Instr(System,"Windows NT 5.1") then
System = "WinXP"
elseif Instr(System,"Windows NT") then
System = "WinNT"
elseif Instr(System,"Windows 9") then
System = "Win9x"
elseif Instr(System,"unix") or instr(System,"linux") or instr(System,"SunOS") or instr(System,"BSD") then
System = "Unix"
elseif Instr(System,"Mac") then
System = "Mac"
else
System = "Other"
end if
GetSystem = System
End Function
"============================================================================================================================
"函数ID：20
"函数作用：数据库事务处理
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-3-5 3:25
"修改时间：
"传人参数：
"返回值：true or false
"============================================================================================================================
function ConnManage(Conn_object)
if Conn_object.Errors.count<>0 then
Conn_object.rollbacktrans
err.clear
ConnManage = false
else
Conn_object.committrans
ConnManage = true
end if
end function
"============================================================================================================================
"函数ID：21
"函数作用：快速排序（递归）
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-4-9 19:53
"修改时间：
"传人参数：
" arr:需排序的数组
" Low:数组最小下标
" High:数组最大下标
"返回值：
"============================================================================================================================
Sub QuickSort(arr,Low,High)
Dim i,j,x,y,k
i=Low
j=High
x=arr(Cint((Low+High)/2))
Do
While (arr(i)-x<0 and i<High)
i=i+1
Wend
While (x-arr(j)<0 and j>Low)
j=j-1
Wend
If i<=j Then
y=arr(i)
arr(i)=arr(j)
arr(j)=y
i=i+1
j=j-1
End if
Loop while i<=j
If Low<j Then call QuickSort(arr,Low,j)
If i<High Then call QuickSort(arr,i,High)
End sub
"============================================================================================================================
"函数ID：22
"函数作用：将数组的元素以特定字符串连起来
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-4-9 21:16
"修改时间：
"传人参数：
" arr:需串连的数组
" character:串连字符
"返回值：
" 串连后的字符串
"============================================================================================================================
function arr_join(arr,character)
dim i
for i = 0 to ubound(arr)
if i = 0 then
arr_join = arr(i)
else
arr_join = arr_join & character & arr(i)
end if
next
end function
"============================================================================================================================
"函数ID：23
"函数作用：返回字符串以某分割符分割的数目
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:29
"修改时间：
"传人参数：
" errStr:错误提示-字符型
"返回值：返回提交页面
"============================================================================================================================
function count_character(str,character)
dim i
i = 0
Do Until InStr(str,character) = 0
str = Mid(str, InStr(str,character) + 1)
i = i + 1
Loop
count_character = i
End function
"============================================================================================================================
"函数ID：24
"函数作用：截取含有分割符的字符串中指定数目的字符串
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:29
"修改时间：
"传人参数：
" errStr:错误提示-字符型
"返回值：返回提交页面
"============================================================================================================================
function inter_str_by_character_num(str,character,start,num)
dim i,str_temp,start_location,inter_length,str_length
i = 0
inter_length = 0
str_length = len(str)
str = right(left(str,str_length-1),str_length-2)
str_length = str_length - 2
str_temp = str
Do Until InStr(str_temp,character) = 0
i = i + 1
str_temp = Mid(str_temp,InStr(str_temp,character) + 1)
if i = start - 1 then start_location = str_length - len(str_temp)
if i = start + num - 1 then
inter_length = str_length - len(str_temp) - start_location
exit do
end if
Loop
if inter_length = 0 then
inter_str_by_character_num = mid(str,start_location+1)
else
inter_str_by_character_num = mid(str,start_location+1,inter_length-1)
end if
End function
"============================================================================================================================
"函数ID：25
"函数作用：利用Stream下载文件
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 16:29
"修改时间：
"传人参数：
" errStr:错误提示-字符型
"返回值：返回提交页面
"============================================================================================================================
function downloadFile(strFile)
dim strFilename,s,fso,f,intFilelength
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFile) then
Response.Write("<h1>Error:</h1>该文件不存在<p>")
Response.End
end if
Set f = fso.GetFile(strFile)
intFilelength = f.size
s.LoadFromFile(strFile)
if err then
Response.Write("<h1>Error:</h1>文件下载错误<p>")
Response.End
end if
Response.AddHeader "Content-Disposition","attachment;filename=" & f.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
set f = nothing
set fso = nothing
Set s = Nothing
end function
"============================================================================================================================
"函数ID：26
"函数作用：返回信息
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-21 20：45
"修改时间：
"传人参数：
"返回值：
"============================================================================================================================
sub send_back(ResultWords)
dim objResult
Set objResult = Server.CreateObject("MSXML2.DOMDocument")
objResult.loadXML ("<返回结果></返回结果>")
objResult.selectSingleNode("返回结果").text = ResultWords
Response.ContentType = "text/xml"
objResult.save (Response)
Response.End
Set objResult = Nothing
end sub
"============================================================================================================================
"函数ID：27
"函数作用：获取错误信息
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-4-22 13：13
"修改时间：
"传人参数：
"返回值：
"============================================================================================================================
function get_err()
if Err.Number > 0 then
get_err = Err.Description
else
get_err = "T"
end if
end function
"============================================================================================================================
"函数ID：28
"函数作用：与SafeRequest相反
"作者名称：茫仔 xiamangmang@gmail.com 博客：blog.mzoe.com
"建立时间：2006-2-16 15:32
"修改时间：
"传人参数：
" paraName:参数名称-字符型
" paraType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
"返回值：
" 过滤后的字符串
"============================================================================================================================
function SafeResponse(content)
dim paraValue
paraValue = content
paraValue = replace(paraValue,"[system:34]",""")
paraValue = replace(paraValue,"[system:61]","=")
SafeResponse = paraValue
end function
"============================================================================================================================
"函数ID：29
"函数作用：保存远程图片
"作者名称：http://news.dvbbs.net/info...
"建立时间：2006-2-16 15:32
"修改时间：
"传人参数：
" LocalFileName:本地文件名
" RemoteFileUrl:远程文件URL
"返回值：
"============================================================================================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile LocalFileName,2
.Cancel()
.Close()
End With
Set Ads=nothing
end sub
%>[/code]
浏览模式: 标准 | 列表分类:网站|ASP备忘
ASP的一些自定功能函数
Submitted by on 2006, September 16, 1:55 PM
一些小偷，采集程序常用函数
Submitted by on 2006, September 5, 1:14 AM
//连接数据库
function connOpen(DataBaseConnectStr){
var conn = Server.CreateObject("ADODB.Connection");
conn.Open(DataBaseConnectStr);
return conn;
}
//利用AdoDb.Stream对象来读取指定格式的文本文件
function readFromTextFile(FileUrl,CharSet){
var str;
var stm = Server.CreateObject("adodb.stream");
stm.Type = 2;
stm.Mode = 3;
stm.Charset=CharSet;
stm.open;
stm.LoadFromFile(Server.MapPath(FileUrl));
str = stm.ReadText
stm.close;
return str;
}
//利用AdoDb.Stream对象来写入指定格式的文本文件
function writeToTextFile(FileUrl,Str,CharSet){
var stm = Server.CreateObject("adodb.stream");
stm.Type = 2;
stm.Mode = 3;
stm.Charset = CharSet;
stm.open;
stm.WriteText(Str);
stm.SaveToFile(Server.MapPath(FileUrl),2);
stm.flush;
stm.close;
}
//利用fso判断文件是否存在
function isFileExist(FileUrl){
var FSO = Server.CreateObject("Scripting.FileSystemObject")
if(FSO.FileExists(Server.MapPath(FileUrl))){
return true;
}else{
return false;
}
}
//利用fso写文件
function CateFile(files,fbody){
var fs = Server.CreateObject("Scripting.FileSystemObject");
var a = fs.CreateTextFile(Server.mappath(files));
a.Write(fbody);
a.close();
}
//获取目标页面源代码
function getHTTPPage(url){
var Http= Server.CreateObject("Microsoft.XMLHTTP");
Http.open("GET",url,false);
Http.send();
if (Http.readystate!==4){return false;}
return(BytesToBstr(Http.responseBody,"GB2312"));
}
//编码
function BytesToBstr(body,Cset){
var objstream = Server.CreateObject("adodb.stream");
objstream.Type = 1;
objstream.Mode =3;
objstream.Open();
objstream.Write = body;
objstream.Position = 0;
objstream.Type = 2;
objstream.Charset = Cset;
return(objstream.ReadText);
objstream.Close();
}
//获取完整连接地址
function GetCompleteUrl(sources_url,get_url){
if(get_url.indexOf("http://")!=-1)retu... get_url;
var completeUrl="";
var sources_url_arr = sources_url.split("/");
var get_url_arr = get_url.split("../");
for(var i=0;i<sources_url_arr.length-get_url_arr.length;i++){
completeUrl += sources_url_arr[i] + "/";
}
completeUrl += get_url_arr[get_url_arr.length-1];
return completeUrl;
}
//利用Stream对象下载文件（几乎各种类型的文件都能下）
function downloadFile(strFile)
dim strFilename,s,fso,f,intFilelength
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFile) then
Response.Write("<h1>Error:</h1>该文件不存在<p>")
Response.End
end if
Set f = fso.GetFile(strFile)
intFilelength = f.size
s.LoadFromFile(strFile)
if err then
Response.Write("<h1>Error:</h1>文件下载错误<p>")
Response.End
end if
Response.AddHeader "Content-Disposition","attachment;filename=" & f.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
set f = nothing
set fso = nothing
Set s = Nothing
end function
function connOpen(DataBaseConnectStr){
var conn = Server.CreateObject("ADODB.Connection");
conn.Open(DataBaseConnectStr);
return conn;
}
//利用AdoDb.Stream对象来读取指定格式的文本文件
function readFromTextFile(FileUrl,CharSet){
var str;
var stm = Server.CreateObject("adodb.stream");
stm.Type = 2;
stm.Mode = 3;
stm.Charset=CharSet;
stm.open;
stm.LoadFromFile(Server.MapPath(FileUrl));
str = stm.ReadText
stm.close;
return str;
}
//利用AdoDb.Stream对象来写入指定格式的文本文件
function writeToTextFile(FileUrl,Str,CharSet){
var stm = Server.CreateObject("adodb.stream");
stm.Type = 2;
stm.Mode = 3;
stm.Charset = CharSet;
stm.open;
stm.WriteText(Str);
stm.SaveToFile(Server.MapPath(FileUrl),2);
stm.flush;
stm.close;
}
//利用fso判断文件是否存在
function isFileExist(FileUrl){
var FSO = Server.CreateObject("Scripting.FileSystemObject")
if(FSO.FileExists(Server.MapPath(FileUrl))){
return true;
}else{
return false;
}
}
//利用fso写文件
function CateFile(files,fbody){
var fs = Server.CreateObject("Scripting.FileSystemObject");
var a = fs.CreateTextFile(Server.mappath(files));
a.Write(fbody);
a.close();
}
//获取目标页面源代码
function getHTTPPage(url){
var Http= Server.CreateObject("Microsoft.XMLHTTP");
Http.open("GET",url,false);
Http.send();
if (Http.readystate!==4){return false;}
return(BytesToBstr(Http.responseBody,"GB2312"));
}
//编码
function BytesToBstr(body,Cset){
var objstream = Server.CreateObject("adodb.stream");
objstream.Type = 1;
objstream.Mode =3;
objstream.Open();
objstream.Write = body;
objstream.Position = 0;
objstream.Type = 2;
objstream.Charset = Cset;
return(objstream.ReadText);
objstream.Close();
}
//获取完整连接地址
function GetCompleteUrl(sources_url,get_url){
if(get_url.indexOf("http://")!=-1)retu... get_url;
var completeUrl="";
var sources_url_arr = sources_url.split("/");
var get_url_arr = get_url.split("../");
for(var i=0;i<sources_url_arr.length-get_url_arr.length;i++){
completeUrl += sources_url_arr[i] + "/";
}
completeUrl += get_url_arr[get_url_arr.length-1];
return completeUrl;
}
//利用Stream对象下载文件（几乎各种类型的文件都能下）
function downloadFile(strFile)
dim strFilename,s,fso,f,intFilelength
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFile) then
Response.Write("<h1>Error:</h1>该文件不存在<p>")
Response.End
end if
Set f = fso.GetFile(strFile)
intFilelength = f.size
s.LoadFromFile(strFile)
if err then
Response.Write("<h1>Error:</h1>文件下载错误<p>")
Response.End
end if
Response.AddHeader "Content-Disposition","attachment;filename=" & f.name
Response.AddHeader "Content-Length",intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
set f = nothing
set fso = nothing
Set s = Nothing
end function
不用模板，只用ASP+FSO生成静态HTML页的一个方法（对于内容密集型页面特别适用）
Submitted by on 2006, August 25, 7:21 AM
FSO生成静态HTML文件的时候替换模板标签一直是一个很麻烦的问题，至少我是这么认为的，还要别外做一个模板，麻烦！，我今天看见有一个方法可以解决这个问题
如一个正常的index.asp页面，并且用ASP代码调出数据库中的内容，另建一个makehtml.asp的页面，加入一个textarea域，假设为name="body"，将index.asp在textarea里调出来，如：
<textarea name="body"><!--#include file="index.asp"--></textarea>，将这个textarea包含在表单中，在接收表单页用创建FSO对象，如下生成index.html文件！
这样index.html文件就生成了，连模板都用不着，只要将正常情况下使用的ASP文件读取到textarea里就可以了，目前尚未发现问题！当然前提是服务器要支持FSO
如一个正常的index.asp页面，并且用ASP代码调出数据库中的内容，另建一个makehtml.asp的页面，加入一个textarea域，假设为name="body"，将index.asp在textarea里调出来，如：
<textarea name="body"><!--#include file="index.asp"--></textarea>，将这个textarea包含在表单中，在接收表单页用创建FSO对象，如下生成index.html文件！
| 代码: |
| <%
filename="../index.html" if request("body")<>"" then set fso = Server.CreateObject("Scripting.FileSystemObject") set fout = fso.CreateTextFile(server.mappath(""&filename&"")) fout.write request.form("body") fout.close set fout=nothing set fso=nothing end if %> |
这样index.html文件就生成了，连模板都用不着，只要将正常情况下使用的ASP文件读取到textarea里就可以了，目前尚未发现问题！当然前提是服务器要支持FSO
为pjBlog添加漂亮的“载入中”对话框
Submitted by on 2006, August 24, 7:50 PM
首先，打开header.asp，在[head]的后面，插入以下代码：
<%"=======X-Force添加的Loading界面==========%>
<style type="text/css">
#loader_container {
text-align:center;
position:absolute;
top:40%;
width:100%;
left: 0;
}
#loader {
font-family:Tahoma, Helvetica, sans;
font-size:11.5px;
color:#000000;
background-color:#FFFFFF;
padding:10px 0 16px 0;
margin:0 auto;
display:block;
width:230px;
border:1px solid #5a667b;
text-align:left;
z-index:2;
}
#loader_bg {background-color:#e4e7eb;
position:relative;
top:8px;
left:8px;
height:7px;
width:213px;
font-size:1px}
#progress {
height:5px;
font-size:1px;
width:1px;
position:relative;
top:1px;
left:0px;
background-color:#77A9E0
}
</style>
<script language="JavaScript">
//读取框
var t_id = setInterval(animate,20);
var pos=0;
var dir=2;
var len=0;
function animate()
{
var elem = document.getElementById("progress");
if(elem != null) {
if (pos==0) len += dir;
if (len>32 || pos>179) pos += dir;
if (pos>179) len -= dir;
if (pos>179 && len==0) pos=0;
elem.style.left = pos;
elem.style.width = len;
}
}
function remove_loading() {
this.clearInterval(t_id);
var targelem = document.getElementById("loader_container");
targelem.style.display="none";
targelem.style.visibility="hidden";
initJS();
}
</script>
<%"============X-Force添加的Loading界面==========%>
然后，找到：
<body onload="initJS()" onkeydown="PressKey()">
将其修改为：
<body onload="remove_loading()" onkeydown="PressKey()">
<%"===========X-Force的Loading界面==========%>
<div id="loader_container">
<div id="loader">
<div align="center">
本站靓靓の页面正在很用力de加载中... <br>
版权归 www.X-Force.cn 所有
</div>
<div id="loader_bg"><div id="progress"> </div></div>
</div>
</div>
<%"===========X-Force的Loading界面==========%>
<%"=======X-Force添加的Loading界面==========%>
<style type="text/css">
#loader_container {
text-align:center;
position:absolute;
top:40%;
width:100%;
left: 0;
}
#loader {
font-family:Tahoma, Helvetica, sans;
font-size:11.5px;
color:#000000;
background-color:#FFFFFF;
padding:10px 0 16px 0;
margin:0 auto;
display:block;
width:230px;
border:1px solid #5a667b;
text-align:left;
z-index:2;
}
#loader_bg {background-color:#e4e7eb;
position:relative;
top:8px;
left:8px;
height:7px;
width:213px;
font-size:1px}
#progress {
height:5px;
font-size:1px;
width:1px;
position:relative;
top:1px;
left:0px;
background-color:#77A9E0
}
</style>
<script language="JavaScript">
//读取框
var t_id = setInterval(animate,20);
var pos=0;
var dir=2;
var len=0;
function animate()
{
var elem = document.getElementById("progress");
if(elem != null) {
if (pos==0) len += dir;
if (len>32 || pos>179) pos += dir;
if (pos>179) len -= dir;
if (pos>179 && len==0) pos=0;
elem.style.left = pos;
elem.style.width = len;
}
}
function remove_loading() {
this.clearInterval(t_id);
var targelem = document.getElementById("loader_container");
targelem.style.display="none";
targelem.style.visibility="hidden";
initJS();
}
</script>
<%"============X-Force添加的Loading界面==========%>
然后，找到：
<body onload="initJS()" onkeydown="PressKey()">
将其修改为：
<body onload="remove_loading()" onkeydown="PressKey()">
<%"===========X-Force的Loading界面==========%>
<div id="loader_container">
<div id="loader">
<div align="center">
本站靓靓の页面正在很用力de加载中... <br>
版权归 www.X-Force.cn 所有
</div>
<div id="loader_bg"><div id="progress"> </div></div>
</div>
</div>
<%"===========X-Force的Loading界面==========%>
使用FSO读取网站系统使用空间的大小
Submitted by on 2006, August 24, 7:44 PM
| 代码: |
| <%set fsoSpaceObj=Server.CreateObject("Scripting.FileSystemObject")
sysrootdir="" if SysRootDir = "" then SysPath=Server.mappath("/") else SysPath=Server.mappath("/" & SysRootDir) end if if fsoSpaceObj.FolderExists(SysPath) then set GetSysSpace=fsoSpaceObj.GetFolder(SysPath) SysSpace=GetSysSpace.size if SysSpace=0 then ShowSysSpace=0 else SysSpace=SysSpace/1024/1024 ShowSysSpace = formatnumber(SysSpace,2,-1) end if else ShowSysSpace=0 end if SysPicSize=formatnumber(ShowSysSpace/300*100,2,-1) %> |
ASP备份与恢复SQL Server数据库
Submitted by on 2006, August 24, 6:41 PM
| 代码: |
| <HTML>
<HEAD> <TITLE>数据库操作</TITLE> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> </HEAD> <BODY> <form method="post" name=myform> <%if action="restore" then%><INPUT TYPE="hidden" name="action" value="restore">准备恢复数据库。。。 <%elseif action="backup" then%><INPUT TYPE="hidden" name="action" value="backup">准备备份数据库。。。<%else%> 选择操作： <INPUT TYPE="radio" name="action" id="act_backup" value="backup"><label for=act_backup>备份</label> <INPUT TYPE="radio" name="action" id="act_restore" value="restore"><label for=act_restore>恢复</label><%end if%> <br>数据库名：<INPUT TYPE="text" name="databasename" value="bbs"> <br>文件路径：<INPUT TYPE="text" name="bak_file" value="bbs.bak">(备份或恢复的文件路径)<br> <input type="submit" value="确定"> </form> <% dim sqlserver,sqlname,sqlpassword,sqlLoginTimeout,databasename,bak_file,act sqlserver = "localhost" "sql服务器 sqlname = "bbs" "用户名 sqlpassword = "bbs" "密码 sqlLoginTimeout = 15 "登陆超时 databasename = trim(request("databasename")) bak_file = trim(request("bak_file")) bak_file = Server.MapPath("backup/"&bak_file) act = lcase(request("action")) if databasename = "" then response.write "input database name" else if act = "backup" then Set srv = Server.CreateObject("SQLDMO.SQLServer") srv.LoginTimeout = sqlLoginTimeout srv.Connect sqlserver,sqlname, sqlpassword Set bak = Server.CreateObject("SQLDMO.Backup") bak.Database = databasename bak.Devices = Files bak.Files = bak_file bak.Action = 0 bak.Initialize = 1 "bak.ReplaceDatabase = True bak.SQLBackup srv if err.number>0 then response.write err.number&"<font color=red><br>" response.write err.description&"</font>" end if Response.write "<font color=green>备份成功!</font>" srv.disconnect Set srv = nothing Set bak = nothing elseif act = "restore" then "恢复时要在没有使用数据库时进行！ Set srv=Server.CreateObject("SQLDMO.SQLServer") srv.LoginTimeout = sqlLoginTimeout srv.Connect sqlserver,sqlname, sqlpassword Set rest = Server.CreateObject("SQLDMO.Restore") rest.Action = 0 " full db restore rest.Database = databasename rest.Devices = Files rest.Files = bak_file rest.ReplaceDatabase = True "Force restore over existing database if err.number>0 then response.write err.number&"<font color=red><br>" response.write err.description&"</font>" end if rest.SQLRestore srv Response.write "<font color=green>恢复成功!</font>" srv.disconnect Set srv = nothing Set rest = nothing else Response.write "<font color=red>没有选择操作</font>" end if end if %> </BODY> |
20个经典ASP例子
Submitted by on 2006, August 24, 6:39 PM
显示页面加载时间
页面顶部添加下面的代码：
<%
Dim strStartTime
Dim strEndTime
strStartTime = Timer "开始时间
%>
页面(同一页)的末尾添加：
<%
" 加载完毕的时间
strEndTime = Timer
Response.Write ("页面加载时间: ")
Response.Write FormatNumber(strEndTime - strStartTime, 4)
Response.Write (" 秒.")
%>
1.如何用Asp判断你的网站的虚拟物理路径
答：使用Mappath方法
< p align="center" > < font size="4" face="Arial" > < b >
The Physical path to this virtual website is:
< /b > < /font >
< font color="#FF0000" size="6" face="Arial" >
< %= Server.MapPath("\")% >
< /font > < /p >
2.我如何知道使用者所用的浏览器？
答：使用the Request object方法
strBrowser=Request.ServerVariables("HTTP_USER_AGENT")
If Instr(strBrowser,"MSIE") < > 0 Then
Response.redirect("ForMSIEOnly.htm")
Else
Response.redirect("ForAll.htm")
End If
3.如何计算每天的平均反复访问人数
答：解决方法
< % startdate=DateDiff("d",Now,"01/01/1990")
if strdate < 0 then startdate=startdate*-1
avgvpd=Int((usercnt)/startdate) % >
显示结果
< % response.write(avgvpd) % >
that is it.this page have been viewed since November 10,1998
4.如何显示随机图象
< % dim p,ppic,dpic
ppic=12
randomize
p=Int((ppic*rnd)+1)
dpic="graphix/randompics/"&p&".gif"
% >
显示
< img src=" < %=dpic% >" >
5.如何回到先前的页面
答： < a href=" < %=request.serverVariables("Http_REFERER")% >" >preivous page < /a >
或用图片如： < img src="arrowback.gif" alt=" < %=request.serverVariables("HTTP_REFERER")% >" >
6.如何确定对方的IP地址
答： < %=Request.serverVariables("REMOTE_ADDR)% >
7.如何链结到一副图片上
答： < % @Languages=vbs cript % >
< % response.expires=0
strimagename="graphix/errors/erroriamge.gif"
response.redirect(strimagename)
% >
8.强迫输入密码对话框
答：把这句话放载页面的开头
< % response.status="401 not Authorized"
response.end
% >
9.如何传递变量从一页到另一页
答：用 HIDDEN 类型来传递变量
< % form method="post" action="mynextpage.asp" >
< % for each item in request.form % >
< input namee=" < %=item% >" type="HIDDEN"
value=" < %=server.HTMLEncode(Request.form(item)) % >" >
< % next % >
< /form >
10.为何我在 asp 程序内使用 msgbox，程序出错说没有权限
答：由于 asp 是服务器运行的，如果可以在服务器显示一个对话框，那么你只好等有人按了确定之后，你的程序才能继续执行，而一般服务器不会有人守着，所以微软不得不禁止这个函数，并胡乱告诉你 (:) 呵呵) 没有权限。但是ASP和客户端脚本结合倒可以显示一个对话框，as follows:
< % yourVar="测试对话框"% >
< % s cript language="javas cript" >
alert(" < %=yourvar% >")
< /s cript >
11.有没有办法保护自己的源代码，不给人看到
答：可以去下载一个微软的Windows s cript Encoder，它可以对asp的脚本和客户端javas cript/vbs cript脚本进行加密。。。不过客户端加密后，只有ie5才能执行，服务器端脚本加密后，只有服务器上安装有s cript engine 5（装一个ie5就有了）才能执行。
12.怎样才能将 query string 从一个 asp 文件传送到另一个？
答：前者文件加入下句： Response.Redirect("second.asp?" & Request.ServerVariables("QUERY_STRING"))
13.global.asa文件总是不起作用?
答：只有web目录设置为web application, global.asa才有效，并且一个web application的根目录下 global.asa才有效。IIS4可以使用Internet Service Manager设置application setting 怎样才能使得htm文件如同asp文件一样可以执行脚本代码？
14.怎样才能使得htm文件如同asp文件一样可以执行脚本代码？
答：Internet Sevices Manager - > 选择default web site - >右鼠键- >菜单属性-〉主目录- > 应用程序设置（Application Setting）- > 点击按钮 "配置"- > app mapping - >点击按钮"Add" - > executable browse选择 \WINNT\SYSTEM32\INETSRV\ASP.DLL EXTENSION 输入 htm method exclusions 输入PUT.Delete 全部确定即可。但是值得注意的是这样对htm也要由asp.dll处理，效率将降低。
15.如何注册组件
答：有两种方法。
第一种方法：手工注册 DLL 这种方法从IIs 3.0一直使用到IIs 4.0和其它的Web Server。它需要你在命令行方式下来执行，进入到包含有DLL的目录，并输入：regsvr32 component_name.dll 例如 c:\temp\regsvr32 AspEmail.dll 它会把dll的特定信息注册入服务器中的注册表中。然后这个组件就可以在服务器上使用了，但是这个方法有一个缺陷。当使用这种方法注册完毕组件后，该组件必须要相应的设置NT的匿名帐号有权限执行这个dll。特别是一些组件需要读取注册表，所以，这个注册组件的方法仅仅是使用在服务器上没有MTS的情况下，要取消注册这个dll，使用：regsvr32 /u aspobject.dll example c:\temp\regsvr32 /u aneiodbc.dll
第二种方法：使用MTS(Microsoft Transaction Server) MTS是IIS 4新增特色，但是它提供了巨大的改进。MTS允许你指定只有有特权的用户才能够访问组件，大大提高了网站服务器上的安全性设置。在MTS上注册组件的步骤如下：
1) 打开IIS管理控制台。
2) 展开transaction server，右键单击"pkgs installed"然后选择"new package"。
3) 单击"create an empty package"。
4) 给该包命名。
5) 指定administrator帐号或则使用"interactive"（如果服务器经常是使用administrator 登陆的话）。
6) 现在使用右键单击你刚建立的那个包下面展开后的"components"。选择 "new then component"。
7) 选择 "install new component" 。
8) 找到你的.dll文件然后选择next到完成。
要删除这个对象，只要选择它的图标，然后选择delete。
附注：特别要注意第二种方法，它是用来调试自己编写组件的最好方法，而不必每次都需要重新启动机器了。
16. ASP与Access数据库连接：
<%@ language=VBs cript%>
<%
dim conn,mdbfile
mdbfile=server.mappath("数据库名称.mdb")
set conn=server.createobject("adodb.connection")
conn.open "driver={microsoft access driver (*.mdb)};uid=admin;pwd=数据库密码;dbq="&mdbfile
%>
17. ASP与SQL数据库连接：
<%@ language=VBs cript%>
<%
dim conn
set conn=server.createobject("ADODB.connection")
con.open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服务器名称或IP地址;UID=sa;PWD=数据库密码;DATABASE=数据库名称
%>
建立记录集对象：
set rs=server.createobject("adodb.recordset")
rs.open SQL语句,conn,3,2
18. SQL常用命令使用方法：
(1) 数据记录筛选：
sql="select * from 数据表 where 字段名=字段值 order by 字段名 [desc]"
sql="select * from 数据表 where 字段名 like "%字段值%" order by 字段名 [desc]"
sql="select top 10 * from 数据表 where 字段名 order by 字段名 [desc]"
sql="select * from 数据表 where 字段名 in ("值1","值2","值3")"
sql="select * from 数据表 where 字段名 between 值1 and 值2"
(2) 更新数据记录：
sql="update 数据表 set 字段名=字段值 where 条件表达式"
sql="update 数据表 set 字段1=值1,字段2=值2 …… 字段n=值n where 条件表达式"
(3) 删除数据记录：
sql="delete from 数据表 where 条件表达式"
sql="delete from 数据表" (将数据表所有记录删除)
(4) 添加数据记录：
sql="insert into 数据表 (字段1,字段2,字段3 …) valuess (值1,值2,值3 …)"
sql="insert into 目标数据表 select * from 源数据表" (把源数据表的记录添加到目标数据表)
(5) 数据记录统计函数：
AVG(字段名) 得出一个表格栏平均值
COUNT(*|字段名) 对数据行数的统计或对某一栏有值的数据行数统计
MAX(字段名) 取得一个表格栏最大的值
MIN(字段名) 取得一个表格栏最小的值
SUM(字段名) 把数据栏的值相加
引用以上函数的方法：
sql="select sum(字段名) as 别名 from 数据表 where 条件表达式"
set rs=conn.excute(sql)
用 rs("别名") 获取统的计值，其它函数运用同上。
(5) 数据表的建立和删除：
Create TABLE 数据表名称(字段1 类型1(长度),字段2 类型2(长度) …… )
例：Create TABLE tab01(name varchar(50),datetime default now())
Drop TABLE 数据表名称 (永久性删除一个数据表)
19. 记录集对象的方法：
rs.movenext 将记录指针从当前的位置向下移一行
rs.moveprevious 将记录指针从当前的位置向上移一行
rs.movefirst 将记录指针移到数据表第一行
rs.movelast 将记录指针移到数据表最后一行
rs.absoluteposition=N 将记录指针移到数据表第N行
rs.absolutepage=N 将记录指针移到第N页的第一行
rs.pagesize=N 设置每页为N条记录
rs.pagecount 根据 pagesize 的设置返回总页数
rs.recordcount 返回记录总数
rs.bof 返回记录指针是否超出数据表首端，true表示是，false为否
rs.eof 返回记录指针是否超出数据表末端，true表示是，false为否
rs.delete 删除当前记录，但记录指针不会向下移动
rs.addnew 添加记录到数据表末端
rs.update 更新数据表记录
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
20 Recordset对象方法
Open方法
recordset.Open Source,ActiveConnection,CursorType,LockType,Options
Source
Recordset对象可以通过Source属性来连接Command对象。Source参数可以是一个Command对象名称、一段SQL命令、一个指定的数据表名称或是一个Stored Procedure。假如省略这个参数，系统则采用Recordset对象的Source属性。
ActiveConnection
Recordset对象可以通过ActiveConnection属性来连接Connection对象。这里的ActiveConnection可以是一个Connection对象或是一串包含数据库连接信息（ConnectionString）的字符串参数。
CursorType
Recordset对象Open方法的CursorType参数表示将以什么样的游标类型启动数据，包括adOpenForwardOnly、adOpenKeyset、adOpenDynamic及adOpenStatic，分述如下：
--------------------------------------------------------------
常数 常数值 说明
-------------------------------------------------------------
adOpenForwardOnly 0 缺省值，启动一个只能向前移动的游标（Forward Only）。
adOpenKeyset 1 启动一个Keyset类型的游标。
adOpenDynamic 2 启动一个Dynamic类型的游标。
adOpenStatic 3 启动一个Static类型的游标。
-------------------------------------------------------------
以上几个游标类型将直接影响到Recordset对象所有的属性和方法，以下列表说明他们之间的区别。
-------------------------------------------------------------
Recordset属性 adOpenForwardOnly adOpenKeyset adOpenDynamic adOpenStatic
-------------------------------------------------------------
AbsolutePage 不支持 不支持 可读写 可读写
AbsolutePosition 不支持 不支持 可读写 可读写
ActiveConnection 可读写 可读写 可读写 可读写
BOF 只读 只读 只读 只读
Bookmark 不支持 不支持 可读写 可读写
CacheSize 可读写 可读写 可读写 可读写
CursorLocation 可读写 可读写 可读写 可读写
CursorType 可读写 可读写 可读写 可读写
EditMode 只读 只读 只读 只读
EOF 只读 只读 只读 只读
Filter 可读写 可读写 可读写 可读写
LockType 可读写 可读写 可读写 可读写
MarshalOptions 可读写 可读写 可读写 可读写
MaxRecords 可读写 可读写 可读写 可读写
PageCount 不支持 不支持 只读 只读
PageSize 可读写 可读写 可读写 可读写
RecordCount 不支持 不支持 只读 只读
Source 可读写 可读写 可读写 可读写
State 只读 只读 只读 只读
Status 只读 只读 只读 只读
AddNew 支持 支持 支持 支持
CancelBatch 支持 支持 支持 支持
CancelUpdate 支持 支持 支持 支持
Clone 不支持 不支持
Close 支持 支持 支持 支持
Delete 支持 支持 支持 支持
GetRows 支持 支持 支持 支持
Move 不支持 支持 支持 支持
MoveFirst 支持 支持 支持 支持
MoveLast 不支持 支持 支持 支持
MoveNext 支持 支持 支持 支持
MovePrevious 不支持 支持 支持 支持
NextRecordset 支持 支持 支持 支持
Open 支持 支持 支持 支持
Requery 支持 支持 支持 支持
Resync 不支持 不支持 支持 支持
Supports 支持 支持 支持 支持
Update 支持 支持 支持 支持
UpdateBatch 支持 支持 支持 支持
--------------------------------------------------------------
其中NextRecordset方法并不适用于Microsoft Access数据库。
LockType
Recordset对象Open方法的LockType参数表示要采用的Lock类型，如果忽略这个参数，那么系统会以Recordset对象的LockType属性为预设值。LockType参数包含adLockReadOnly、adLockPrssimistic、adLockOptimistic及adLockBatchOptimistic等，分述如下：
-------------------------------------------------------------
常数 常数值 说明
--------------------------------------------------------------
adLockReadOnly 1 缺省值，Recordset对象以只读方式启动，无法运行AddNew、Update及Delete等方法
adLockPrssimistic 2 当数据源正在更新时，系统会暂时锁住其他用户的动作，以保持数据一致性。
adLockOptimistic 3 当数据源正在更新时，系统并不会锁住其他用户的动作，其他用户可以对数据进行增、删、改的操作。
adLockBatchOptimistic 4 当数据源正在更新时，其他用户必须将CursorLocation属性改为adUdeClientBatch才能对数据进行增、
删、改的操作。
页面顶部添加下面的代码：
<%
Dim strStartTime
Dim strEndTime
strStartTime = Timer "开始时间
%>
页面(同一页)的末尾添加：
<%
" 加载完毕的时间
strEndTime = Timer
Response.Write ("页面加载时间: ")
Response.Write FormatNumber(strEndTime - strStartTime, 4)
Response.Write (" 秒.")
%>
1.如何用Asp判断你的网站的虚拟物理路径
答：使用Mappath方法
< p align="center" > < font size="4" face="Arial" > < b >
The Physical path to this virtual website is:
< /b > < /font >
< font color="#FF0000" size="6" face="Arial" >
< %= Server.MapPath("\")% >
< /font > < /p >
2.我如何知道使用者所用的浏览器？
答：使用the Request object方法
strBrowser=Request.ServerVariables("HTTP_USER_AGENT")
If Instr(strBrowser,"MSIE") < > 0 Then
Response.redirect("ForMSIEOnly.htm")
Else
Response.redirect("ForAll.htm")
End If
3.如何计算每天的平均反复访问人数
答：解决方法
< % startdate=DateDiff("d",Now,"01/01/1990")
if strdate < 0 then startdate=startdate*-1
avgvpd=Int((usercnt)/startdate) % >
显示结果
< % response.write(avgvpd) % >
that is it.this page have been viewed since November 10,1998
4.如何显示随机图象
< % dim p,ppic,dpic
ppic=12
randomize
p=Int((ppic*rnd)+1)
dpic="graphix/randompics/"&p&".gif"
% >
显示
< img src=" < %=dpic% >" >
5.如何回到先前的页面
答： < a href=" < %=request.serverVariables("Http_REFERER")% >" >preivous page < /a >
或用图片如： < img src="arrowback.gif" alt=" < %=request.serverVariables("HTTP_REFERER")% >" >
6.如何确定对方的IP地址
答： < %=Request.serverVariables("REMOTE_ADDR)% >
7.如何链结到一副图片上
答： < % @Languages=vbs cript % >
< % response.expires=0
strimagename="graphix/errors/erroriamge.gif"
response.redirect(strimagename)
% >
8.强迫输入密码对话框
答：把这句话放载页面的开头
< % response.status="401 not Authorized"
response.end
% >
9.如何传递变量从一页到另一页
答：用 HIDDEN 类型来传递变量
< % form method="post" action="mynextpage.asp" >
< % for each item in request.form % >
< input namee=" < %=item% >" type="HIDDEN"
value=" < %=server.HTMLEncode(Request.form(item)) % >" >
< % next % >
< /form >
10.为何我在 asp 程序内使用 msgbox，程序出错说没有权限
答：由于 asp 是服务器运行的，如果可以在服务器显示一个对话框，那么你只好等有人按了确定之后，你的程序才能继续执行，而一般服务器不会有人守着，所以微软不得不禁止这个函数，并胡乱告诉你 (:) 呵呵) 没有权限。但是ASP和客户端脚本结合倒可以显示一个对话框，as follows:
< % yourVar="测试对话框"% >
< % s cript language="javas cript" >
alert(" < %=yourvar% >")
< /s cript >
11.有没有办法保护自己的源代码，不给人看到
答：可以去下载一个微软的Windows s cript Encoder，它可以对asp的脚本和客户端javas cript/vbs cript脚本进行加密。。。不过客户端加密后，只有ie5才能执行，服务器端脚本加密后，只有服务器上安装有s cript engine 5（装一个ie5就有了）才能执行。
12.怎样才能将 query string 从一个 asp 文件传送到另一个？
答：前者文件加入下句： Response.Redirect("second.asp?" & Request.ServerVariables("QUERY_STRING"))
13.global.asa文件总是不起作用?
答：只有web目录设置为web application, global.asa才有效，并且一个web application的根目录下 global.asa才有效。IIS4可以使用Internet Service Manager设置application setting 怎样才能使得htm文件如同asp文件一样可以执行脚本代码？
14.怎样才能使得htm文件如同asp文件一样可以执行脚本代码？
答：Internet Sevices Manager - > 选择default web site - >右鼠键- >菜单属性-〉主目录- > 应用程序设置（Application Setting）- > 点击按钮 "配置"- > app mapping - >点击按钮"Add" - > executable browse选择 \WINNT\SYSTEM32\INETSRV\ASP.DLL EXTENSION 输入 htm method exclusions 输入PUT.Delete 全部确定即可。但是值得注意的是这样对htm也要由asp.dll处理，效率将降低。
15.如何注册组件
答：有两种方法。
第一种方法：手工注册 DLL 这种方法从IIs 3.0一直使用到IIs 4.0和其它的Web Server。它需要你在命令行方式下来执行，进入到包含有DLL的目录，并输入：regsvr32 component_name.dll 例如 c:\temp\regsvr32 AspEmail.dll 它会把dll的特定信息注册入服务器中的注册表中。然后这个组件就可以在服务器上使用了，但是这个方法有一个缺陷。当使用这种方法注册完毕组件后，该组件必须要相应的设置NT的匿名帐号有权限执行这个dll。特别是一些组件需要读取注册表，所以，这个注册组件的方法仅仅是使用在服务器上没有MTS的情况下，要取消注册这个dll，使用：regsvr32 /u aspobject.dll example c:\temp\regsvr32 /u aneiodbc.dll
第二种方法：使用MTS(Microsoft Transaction Server) MTS是IIS 4新增特色，但是它提供了巨大的改进。MTS允许你指定只有有特权的用户才能够访问组件，大大提高了网站服务器上的安全性设置。在MTS上注册组件的步骤如下：
1) 打开IIS管理控制台。
2) 展开transaction server，右键单击"pkgs installed"然后选择"new package"。
3) 单击"create an empty package"。
4) 给该包命名。
5) 指定administrator帐号或则使用"interactive"（如果服务器经常是使用administrator 登陆的话）。
6) 现在使用右键单击你刚建立的那个包下面展开后的"components"。选择 "new then component"。
7) 选择 "install new component" 。
8) 找到你的.dll文件然后选择next到完成。
要删除这个对象，只要选择它的图标，然后选择delete。
附注：特别要注意第二种方法，它是用来调试自己编写组件的最好方法，而不必每次都需要重新启动机器了。
16. ASP与Access数据库连接：
<%@ language=VBs cript%>
<%
dim conn,mdbfile
mdbfile=server.mappath("数据库名称.mdb")
set conn=server.createobject("adodb.connection")
conn.open "driver={microsoft access driver (*.mdb)};uid=admin;pwd=数据库密码;dbq="&mdbfile
%>
17. ASP与SQL数据库连接：
<%@ language=VBs cript%>
<%
dim conn
set conn=server.createobject("ADODB.connection")
con.open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服务器名称或IP地址;UID=sa;PWD=数据库密码;DATABASE=数据库名称
%>
建立记录集对象：
set rs=server.createobject("adodb.recordset")
rs.open SQL语句,conn,3,2
18. SQL常用命令使用方法：
(1) 数据记录筛选：
sql="select * from 数据表 where 字段名=字段值 order by 字段名 [desc]"
sql="select * from 数据表 where 字段名 like "%字段值%" order by 字段名 [desc]"
sql="select top 10 * from 数据表 where 字段名 order by 字段名 [desc]"
sql="select * from 数据表 where 字段名 in ("值1","值2","值3")"
sql="select * from 数据表 where 字段名 between 值1 and 值2"
(2) 更新数据记录：
sql="update 数据表 set 字段名=字段值 where 条件表达式"
sql="update 数据表 set 字段1=值1,字段2=值2 …… 字段n=值n where 条件表达式"
(3) 删除数据记录：
sql="delete from 数据表 where 条件表达式"
sql="delete from 数据表" (将数据表所有记录删除)
(4) 添加数据记录：
sql="insert into 数据表 (字段1,字段2,字段3 …) valuess (值1,值2,值3 …)"
sql="insert into 目标数据表 select * from 源数据表" (把源数据表的记录添加到目标数据表)
(5) 数据记录统计函数：
AVG(字段名) 得出一个表格栏平均值
COUNT(*|字段名) 对数据行数的统计或对某一栏有值的数据行数统计
MAX(字段名) 取得一个表格栏最大的值
MIN(字段名) 取得一个表格栏最小的值
SUM(字段名) 把数据栏的值相加
引用以上函数的方法：
sql="select sum(字段名) as 别名 from 数据表 where 条件表达式"
set rs=conn.excute(sql)
用 rs("别名") 获取统的计值，其它函数运用同上。
(5) 数据表的建立和删除：
Create TABLE 数据表名称(字段1 类型1(长度),字段2 类型2(长度) …… )
例：Create TABLE tab01(name varchar(50),datetime default now())
Drop TABLE 数据表名称 (永久性删除一个数据表)
19. 记录集对象的方法：
rs.movenext 将记录指针从当前的位置向下移一行
rs.moveprevious 将记录指针从当前的位置向上移一行
rs.movefirst 将记录指针移到数据表第一行
rs.movelast 将记录指针移到数据表最后一行
rs.absoluteposition=N 将记录指针移到数据表第N行
rs.absolutepage=N 将记录指针移到第N页的第一行
rs.pagesize=N 设置每页为N条记录
rs.pagecount 根据 pagesize 的设置返回总页数
rs.recordcount 返回记录总数
rs.bof 返回记录指针是否超出数据表首端，true表示是，false为否
rs.eof 返回记录指针是否超出数据表末端，true表示是，false为否
rs.delete 删除当前记录，但记录指针不会向下移动
rs.addnew 添加记录到数据表末端
rs.update 更新数据表记录
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
20 Recordset对象方法
Open方法
recordset.Open Source,ActiveConnection,CursorType,LockType,Options
Source
Recordset对象可以通过Source属性来连接Command对象。Source参数可以是一个Command对象名称、一段SQL命令、一个指定的数据表名称或是一个Stored Procedure。假如省略这个参数，系统则采用Recordset对象的Source属性。
ActiveConnection
Recordset对象可以通过ActiveConnection属性来连接Connection对象。这里的ActiveConnection可以是一个Connection对象或是一串包含数据库连接信息（ConnectionString）的字符串参数。
CursorType
Recordset对象Open方法的CursorType参数表示将以什么样的游标类型启动数据，包括adOpenForwardOnly、adOpenKeyset、adOpenDynamic及adOpenStatic，分述如下：
--------------------------------------------------------------
常数 常数值 说明
-------------------------------------------------------------
adOpenForwardOnly 0 缺省值，启动一个只能向前移动的游标（Forward Only）。
adOpenKeyset 1 启动一个Keyset类型的游标。
adOpenDynamic 2 启动一个Dynamic类型的游标。
adOpenStatic 3 启动一个Static类型的游标。
-------------------------------------------------------------
以上几个游标类型将直接影响到Recordset对象所有的属性和方法，以下列表说明他们之间的区别。
-------------------------------------------------------------
Recordset属性 adOpenForwardOnly adOpenKeyset adOpenDynamic adOpenStatic
-------------------------------------------------------------
AbsolutePage 不支持 不支持 可读写 可读写
AbsolutePosition 不支持 不支持 可读写 可读写
ActiveConnection 可读写 可读写 可读写 可读写
BOF 只读 只读 只读 只读
Bookmark 不支持 不支持 可读写 可读写
CacheSize 可读写 可读写 可读写 可读写
CursorLocation 可读写 可读写 可读写 可读写
CursorType 可读写 可读写 可读写 可读写
EditMode 只读 只读 只读 只读
EOF 只读 只读 只读 只读
Filter 可读写 可读写 可读写 可读写
LockType 可读写 可读写 可读写 可读写
MarshalOptions 可读写 可读写 可读写 可读写
MaxRecords 可读写 可读写 可读写 可读写
PageCount 不支持 不支持 只读 只读
PageSize 可读写 可读写 可读写 可读写
RecordCount 不支持 不支持 只读 只读
Source 可读写 可读写 可读写 可读写
State 只读 只读 只读 只读
Status 只读 只读 只读 只读
AddNew 支持 支持 支持 支持
CancelBatch 支持 支持 支持 支持
CancelUpdate 支持 支持 支持 支持
Clone 不支持 不支持
Close 支持 支持 支持 支持
Delete 支持 支持 支持 支持
GetRows 支持 支持 支持 支持
Move 不支持 支持 支持 支持
MoveFirst 支持 支持 支持 支持
MoveLast 不支持 支持 支持 支持
MoveNext 支持 支持 支持 支持
MovePrevious 不支持 支持 支持 支持
NextRecordset 支持 支持 支持 支持
Open 支持 支持 支持 支持
Requery 支持 支持 支持 支持
Resync 不支持 不支持 支持 支持
Supports 支持 支持 支持 支持
Update 支持 支持 支持 支持
UpdateBatch 支持 支持 支持 支持
--------------------------------------------------------------
其中NextRecordset方法并不适用于Microsoft Access数据库。
LockType
Recordset对象Open方法的LockType参数表示要采用的Lock类型，如果忽略这个参数，那么系统会以Recordset对象的LockType属性为预设值。LockType参数包含adLockReadOnly、adLockPrssimistic、adLockOptimistic及adLockBatchOptimistic等，分述如下：
-------------------------------------------------------------
常数 常数值 说明
--------------------------------------------------------------
adLockReadOnly 1 缺省值，Recordset对象以只读方式启动，无法运行AddNew、Update及Delete等方法
adLockPrssimistic 2 当数据源正在更新时，系统会暂时锁住其他用户的动作，以保持数据一致性。
adLockOptimistic 3 当数据源正在更新时，系统并不会锁住其他用户的动作，其他用户可以对数据进行增、删、改的操作。
adLockBatchOptimistic 4 当数据源正在更新时，其他用户必须将CursorLocation属性改为adUdeClientBatch才能对数据进行增、
删、改的操作。
ASP无限分类
Submitted by on 2006, August 24, 6:16 PM
实现一：
数据库Access,字段：ClassID（主键）,ParentClassID,ClassName，3个字段都是文本型。
方法二：
数据库Access,字段：ClassID（主键）,ParentClassID,ClassName，3个字段都是文本型。
| 代码: |
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml... <html xmlns="http://www.w3.org/1999/xht... <head> <title>ASP无限分类数据库版</title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> <meta name="Generator" content="EditPlus"> <meta name="Author" content="Dicky;QQ:25941"> <meta name="Keywords" content="Dicky;QQ:25941;ASP无限分类数据库版"> <meta name="Description" content="Dicky;QQ:25941;ASP无限分类数据库版"> </head> <body> <% Const IsSql = 0 "定义数据库类型,1为SQL Server,0为Access Function OpenConn(Conn) "打开数据库连接 Dim ConnStr If IsSql = 1 Then "如果是SQL Server数据库 "SQL Server数据库连接参数:用户名、用户密码、数据库名、连接名（本地用local，外地用IP） Dim SqlUsername,SqlPassword,SqlDatabaseName,SqlLocalName SqlUsername = "sa" SqlPassword = "" SqlDatabaseName = "TreeDb" SqlLocalName = "(local)" ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";" Else "如果是Access数据库 Dim Db "第一次使用请修改本处数据库地址并相应修改数据库名称，如将Dicky.mdb修改为Dicky.asp(防止恶意下载Access数据库) Db = "TreeDB.mdb" ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(Db) End If On Error Resume Next Set Conn = Server.CreateObject("ADODB.Connection") Conn.Open ConnStr If Err Then " Err.Clear Set Conn = Nothing Response.Write "数据库连接出错，请检查连接字串。" Response.End End If End Function Function CloseConn(Conn) "关闭数据库连接 If IsObject(Conn) Then Conn.Close Set Conn = Nothing End If End Function Function Echo(Str) "输出字符串并换行 Response.Write Str & VbCrlf End Function Call OpenConn(Conn) "定义第一级分类 Sub MainFl() Dim Rs Set Rs = Conn.Execute("Select ClassID,ClassName FROM Class Where ParentClassID IS NULL") If Not Rs.Eof Then Do While Not Rs.Eof Echo("<div><label id=""" & Trim(Rs("ClassID")) & """>+" & Trim(Rs("ClassName")) & "</label>") Call Subfl(Rs("ClassID"),"|-") "循环子级分类 Echo("</div>") Rs.MoveNext If Rs.Eof Then Exit Do "防上造成死循环 Loop End If Set Rs = Nothing End Sub "定义子级分类 Sub SubFl(FID,StrDis) Dim Rs1 Set Rs1 = Conn.Execute("Select ClassID,ClassName FROM Class Where ParentClassID = "" & FID & """) If Not Rs1.Eof Then Do While Not Rs1.Eof Echo(" <div id=""" & Trim(Rs1("ClassID")) & """>" & StrDis & Trim(Rs1("ClassName")) & "</div>") Call SubFl(Trim(Rs1("ClassID")),"| " & Strdis) "递归子级分类 Rs1.Movenext:Loop If Rs1.Eof Then Rs1.Close Exit Sub End If End If Set Rs1 = Nothing End Sub "最后直接调用MainFl()就行了 MainFl() Call CloseConn(Conn)%> </body> </html> |
方法二：
| 代码: |
| <%
"程序的核心是一个数组,显示的结果只是比较常见的两种情况,只读取了一次数据库 Dim LID,CID,TID,OID,Tmp,Url,Bof,Eof,i,ReadSQL,PgNum,PgSiz,Arr,reID,AllRs,LinkStr, ReadPgSiz,ReadPgNum,ReadAllFd,ReadAllPg,ReadAllRs,ReadRsNum Db = "test.mdb" ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(db) Set conn = Server.createObject("ADODB.Connection") conn.open ConnStr Set NET = New Class_NET Class Class_NET function Read(ReadSQL,PgNum,PgSiz) ReadSQL =(Replace(ReadSQL,""","")) ReadPgSiz=Int(PgSiz) ReadPgNum=Int(PgNum) Set ReadRs= Server.createObject("ADODB.Recordset") ReadRs.open ReadSQL,conn,1,1 ReadRs.PageSize =ReadPgSiz ReadAllFd =ReadRs.Fields.Count ReadAllPg =ReadRs.PageCount ReadAllRs =ReadRs.RecordCount ReadRsNum =ReadRs.Absoluteposition If int(ReadPgNum)>Int(ReadAllPg) or int(ReadPgNum)=0 Then ReadPgNum=1 ReadRs.absolutepage=ReadPgNum "返回实际的页面记录条数 If int(ReadPgNum)=Int(ReadAllPg) Then ReadPgSiz=ReadAllRs-ReadPgSiz*(ReadAllPg-1) "数组开始 reDim ReadRsArr(ReadAllFd-1,ReadPgSiz-1) For ReadArrRs = 0 to ReadPgSiz-1 If ReadRs.Eof Then Exit For For ReadArrFd = 0 to ReadAllFd-1 ReadRsArr(ReadArrFd,ReadArrRs)=ReadRs(ReadArrFd) Next ReadRs.MoveNext Next Read=ReadRsArr End function "===================================================== function ClassPath(Arr,reID,AllRs,Url,LinkStr) Tmp=Null reID=Int(reID) If reID=0 Then Exit function For i=0 to AllRs-1 If int(Arr(5,i))=int(reID) Then OID=Arr(0,i) LID=Arr(1,i) Exit For End If Next For i=i to 0 step -1 If Arr(1,i)<=LID Then Tmp=LinkStr&"<a href="&Url&Arr(5,i)&">"&Arr(6,i)&"</a>"&Tmp LID=LID-1 End If Next ClassPath=Tmp End function "===================================================== Sub SetBofEof(Arr,reID,AllRs) If reID=0 Then Bof=0 Eof=AllRs-1 Else For i=0 to AllRs-1 If Arr(5,i)=reID Then Bof=i For j=i+1 to AllRs-1 If Arr(1,j)<=Arr(1,i) Then Eof=j-1 Exit For End If If j=AllRs-1 Then Eof=AllRs-1 Next Exit For End If Next End If End Sub "===================================================== function ClassList(Arr,reID,AllRs,Url) Tmp=Null reID=Int(reID) Call Net.SetBofEof(Arr,reID,AllRs) "下边这两条实现不显示总分类的功能 If reID>0 Then Bof=Bof+1 For i=Bof to Eof For j=1 to Arr(1,i)-Arr(1,Bof) Tmp=Tmp&" " Next For k=i+1 to AllRs-1 If Int(Arr(2,k))=Int(Arr(2,i)) Then Tmp=Tmp&"┝" Exit For Else If k=AllRs-1 Then Tmp=Tmp&"┕" Exit For End If End If Next If i=AllRs-1 Then Tmp=Tmp&"┕" Tmp=Tmp&"<a href="&Url&Arr(5,i)&">"&Arr(6,i)&"</a><br>" Next ClassList=Tmp End function End Class Dim reClass reClass=request("Class") If reClass="" or Int(reClass)<1 Then reClass=0 Dim ClassArr ClassArr=NET.Read(" select * From Class where LID<20 order by OID",1,999) Dim ClassAllRs ClassAllRs=ReadAllRs %> <style type="text/css"> <!-- body,a,table,div,span,td,th,input,select{font-size:9pt;font-family:"dotuml";color:#000000;} body {background-color:#ffffff;scrollbar-base-color:#d0d0c8} a:hover{ color:#000000 ;} a:link,a:active,a:visited{text-decoration:none ;color:#ff4500} .btn {background-color: #d0d0c8; height: 21px; top: 1px; width: 21px; } --> </style> <% Response.Write "当前栏目的显示" Response.Write "<br>" Response.Write NET.ClassPath(ClassArr,reClass,ClassAllRs,"?Class=",">>>") Response.Write "<br>" Response.Write "栏目列表的显示" Response.Write "<br>" Response.Write NET.ClassList(ClassArr,reClass,ClassAllRs,"?class=") %> |
asp随机抽取记录
Submitted by on 2006, August 24, 9:26 AM
引子：
以前面试时，曾经有过这样的要求的。当时处理得不是很好，所以回来整理了一下。
方法一：
另一种方法：
随机提取10条记录的例子：
Sql server：
select top 10 * from 表 order by newid()
Access：
Select top 10 * FROM 表 orDER BY Rnd(id)
Rnd(id) 其中的id是自动编号字段，可以利用其他任何数值来完成
比如用姓名字段(UserName)
Select top 10 * FROM 表 orDER BY Rnd(len(UserName))
MySql：
Select * From 表 order By rand() Limit 10
表 TestTable，有自动编号字段 TestID，标题字段 TestTitle，随机取得5条纪录，用代码：
Randomize
Select TOP 5 [TestTitle] FROM [TestTable] orDER BY Rnd(-(TestID+"&Rnd()&"))
asp从access数据库中随机抽取记录
"随机抽取选择题
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open "Select id from [shiti] where type=1 order by Rnd(id)",conn,1,1
Count=rs.RecordCount
redim a(xzcount),t(Count)
for each j in t
j=0
next
" 随机抽取记录号
Randomize timer "初始化随机数生成器
for j=1 to xzcount
k=int(rnd*Count+1) "从总数里面随机取一条记录
do while t(k)<>0 "判断是否记录是否已经在数组中
k=int(rnd*xzcount+1)
loop
t(k)=1 "第k条记录被选中
next
j=1:i=1"定义下标
" 循环选取数据集rs中的部分记录存放到数组中
do while not rs.Eof
if t(j)=1 then
a(i)=rs("id") "记录id
i=i+1
end if
j=j+1
rs.MoveNext
Loop
rs.close
for i=1 to xzcount
rs.open "select * from [shiti] where id="&a(i)&"",conn,1,1
rnd(id)可以改变记录的顺序
更新个更简单的
Randomize
Set RS = Con.Execute("Select TOP 3 id FROM czfxx orDER BY rnd(-(id +" & rnd() & "))")
以前面试时，曾经有过这样的要求的。当时处理得不是很好，所以回来整理了一下。
方法一：
引用
数据库打开查询若干，省略... ...
Set rs = Server.CreateObject("Adodb.RecordSet")
rs.open sql,conn,1,1
DIM Appeared
Call DisRndRecord(10,rs.recordCount)"调用函数该位置显示记录
"################SUBS################
"#DisRndRecord(DisNum,rsBound)
"#参数DisNum：显示数量
"#参数rsBound：随机数产生范围
Sub DisRndRecord(DisNum,rsBound)
DIM i,ThisRnd
If rsBound < DisNum Then DisNum = rsBound"记录总数小于要抽取记录条数的情况
For i = 0 To DisNum - 1
ThisRnd = GetRnd(rsBound)"取得一个不重复的随机数
rs.Move(ThisRnd)"游标移动到随机数位置数读取
Response.Write("<br>("&rs("id")&")"&rs("Title"))
rs.Move(-ThisRnd)
Next
End Sub
"# 函数GetRnd(bound)返回一个不重复的随机数字
"#参数bound：随机范围
Function GetRnd(bound)
DIM ranNum
Randomize()
ranNum=int(bound*rnd)
If Instr(Appeared,"["&ranNum&"]") Then"产生的随机数是否出现过
ranNum = getRnd(bound)
End If
Appeared = Appeared & "["&ranNum&"]""记录已出现的随机数
GetRnd = ranNum
End Function
Set rs = Server.CreateObject("Adodb.RecordSet")
rs.open sql,conn,1,1
DIM Appeared
Call DisRndRecord(10,rs.recordCount)"调用函数该位置显示记录
"################SUBS################
"#DisRndRecord(DisNum,rsBound)
"#参数DisNum：显示数量
"#参数rsBound：随机数产生范围
Sub DisRndRecord(DisNum,rsBound)
DIM i,ThisRnd
If rsBound < DisNum Then DisNum = rsBound"记录总数小于要抽取记录条数的情况
For i = 0 To DisNum - 1
ThisRnd = GetRnd(rsBound)"取得一个不重复的随机数
rs.Move(ThisRnd)"游标移动到随机数位置数读取
Response.Write("<br>("&rs("id")&")"&rs("Title"))
rs.Move(-ThisRnd)
Next
End Sub
"# 函数GetRnd(bound)返回一个不重复的随机数字
"#参数bound：随机范围
Function GetRnd(bound)
DIM ranNum
Randomize()
ranNum=int(bound*rnd)
If Instr(Appeared,"["&ranNum&"]") Then"产生的随机数是否出现过
ranNum = getRnd(bound)
End If
Appeared = Appeared & "["&ranNum&"]""记录已出现的随机数
GetRnd = ranNum
End Function
另一种方法：
引用
另外一个更有用的函数：NewID（），它返回一个GUID（全局唯一标志符）。
Rand（）函数用在SQL语句中没有作用。可能只能用在SQL SERVER中。
//随机返回10条记录
select top 10
newid() as row, productid, productname
from Products
order by row
相关参考：
NEWID()另外一个应用是在Select出记录时随即选出N条记录
比如：Select top 5 * from yourtable order by newid()这样就能从yourtable表中每次随机地选出5条记录，这对于随机显示新闻的地方比较有用
Rand（）函数用在SQL语句中没有作用。可能只能用在SQL SERVER中。
//随机返回10条记录
select top 10
newid() as row, productid, productname
from Products
order by row
相关参考：
NEWID()另外一个应用是在Select出记录时随即选出N条记录
比如：Select top 5 * from yourtable order by newid()这样就能从yourtable表中每次随机地选出5条记录，这对于随机显示新闻的地方比较有用
引用
随机提取10条记录的例子：
Sql server：
select top 10 * from 表 order by newid()
Access：
Select top 10 * FROM 表 orDER BY Rnd(id)
Rnd(id) 其中的id是自动编号字段，可以利用其他任何数值来完成
比如用姓名字段(UserName)
Select top 10 * FROM 表 orDER BY Rnd(len(UserName))
MySql：
Select * From 表 order By rand() Limit 10
表 TestTable，有自动编号字段 TestID，标题字段 TestTitle，随机取得5条纪录，用代码：
Randomize
Select TOP 5 [TestTitle] FROM [TestTable] orDER BY Rnd(-(TestID+"&Rnd()&"))
引用
asp从access数据库中随机抽取记录
"随机抽取选择题
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open "Select id from [shiti] where type=1 order by Rnd(id)",conn,1,1
Count=rs.RecordCount
redim a(xzcount),t(Count)
for each j in t
j=0
next
" 随机抽取记录号
Randomize timer "初始化随机数生成器
for j=1 to xzcount
k=int(rnd*Count+1) "从总数里面随机取一条记录
do while t(k)<>0 "判断是否记录是否已经在数组中
k=int(rnd*xzcount+1)
loop
t(k)=1 "第k条记录被选中
next
j=1:i=1"定义下标
" 循环选取数据集rs中的部分记录存放到数组中
do while not rs.Eof
if t(j)=1 then
a(i)=rs("id") "记录id
i=i+1
end if
j=j+1
rs.MoveNext
Loop
rs.close
for i=1 to xzcount
rs.open "select * from [shiti] where id="&a(i)&"",conn,1,1
rnd(id)可以改变记录的顺序
更新个更简单的
| 代码: |
| Set Con= Server.CreateObject("ADODB.CONNECTION")
ConnString = "Provider=MicroSoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("myconnnnb.mdb") Con.Open ConnString Randomize Set RS = Con.Execute("Select TOP 3 id FROM czfxx orDER BY rnd(-(id +" & rnd() & "))") Do While Not RS.EOF Response.Write RS.Fields("id").Value & "<br />" RS.MoveNext Loop RS.Close Set RS = Nothing Con.Close Set Con = Nothing |
Randomize
Set RS = Con.Execute("Select TOP 3 id FROM czfxx orDER BY rnd(-(id +" & rnd() & "))")
无组件图片与文本同步存入数据库
Submitted by on 2006, August 23, 5:05 AM
一:前言
一种完全简单的手法。完成无组件的文本与图片上传数据库所有过程。希望能帮助所有对此有疑
问的网友。
二：准备工作
按照惯例，我先将我的测试环境告诉大家。
系统：Win98se + pws + asp
编程环境：Visual Interdev 6.0
数据库：Access2000 （因为网友问的最多的都是Access2000的问题。）
建一个库：access2000中，先建好一个Test.mdb的数据库。具体有四个字段。
id | text1 | text2 | img
自动编号 文本 文本 OLE对象 ’如果是sql server 则选择(image即可)
三：Are you ready ,Go!!!
3-1.建上传表单：
我们知道，图像与文本是两种不同制式的文件（二进制，流式文本）而如果要同一表单提交的话，(file格式提交)则
我们获取时就不能用原来的方法request.form而必须用equest.TotalBytes来获得所有的提交资料。但这时两种格式的文件
混合在一起比较难分。我的上一贴已经告诉大家用二进制的方法来分开这些资料。但十分麻烦，要用到许多二进值的函
数，所以许多网友来信问我有没有更简单的方法,好。我可以告诉大家，有！而且保证下面的方法保证一学就会。（这种方
法很另类但伟人说过白猫，黑猫。能上网的就是好猫！）
upload.asp(具体代码如下)
3-2 兵分两路来处理数据。
首先，文本很简单。
uptext.asp (代码如下)
接着，来处理图像。
upimage.asp (具体代码如下)
啊？！？！原来如此简单！
四：“显示，我要同页显示”
终于完成了图文同步提交。（真的是同步吗？不是吗？是吗？ 唉，我们只是为了解决问题。何必当真哪？不
是 吗？）
现在我们还要让他同页显示出来。其实，这是同样的思路。我们也用两页来完成。
主页面：show.asp
以下是你的上传资料。<br>
文本一：<% Response.Write rs("text1") %><br>
文本二：<% Response.Write rs("text2") %><br>
你的图像：
<img src=showimg.asp?id=<%=rs("id")%>> ’注意这里，这才是关键。他可以实现网页图像与文本
</body> ’共存。
</html>
幕后页面：showimg.asp （说他是幕后的页面，因为他潜伏在主页面里。看上是一个页面一样）
（全文完：希望本文能帮助那些急于想解决本类问题的网友。）
一种完全简单的手法。完成无组件的文本与图片上传数据库所有过程。希望能帮助所有对此有疑
问的网友。
二：准备工作
按照惯例，我先将我的测试环境告诉大家。
系统：Win98se + pws + asp
编程环境：Visual Interdev 6.0
数据库：Access2000 （因为网友问的最多的都是Access2000的问题。）
建一个库：access2000中，先建好一个Test.mdb的数据库。具体有四个字段。
id | text1 | text2 | img
自动编号 文本 文本 OLE对象 ’如果是sql server 则选择(image即可)
三：Are you ready ,Go!!!
3-1.建上传表单：
我们知道，图像与文本是两种不同制式的文件（二进制，流式文本）而如果要同一表单提交的话，(file格式提交)则
我们获取时就不能用原来的方法request.form而必须用equest.TotalBytes来获得所有的提交资料。但这时两种格式的文件
混合在一起比较难分。我的上一贴已经告诉大家用二进制的方法来分开这些资料。但十分麻烦，要用到许多二进值的函
数，所以许多网友来信问我有没有更简单的方法,好。我可以告诉大家，有！而且保证下面的方法保证一学就会。（这种方
法很另类但伟人说过白猫，黑猫。能上网的就是好猫！）
upload.asp(具体代码如下)
| 代码: |
| <% @ language=vbscript %>
<html> <head> <meta name="VI60_defaultClientScript" content="VBScript"> <title> File Upload </title> <script ID="clientEventHandlersVBS" LANGUAGE="vbscript"> <!-- Sub form2_onsubmit //** 这里是关键，当form2在提交的过程中时，即活form1的提交 form1.submit //**所以我们这里用了两个表单，但只用一个提交就可以了。 End Sub --> </script> </head> <body> <form name="form1" ENCTYPE="multipart/form-data" ACTION="upimage.asp" METHOD="POST" target="_blank"> Please choose a picture to upload: <br> <input NAME="picture" TYPE="FILE"> <br> </form> <form name="form2" action="uptext.asp" method="post"> <input type="text" name="text1"><br> <input type="text" name="text2"><br> <input type="submit" value="提交"> </form> </body> </html> |
3-2 兵分两路来处理数据。
首先，文本很简单。
uptext.asp (代码如下)
| 代码: |
| <% @ language=vbscript %>
<% strconn="driver={microsoft access driver (*.mdb)};dbq="&server.MapPath("test.mdb") text1=request.form("text1") text2=request.form("text2") response.write text1 response.write text2 set rs=Server.CreateObject("adodb.recordset") sql="Select top 1 * FROM imgtable orDER BY id DESC" ’这里的意思是选择最后一个Id,既刚刚被改动 rs.Open sql,strconn,1,3 ’就是你上传的图像的两个文本字段。 rs("text1")=text1 ’注意，这里是改动不是添加，所以不用addnew。 rs("text2")=text2 rs.Update rs.Close %> |
接着，来处理图像。
upimage.asp (具体代码如下)
| 代码: |
| <%
FormSize = Request.TotalBytes ’得到数据 FormData = Request.BinaryRead( FormSize ) function ImageUp(formsize,formdata) ’这个函数的功能是截取其中的图像部分。 bncrlf=chrb(13) & chrb(10) ’做成函数后。以后你可以自己随意使用了。 divider=leftb(formdata,instrb(formdata,bncrlf)-1) datastart=instrb(formdata,bncrlf&bncrlf)+4 dataend=instrb(datastart+1,formdata,divider)-datastart imageup=midb(formdata,datastart,dataend) end function Image=ImageUp (FormSize,Formdata) ’这里就是图像部分了。 set rs=server.CreateObject("adodb.recordset") strconn="driver={microsoft access driver (*.mdb)};dbq="&server.MapPath("test.mdb") sql="Select * FROM imgtable" rs.Open sql,strconn,1,3 rs.AddNew ’因为表单二在表单一提交的过程中下提交了。 rs("img").appendchunk Image ’所以这里是添加。 rs.Update rs.Close response.contenttype="image/gif" response.binarywrite imageup(formsize,formdata) ’这里是显示图像。表示成功！ %> |
啊？！？！原来如此简单！
四：“显示，我要同页显示”
终于完成了图文同步提交。（真的是同步吗？不是吗？是吗？ 唉，我们只是为了解决问题。何必当真哪？不
是 吗？）
现在我们还要让他同页显示出来。其实，这是同样的思路。我们也用两页来完成。
主页面：show.asp
| 代码: |
| <%@ Language=VBScript %>
<% strconn="driver={microsoft access driver (*.mdb)};dbq="&server.MapPath("test.mdb") set rs=Server.CreateObject("adodb.recordset") sql="Select top 1 * FROM imgtable orDER BY id DESC" rs.Open sql,strconn,1,3 %> <html> <body> |
文本一：<% Response.Write rs("text1") %><br>
文本二：<% Response.Write rs("text2") %><br>
你的图像：
<img src=showimg.asp?id=<%=rs("id")%>> ’注意这里，这才是关键。他可以实现网页图像与文本
</body> ’共存。
</html>
幕后页面：showimg.asp （说他是幕后的页面，因为他潜伏在主页面里。看上是一个页面一样）
| 代码: |
| <%@ Language=VBScript %>
<% strconn="driver={microsoft access driver (*.mdb)};dbq="&server.MapPath("test.mdb") id=Request("id") set rs=server.CreateObject("adodb.recordset") sql="Select * FROM imgtable where id="&id rs.Open sql,strconn,1,3 response.contenttype="image/gif" Response.BinaryWrite rs("img") %> |
（全文完：希望本文能帮助那些急于想解决本类问题的网友。）