我要投稿
  • 您当前的位置:57365.com -> 技术教程 -> 网站建设教程 -> 源码精华 -> 教程内容
  • [ 收藏本页教程 ]
  • 抓取动网论坛 Email 地址的一段代码源码精华教程

    教程作者:佚名    教程来源:不详   教程栏目:源码精华    收藏本页
    代码如下, 用记事本等文本编辑工具,保存成 dv.vbs
    在使用之前,需要你先到那个论坛,注册个用户然后登陆进去
    使用方法: c:\cscript dv.vbs 就可以了。
    '搜集的 email 地址的保存位置
    strFile = "d:\email.txt"
    srtUrl = "/jishu513556http://bbs.aaa.com"
    iStart = 1  '用户ID最小值
    iEnd = 1000  '用户ID最大值
    For i=iStart to iEnd


    strUrl1 = strUrl &
    "/dispuser.asp?id=" & cstr(i)
    strRet = OpenUrl(strurl1)

    strRet =
    getMid(strRet,"mailto:",">") '这个地方可能需要灵活做一些改变
    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 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

    (出处:

    我要投稿   -   广告合作   -   关于本站   -   友情连接   -   网站地图   -   联系我们   -   版权声明   -   设为首页   -   加入收藏   -   网站留言
    Copyright © 2009 - 20012 www.www.hxswjs.com All Rights Reserved.57365.com 版权所有