一些值得一看的代码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
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="default_22.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, ">", "&gt;")
fString = Replace(fString, "<", "&lt;")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), "  ")
fString = Replace(fString, Chr(34), """)
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>")
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, "<","&lt;")
strOutput = Replace(strOutput, ">","&gt;")
stripHTML = strOutput
Set objRegExp = Nothing
End Function