 |
|
|
 首页 |
名片设计 CorelDRAW Illustrator AuotoCAD Painter 其他软件 Photoshop Fireworks Flash |
|
搜索引擎优化自然是首选，可是也不能放过邮件群发，虽然邮件群发被人所不齿， 不过，只要选定了群发的对象，少发点，应该没什么吧，：=――。 所以就找了一些相关主题的论坛，好多都是动网的论坛，现在就是需要把论坛用户的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=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 返回类别: 教程 上一教程: 用表单来提交SQL - 2 下一教程: 用ASP创建MICROSOFT WORD文件 您可以阅读与"抓取动网论坛EMAIL地址的一段代码"相关的教程: · 抓取动网论坛 EMAIL 地址的一段代码 · 在ASP中通过GETROWS实现数据库记录分页的一段代码 · 关于ACCESS数据库表改名的一段代码 · ASP中通过GETROWS实现数据库记录分页的一段代码 · 动网论坛上传文件漏洞的原理以及攻击的代码实现 |
  |
| 快精灵印艺坊 版权所有 |
首页 会员中心在线印刷在线编辑付款方式索取样品设计指南连锁门店
|
||
