蝙蝠岛资源网 Design By www.hbtsch.com
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
标签:
一些值得一看的代码

蝙蝠岛资源网 Design By www.hbtsch.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
蝙蝠岛资源网 Design By www.hbtsch.com

评论“一些值得一看的代码asp”

暂无一些值得一看的代码asp的评论...

稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!

昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。

这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。

而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?