asp小偷函数

ASP/Visual Basic代码

'==================================================
'函数名：GetHttpPage 自动获取编码类型
'作用：获取网页源码
'参数：HttpUrl ——网页地址
'==================================================
Function getHTTPPage(HttpUrl)
If IsNull(HttpUrl)=True Then
response.Write("请输入网址！")
Exit Function
End If
On Error Resume Next
const TimeInterval=3 '设定时间间隔
const lResolve=5 '解析域名超时时间,秒
const lConnect=5 '连接站点超时时间,秒
const lSend=5 '发送数据请求超时时间,秒
const lReceive=15 '下载数据超时时间,秒
Dim Http
Set Http=server.createobject("MSX""ML2.XML""HTTP")
http.setTimeouts lResolve*1000,lConnect*1000,lSend*1000,lReceive*1000
Http.open "GET",HttpUrl,False
http.setRequestHeader "User-Agent","Mozilla/4.0 (compatible; MSIE 5.00; Windows 98)"
http.setRequestHeader "Pragma","no-cache"
http.setRequestHeader "Cache-Control","no-cache"
http.setRequestHeader "Connection","close"
On Error Resume Next
Http.Send()
Select Case http.readyState
Case 0
GetHttpPage="初始化失败"
Err.Clear
set http=nothing
Exit Function
Case 1
GetHttpPage="连接站点超时"
Err.Clear
set http=nothing
Exit Function
Case 2
GetHttpPage="服务器故障"
Err.Clear
set http=nothing
Exit Function
Case 3
GetHttpPage="数据下载超时"
Err.Clear
set http=nothing
Exit Function
Case 4
'下载成功
End Select
If http.status<>200 then
GetHttpPage="下载失败"&http.status""
Err.Clear
set http=nothing
Exit Function
END IF
if InStr(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")=0 then
GetHTTPPage=bytesToBSTR(Http.responseBody,"gb2312")
set http=nothing
else
if left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),6)="gb2312" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),6)="GB2312" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
elseif left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),3)="gbk" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),3)="GBK" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"GBK")
elseif left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),5)="utf-8" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),5)="UTF-8" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"UTF-8")
else
GetHTTPPage=bytesToBSTR(Http.responseBody,"gb2312")
end if
set http=nothing
end if
End Function

ASP/Visual Basic代码

'==================================================
'函数名：BytesToBstr
'作用：将获取的源码转换为中文
'参数：Body ——要转换的变量
'参数：Cset ——要转换的类型
'==================================================
Function BytesToBstr(Body,Cset)
Dim Objstream
Set Objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

ASP/Visual Basic代码

'==================================================
'函数名：getNum(str)
'作用：获取数字
'==================================================
function getNum(str)
dim re
set re=new RegExp
re.pattern="\D"
re.global=true
getNum = re.replace(str, "")
end function

ASP/Visual Basic代码

Function GetContent(str,start,last,n)
If Instr(lcase(str),lcase(start))>0 and Instr(lcase(str),lcase(last))>0 then
select case n
case 0 '左右都截取（都取前面）（去处关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
case 1 '左右都截取（都取前面）（保留关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
case 2 '只往右截取（取前面的）（去除关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
case 3 '只往右截取（取前面的）（包含关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
case 4 '只往左截取（取后面的）（包含关键字）
GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
case 5 '只往左截取（取后面的）（去除关键字）
GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
case 6 '只往左截取（取前面的）（包含关键字）
GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
case 7 '只往右截取（取后面的）（包含关键字）
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
case 8 '只往左截取（取前面的）（去除关键字）
GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
case 9 '只往右截取（取后面的）（包含关键字）
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
end select
Else
GetContent=""
End if
End function

相关推荐

近期文章

其他操作