注册
登录
| 关键词： nbsp strRet Email 论坛 strFile 用户 地址 工具 strA then |
抓取动网论坛 Email 地址的一段代码 /** 作者： 慈勤强 Email : [email protected] http://blog.csdn.net/cqq **/ 最近，一直想着怎么宣传我们的新网站，http://www.up114.com 。 搜索引擎优化自然是首选，可是也不能放过邮件群发，虽然邮件群发被人所不齿， 不过，只要选定了群发的对象，少发点，应该没什么吧，：=——。 所以就找了一些相关主题的论坛，好多都是动网的论坛，现在就是需要把论坛用户的Email地址 收集下来，网上也有卖专门的工具，不过今天我们就自己写个小工具，同样能够达到效果。 代码如下， 用记事本等文本编辑工具，保存成 dv.vbs 在使用之前，需要你先到那个论坛，注册个用户然后登陆进去 使用方法： c:\cscript dv.vbs 就可以了。 '搜集的 email 地址的保存位置 strFile = d:\email.txt srtUrl = http://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=nothingEnd 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 = strReturnEnd 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 = str11End Function |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
