当前位置: 首页 > 图文教程 > 网络编程 > ASP > 一些值得一看的代码asp

ASP
构建你的网站新闻自动发布系统之三
构建你的网站新闻自动发布系统之四
如何用ASP编写网站统计系统一
如何用ASP编写网站统计系统二
如何用ASP编写网站统计系统三
如何用ASP编写网站统计系统四
ASP Error 0115的一些解决办法
ASP 3.0 新特色先睹为快(一)
ASP 3.0 新特色先睹为快(二)
ASP主件中的安全问题
一个汉字转成拼音的代码
使用w3Sockets组件实现域名查询功能
ASP中实现文件上传方法的研究
构建免受FSO组件威胁虚拟主机
用XMLHTTP做一个自己特色的Google
用asp实现的代码批量修改程序
无组件的数据库的备份与还原
用ASPJPEG组件制作图片的缩略图和加水印
解密ASP源代码
XmlHttp异步获取网站数据的例子

ASP 中的 一些值得一看的代码asp


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-10-12   浏览: 174 ::
收藏到网摘: n/a

Asp中对ip进行过滤限制函数
<%
'获取访问者的地址
ip=Request.ServerVariables("REMOTE_ADDR")
'允许的IP地址段为10.0.0.0~10.68.63.255
allowip1="10.0.0.0"
allowip2="10.68.10.71"
response.write checkip(ip,allowip1,allowip2)
function checkip(ip,allowip1,allowip2)
dim check(4)
checkip=false
ipstr=split(ip,".")
allow1=split(allowip1,".")
allow2=split(allowip2,".")
if cint(allow1(0))>cint(allow2(0)) then
'判断IP地址段是否合法
response.write "IP地址段出错!"
exit function
end if
for i=0 to ubound(ipstr)
if cint(allow1(i))<cint(allow2(i)) then
if cint(allow1(i))=cint(ipstr(i)) then
check(i)=true
checkip=true
exit for
elseif cint(ipstr(i))<cint(allow2(i)) then
check(i)=true
checkip=true
exit for
elseif cint(ipstr(i))>cint(allow2(i)) then
check(i)=false
checkip=false
exit for
else
check(i)=true
checkip=true
end if
end if
end if
elseif cint(allow1(i))>cint(ipstr(i)) or cint(allow1(i))<cint(ipstr(i)) then
check(i)=false
checkip=false
if i<>ubound(ipstr) then
exit for
end if
else
check(i)=true
end if
end if
next
if (check(0)=true and check(1)=true and check(2)=true and check(3)=false) and (cint(allow2(2))>cint(ipstr(2))) then
checkip=true
end if
end function
%>

<%
'列举使用HTML表单提交的所有值
For Each item In Request.Form
Response.Write Request.Form(item)
Next
%>
列举使用HTML表单提交的所有值
利用ASP得到图片尺寸大小
<%
imgpath="/upload/tech/20091012/20091012011922_a8849b052492b5106526b2331e526138.gif"
set pp=new imgInfo
w = pp.imgW(server.mappath(imgpath))
h = pp.imgH(server.mappath(imgpath))
set pp=nothing
response.write "<img src='"&imgpath&"' border=0><br>宽:"&w&";高:"&h

Class imgInfo
dim aso
Private Sub Class_Initialize
set aso=CreateObject("Adodb.Stream")
aso.Mode=3
aso.Type=1
aso.Open
End Sub
Private Sub Class_Terminate
err.clear
set aso=nothing
End Sub
Private Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
clow=MidB(Bin,I,1)
if ASCB(clow)<128 then
Str = Str & Chr(ASCB(clow))
else
I=I+1
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
end if
Next
Bin2Str = Str
End Function
Private Function Num2Str(num,base,lens)
dim ret
ret = ""
while(num>=base)
ret = (num mod base) & ret
num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function
Private Function Str2Num(str,base)
dim ret
ret = 0
for i=1 to len(str)
ret = ret *base + cint(mid(str,i,1))
next
Str2Num=ret
End Function
Private Function BinVal(bin)
dim ret
ret = 0
for i = lenb(bin) to 1 step -1
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal=ret
End Function
Private Function BinVal2(bin)
dim ret
ret = 0
for i = 1 to lenb(bin)
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal2=ret
End Function
Private Function getImageSize(filespec)
dim ret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
select case hex(binVal(bFlag))
case "4E5089":
aso.read(15)
ret(0)="PNG"
ret(1)=BinVal2(aso.read(2))
aso.read(2)
ret(2)=BinVal2(aso.read(2))
case "464947":
aso.read(3)
ret(0)="GIF"
ret(1)=BinVal(aso.read(2))
ret(2)=BinVal(aso.read(2))
case "535746":
aso.read(5)
binData=aso.Read(1)
sConv=Num2Str(ascb(binData),2 ,8)
nBits=Str2Num(left(sConv,5),2)
sConv=mid(sConv,6)
while(len(sConv)<nBits*4)
binData=aso.Read(1)
sConv=sConv&Num2Str(ascb(binData),2 ,8)
wend
ret(0)="SWF"
ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
case "FFD8FF":
do
do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS
if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2)
do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS
loop while true
aso.Read(3)
ret(0)="JPG"
ret(2)=binval2(aso.Read(2))
ret(1)=binval2(aso.Read(2))
case else:
if left(Bin2Str(bFlag),2)="BM" then
aso.Read(15)
ret(0)="BMP"
ret(1)=binval(aso.Read(4))
ret(2)=binval(aso.Read(4))
else
ret(0)=""
end if
end select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getimagesize=ret
End Function
Public Function imgW(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
If (fso1.FileExists(pic_path)) Then
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
imgW = arr(1)
end select
Set f1=nothing
else
imgW = 0
End if
Set fso1=nothing
End Function
Public Function imgH(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
If (fso1.FileExists(pic_path)) Then
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
imgH = arr(2)
end select
Set f1=nothing
else
imgH = 0
End if
Set fso1=nothing
End Function
End Class
%>
客户端屏幕分辨率:Request.SERVERVARIABLES("HTTP_UA_PIXELS")
如何判断URL格式是否符合规范?
<% function checkisUrl(tmpString)
dim c,i checkisUrl = true tmpString=Lcase(trim(tmpString)) if left(tmpString,7)<>"http://" then tmpStri ... //"&tmpString for i = 8 to Len(checkisUrl) c = Lcase(Mid(tmpString, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-./\", c) <= 0 and not IsNumeric(c) then checkisUrl = false exit function end if next if Left(tmpString, 1) = "." or Right(tmpString, 1) = "." then checkisUrl = false exit function end if if InStr(tmpString, ".") <= 0 then checkisUrl = false response.Write "f3" exit function end if if InStr(checkisUrl, "..") > 0 then checkisUrl = false end if
end function%><%
if checkisUrl(request("u"))=true then %>恭喜,你的URL通过!<%else %>对不起,你的URL不合乎规范,请重新检查!<%end if%>

如何利用数据库内容建立一个下拉式列表?
<% myDSN="DSN=xur;uid=xur;pwd=xur"mySQL="select * from authors where AU_ID<100"set conntemp=server.createobject("adodb.connection")conntemp.open myDSNset rstemp=conntemp.execute(mySQL)if rstemp.eof thenresponse.write "噢,数据库为空!"response.write mySQLconntemp.closeset conntemp=nothingresponse.end  end if%><%do until rstemp.eof %><%rstemp.movenextlooprstemp.closeset rstemp=nothingconntemp.closeset conntemp=nothing' 清空对象%>
'获取用户真实IP函数
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function
'获取完整地址栏地址
Function GetUrl()
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
'获取本页文件名
Function SelfName()
SelfName = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
End Function
'获取文件后缀名
Function GetExt(filename)
GetExt = Mid(filename,InstrRev(filename,".")+1)
End Function
'求字符串长度函数
Function GetLength(str)
Dim i,length
For i = 1 to Len(str)
If Asc(Mid(str,i,1))<0 or Asc(Mid(str,i,1))>256 Then
length = length+2
Else
length = length+1
End If
Next
GetLength = length
End Function
'过滤不良字符
Function ChkBadWords(fString)
Dim BadWords,bwords,i
BadWords = "我操|操你|操他|你妈的|他妈的|狗|杂种|屄|屌|王八|强奸|做爱|处女|泽民|法轮|法伦|洪志|法輪"
If Not(IsNull(BadWords) or IsNull(fString)) Then
bwords = Split(BadWords, "|")
For i = 0 to UBound(bwords)
fString = Replace(fString, bwords(i), string(Len(bwords(i)),"*"))
Next
ChkBadWords = fString
End If
End Function
'防止外部提交
Function ChkPost()
Dim URL1,URL2
ChkPost = False
URL1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
URL2 = Cstr(Request.ServerVariables("SERVER_NAME"))
If Mid(URL1,8,Len(URL2))<>URL2 Then
ChkPost = False
Else
ChkPost = True
End If
End Function
'过滤HTML字符函数
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
fString = Replace(fString, "&", "&")
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(39), "'")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
fString = Replace(fString, Chr(10), "<BR>")
fString = Replace(fString, Chr(255), " ")
HTMLEncode = fString
End If
End Function
'清除HTML标记
Function stripHTML(strHTML)
Dim objRegExp,strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strOutput = objRegExp.Replace(strHTML,"")
strOutput = Replace(strOutput, "<","<")
strOutput = Replace(strOutput, ">",">")
stripHTML = strOutput
Set objRegExp = Nothing
End Function