asp中获取指定区域内容代码

 
 
 

<%
 '================================================
 '函数名：findmatch
 '作  用：截取相匹配的内容
 '返回值：截取后的字符串
 '================================================
 public function findmatch(byval str, byval start, byval last)
  dim match
  dim s
  dim filterstr
  dim matchstr
  dim strcontent
  dim arrayfilter()
  dim i, n
  dim brepeat
  
  if len(start) = 0 or len(last) = 0 then exit function
  
  on error resume next
  
  matchstr = "(" & correctpattern(start) & ")(.+?)(" & correctpattern(last) & ")"
  
  dim re
  set re = new regexp
  re.ignorecase = true
  re.global = true
  re.pattern = matchstr
  set s = re.execute(str)
  n = 0
  for each match in s
   if n = 0 then
    n = n + 1
    redim arrayfilter(n)
    arrayfilter(n) = match
   else
    brepeat = false
    for i = 0 to ubound(arrayfilter)
     if ucase(match) = ucase(arrayfilter(i)) then
      brepeat = true
      exit for
     end if
    next
    if brepeat = false then
     n = n + 1
     redim preserve arrayfilter(n)
     arrayfilter(n) = match
    end if
   end if
  next
  
  set s = nothing
  set re = nothing
  
  strcontent = join(arrayfilter, "|||")
  strcontent = replace(strcontent, start, "")
  strcontent = replace(strcontent, last, "")
  
  findmatch = replace(strcontent, "|||", vbnullstring, 1, 1)
  exit function
 end function
 
 
 private function correctpattern(byval str)
  str = replace(str, "", "")
  str = replace(str, "~", "~")
  str = replace(str, "!", "!")
  str = replace(str, "@", "@")
  str = replace(str, "#", "#")
  str = replace(str, "%", "%")
  str = replace(str, "^", "^")
  str = replace(str, "&", "&")
  str = replace(str, "*", "*")
  str = replace(str, "(", "(")
  str = replace(str, ")", ")")
  str = replace(str, "-", "-")
  str = replace(str, "+", "+")
  str = replace(str, "[", "[")
  str = replace(str, "]", "]")
  str = replace(str, "<", "<")
  str = replace(str, ">", ">")
  str = replace(str, ".", ".")
  str = replace(str, "/", "/")
  str = replace(str, "?", "?")
  str = replace(str, "=", "=")
  str = replace(str, "|", "|")
  str = replace(str, "$", "$")
  correctpattern = str
 end function
 
 '================================================
 '函数名：gethttppage
 '作  用：获取http页
 '参  数：url   ----远程url
 '返回值：远程html代码
 '================================================
 public function getremotedata(byval url)
  cset = "gb2312"
  dim strheader
  dim l
  
  on error resume next
  
  dim retrieval
  dim objstream
  set objstream = createobject("adodb.stream")
  objstream.type = 1
  objstream.mode = 3
  objstream.open
  set retrieval = createobject("msxml2.xmlhttp")
  with retrieval
   .open "get", url, false
   .setrequestheader "referer", url
   .send
   if .readystate <> 4 then exit function
   if .status > 300 then exit function
   '--获取目标网站文件头
   strheader = .getresponseheader("content-type")
   strheader = ucase(strheader)
   objstream.write (.responsebody)
  end with
  set retrieval = nothing
  
  if len(strheader) > 0 then
   '--获取目标文件编码
   l = instrrev(strheader, "charset=", -1, 1)
   if l > 0 then
    cset = right(strheader, len(strheader) - l - 7)
   else
    cset = cset
   end if
  end if

  objstream.position = 0
  objstream.type = 2
  objstream.charset = trim(cset)
  getremotedata = objstream.readtext
  objstream.close
  set objstream = nothing
  exit function
 end function
%> 
<%
 fromurl = "http://www.111com.net"

 aa = trim(request.form("aa"))
 bb = trim(request.form("bb"))
 if aa<>"" and bb<>"" then response.write findmatch(getremotedata(fromurl),aa,bb)
%>