<%
on error resume next
'=========================================================
'函数：RemoveHTML(strHTML)
'功能：去除HTML标记
'参数：strHTML  --要去除HTML标记的字符串
'=========================================================
Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 

objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML) 

' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
	strHtml=Replace(strHTML,Match.Value,"")
Next 
	RemoveHTML=trim(strHTML)
Set objRegExp = Nothing 
set Matches=nothing
End Function 
'=========================================================
'函数：RemoveBlank(strHTML2)
'功能：去除空格
'参数：strHTML2  --要去除空格标记的字符串
'=========================================================
Function RemoveBlank(strHTML2) 
Dim objRegExp2, Match2, Matches2 
Set objRegExp2 = New Regexp 

objRegExp2.IgnoreCase = True 
objRegExp2.Global = True 
'取闭合的空格 
objRegExp2.Pattern = "\s" 
'进行匹配 
Set Matches2 = objRegExp2.Execute(strHTML2) 

' 遍历匹配集合，并替换掉匹配的项目 
For Each Match2 in Matches2 
	strHTML2=Replace(strHTML2,Match2.Value,"")
Next 
	RemoveBlank=strHTML2
Set objRegExp2 = Nothing 
set Matches2=nothing
End Function 

'=========================================================
'函数：GetLink(strHTML3)
'功能：获得字符串中的链接
'参数：strHTML3  --要获得链接的字符串
'=========================================================
Function GetLink(strHTML3) 
Dim objRegExp3, Match3, Matches3 ,temp3
Set objRegExp3=New Regexp 
GetLink=""
objRegExp3.IgnoreCase = True 
objRegExp3.Global = True 
'获得字符中的链接 
objRegExp3.Pattern ="href\s*=\s*.+?([^# ](\s|>))"
'进行匹配 
Set Matches3=objRegExp3.Execute(strHTML3) 

' 遍历匹配集合，并替换掉匹配的项目 
For Each Match3 in Matches3 
	temp3=trim(Match3.Value)
	temp3=replace(temp3,"href=","")
	temp3=replace(temp3,"""","")
	temp3=replace(temp3,"'","")
	temp3=replace(temp3,">","")
	GetLink=GetLink&temp3&"|"
Next 	
Set objRegExp3 = Nothing 
set Matches3=nothing
End Function 
'=========================================================
'函数：RemoveAdsCode(strHTML4)
'功能：去除空格
'参数：strHTML4  --要去除空格标记的字符串
'=========================================================
Function RemoveAdsCode(strHTML4) 
Dim objRegExp4, Match4, Matches4 
Set objRegExp4 = New Regexp 

objRegExp4.IgnoreCase = True 
objRegExp4.Global = True 
'取闭合的空格 
objRegExp4.Pattern = "<(iframe|script|object).+?(iframe|script|object)>" 
'进行匹配 
Set Matches4= objRegExp4.Execute(strHTML4) 

' 遍历匹配集合，并替换掉匹配的项目 
For Each Match4 in Matches4 
	strHTML4=Replace(strHTML4,Match4.Value,"")
Next 
	RemoveAdsCode=strHTML4
Set objRegExp4= Nothing 
set Matches4=nothing
End Function 
'========================================================================
'字符编码函数
'========================================================================
Function BytesToBstr(body,code) 
        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 =code
        BytesToBstr = objstream.ReadText  
        objstream.Close 
        set objstream = nothing 
End Function 

'取行字符串在另一字符串中的出现位置
Function Newstring(wstr,strng) 
        Newstring=Instr(lcase(wstr),lcase(strng)) 
        if Newstring<=0 then Newstring=Len(wstr) 
End Function 
'取字符串中一段字符串
Function SubStr(subs,fromstr,endstr)
	SubStr=subs
	fromInt=Newstring(SubStr,fromstr)+len(fromstr)
	SubStr=mid(SubStr,fromInt)
	endInt=Newstring(SubStr,endstr)
	SubStr=left(SubStr,endInt-1)	
End Function
'替换字符串函数
function ReplaceStr(ori,str1,str2)
ReplaceStr=replace(ori,str1,str2)
end function
'====================================================================
function ReadXml(url,code,start,ends)
dim tempHTMLStr
ReadXml=""
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false) 
oSend.send()
If oSend.Readystate<>4 then
     Set oSend=Nothing       
     Exit function
End if
tempHTMLStr=BytesToBstr(oSend.responseBody,code )
if(start<>"") then
	start=Newstring(tempHTMLStr,start)+len(start)
	tempHTMLStr=mid(tempHTMLStr,start)
else
	tempHTMLStr=mid(tempHTMLStr,1)
end if
if(ends<>"") then
	ends=Newstring(tempHTMLStr,ends)
	tempHTMLStr=left(tempHTMLStr,ends-1)
else
	'ReadXml=left(ReadXml,ends)
end if
Set oSend = nothing
ReadXml=tempHTMLStr
end function
'====================================================================
function ReadHtml(url,code)
set oSend=createobject("Microsoft.XMLHTTP")
SourceCode = oSend.open ("GET",url,false) 
oSend.send()
If oSend.Readystate<>4 then
     Set oSend=Nothing       
     Exit function
End if
ReadHtml=BytesToBstr(oSend.responseBody,code)
Set oSend = nothing
end function
'==================================================================
'提交登录
'==================================================================
Function PostHttpPage(loginUrl,loginActUrl,PostData) 
    Dim xmlHttp 
    Dim RetStr      
    Set xmlHttp = CreateObject("Microsoft.XMLHTTP")  
    xmlHttp.Open "POST", loginActUrl, False
    XmlHTTP.setRequestHeader "Content-Length",Len(PostData) 
    xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   ' xmlHttp.setRequestHeader "Referer", loginUrl
    xmlHttp.Send PostData 
    If Err.Number <> 0 Then 
        Set xmlHttp=Nothing
		response.Write("提交登录时出错！提交数据："&PostData)
        Exit Function
    End If
    PostHttpPage=BytesToBstr(xmlHttp.responseBody,"GB2312")
    Set xmlHttp = nothing
End Function
'==================================================
'函数名：GetBody
'作  用：截取字符串
'参  数：ConStr ------将要截取的字符串
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
      GetBody=""
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   If Start<=0 then
      GetBody=""
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody=""
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
   GetBody=MidB(ConStr,Start,Over-Start)
End Function

%>