当前位置: 首页 > 图文教程 > 网络编程 > ASP > 抓取动网论坛Email地址的一段代码

ASP
WEB打印设置解决方案四
截取固定长度字符串显示在页面
如何得到上一次插入记录后自动产生的ID
组件:Adodb.Stream 浅释
一个统计当前在线用户的解决方案
实例演练ASP+XML编程
IP地址分段计算
身份证验证代码函数
简单购物车教程
ASP分页函数
asp中对ip进行过滤限制函数
不用Golobal和session实现在线人数统计
ASP实现结构化列举并查看某路径下所有文件
常用Response对象的使用祥解
在ASP网站设计中表单验证
动网论坛代码分析
轻松实现将上传图片到数据库
读取数据库中数据到数组的类
网址和邮件地址的转换函数
ASP编码优化

ASP 中的 抓取动网论坛Email地址的一段代码


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 167 ::
收藏到网摘: n/a

 

 If i mod 100=0 then
  call WriteToFile(strFile,strA)
  strA = ""
 else
  if strRet<>"" then  strA = strA & strRet & vbCrLf
 end if
 
 Wscript.Echo i & vbTab & strRet

Next


Sub WriteToFile(strFile,str)
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile(strfile, 8, True)
   f.Write str
   set f= nothing
   set fso=nothing
End Sub


Function bytes2BSTR(vIn)
 Dim i
 strReturn = ""
 For i = 1 To LenB(vIn)
  ThisCharCode = AscB(MidB(vIn,i,1))
  If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
  Else
   NextCharCode = AscB(MidB(vIn,i+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   i = i + 1
  End If
 Next
 bytes2BSTR = strReturn
End Function


Function OpenUrl(strUrl)
 
 on Error Resume Next

   Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
 xmlhttp.open "GET",(strUrl ),false
    xmlhttp.send    
 OpenUrl=bytes2BSTR(xmlhttp.ResponseBody)
 
    Set xmlhttp = Nothing   
End Function  

Function getMid(str, str1, str2)
 Dim i
 Dim j
    str11 = ""
    i = InStr(str, str1)
    If i > 0 Then
        j = InStr(i, str, str2)
        If j > 0 Then
            str11 = Mid(str, i + Len(str1), j - i - Len(str1))       
        End If   
    End If   
    getMid = str11
End Function