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

ASP
ASP设计常见问题及解答精要-1
ASP设计常见问题及解答精要-2
ASP设计常见问题及解答精要-3
ASP设计常见问题及解答精要-4
asp学习入门经验谈
如何才能成为一名真正的Web程序员
手把手教你在ASP中使用SQL语句
ASP与数据库应用(给初学者)
亲密接触ASP.Net(1)
亲密接触ASP.Net(2)
亲密接触ASP.Net(3)
亲密接触ASP.Net(4)
亲密接触ASP.Net(5)
.Net边学边讲(一)
.Net边学边讲(二)
.Net边学边讲(三)
NET移植案例学习:建造Web站点(1)
NET移植案例学习:建造Web站点(2)
ASP 3.0高级编程(四十)
深入研究Application和Session对象(1)

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 55 ::
收藏到网摘: 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