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

作者:袖梨 2022-06-30






'================================================
'函数名: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 = "https://www.111cn.net"

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

相关文章

精彩推荐