【下载文档:  一些值得一看的代码asp.txt 】

---

一些值得一看的代码asp
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 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))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="default_22.gif" set pp=new imgInfo w = pp.imgW(server.mappath(imgpath)) h = pp.imgH(server.mappath(imgpath)) set pp=nothing response.write "
宽:"&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)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), "

") fString = Replace(fString, Chr(10), "
") 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