源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

一些值得一看的代码asp

  • 时间:2022-12-30 16:46 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:一些值得一看的代码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
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部