和serverXMLHTTP相关的几个函数

程序代码 程序代码

'返回页面的内容,weburl为页面url
Function GetBytes(weburl)
  '创建对象
  Dim ObjXMLHTTP
  Set ObjXMLHTTP=Server.CreateObject("MSXML2.serverXMLHTTP")
  '请求文件,以异步形式
  ObjXMLHTTP.Open "GET",weburl,False
  ObjXMLHTTP.send
  While ObjXMLHTTP.readyState <> 4
    ObjXMLHTTP.waitForResponse 1000
  Wend
  '得到结果
  GetBytes=ObjXMLHTTP.responseBody
  '释放对象
  Set ObjXMLHTTP=Nothing
End Function

'把页面内容转化为某个编码的字符串
Function bytesTostr(bytes,setCode)
  dim objstream
  set objstream = Server.CreateObject("adodb.stream")
  objstream.Type = 1
  objstream.Mode =3
  objstream.Open
  objstream.Write bytes
  objstream.Position = 0
  objstream.Type = 2
  objstream.Charset = setCode
  bytesTostr = objstream.ReadText
  objstream.Close
  set objstream = nothing
End Function

'清除字符串中script标记
Function removeJs(StrCon)
  Dim reg
  set reg = New RegExp
  reg.Pattern = "<SCRIPT[\s\S.]*</SCRIPT>"
  reg.IgnoreCase = True
  reg.Global = True
  removeJs = reg.Replace(StrCon, "")
  set reg=nothing
End Function

'得到字符串某个标记间的内容
'bTag开始标记,eTag结束标记
function getTagStr(str,bTag,eTag)
  set regEx=new RegExp
  regEx.IgnoreCase=true
  regEx.Global=true
  regEx.pattern=bTag&"([\s\S.]*)"&eTag
  set Matchs=regEx.execute(str)
  'bodys=Matchs(0).SubMatches(0)
  for each match in Matchs
    getTagStr=getTagStr&match.SubMatches(0)
  next
  set regEx=nothing
end function

'过滤字符串中的html标记
Function RemoveHTML(str)
  Dim re
  Set re=New RegExp
  re.Pattern="<.*?>"
  re.IgnoreCase=True    
  re.Global=True
  str=re.Replace(str,"")
  Set re=Nothing
  RemoveHTML=str
End Function

'============================================================
'函数名:RemoveHTML
'作  用:清除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=strHTML  
    Set objRegExp = Nothing  
End function
'加亮页面字符中的第一个关键字keyWord,并截取关键字前后length个字符
Function subStr(str,keyWord,length)
  n=instr(str,keyWord)
  if n>length then
    subString=Mid(str,n-5,length)
  else
    subString=Mid(str,1,length)
  end if
  if Len(subString)<length then
    m=Len(str)-length
    if m<0 then m=1 end if
    subString=Mid(str,m,Len(str))
  end if
  subStr=replace(subString,keyWord,"<font color='#66CC00'>"&keyWord&"</font>")
End Function



[本日志由 亮亮 于 2008-11-01 08:12 PM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: serverXMLHTTP adodb.stream 清除html 清除script
评论: 1 | 引用: 0 | 查看次数: -
回复回复wodeweilailili[2008-11-20 11:32 AM | del]
谢谢您的源码 。我的邮箱:wodeweilailili@163.com
愿成朋友
发表评论
昵 称:
密 码: 游客发言不需要密码.
内 容:
验证码: 验证码
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.