一些值得一看的代码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, ">", ">") 
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