找回密码
 注册
【阿里云】2核2G云新老同享 99元/年,续费同价华为云精选云产品特惠做网站就用糖果主机Jtti,新加坡服务器,美国服务器,香港服务器
查看: 545|回复: 5

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

[复制链接]
发表于 2005 年 7 月 20 日 23:24:42 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?注册

×
  最近,一直想着怎么宣传我们的新网站,http://www.up114.com

搜索引擎优化自然是首选,可是也不能放过邮件群发,虽然邮件群发被人所不齿,

不过,只要选定了群发的对象,少发点,应该没什么吧,:=——。

所以就找了一些相关主题的论坛,好多都是动网的论坛,现在就是需要把论坛用户的Email地址

收集下来,网上也有卖专门的工具,不过今天我们就自己写个小工具,同样能够达到效果。

代码如下, 用记事本等文本编辑工具,保存成 dv.vbs

在使用之前,需要你先到那个论坛,注册个用户然后登陆进去

使用方法: c:\cscript dv.vbs 就可以了。
  1. '搜集的 email 地址的保存位置
  2. strFile = "d:\email.txt"
  3. srtUrl = "[url]http://bbs.aaa.com[/url]"
  4. iStart = 1 '用户ID最小值
  5. iEnd = 1000 '用户ID最大值
  6. For i=iStart to iEnd
  7. strUrl1 = strUrl & "/dispuser.asp?id=" & cstr(i)
  8. strRet = OpenUrl(strurl1)
  9. strRet = getMid(strRet,"mailto:",">") '这个地方可能需要灵活做一些改变
  10. If i mod 100=0 then
  11. call WriteToFile(strFile,strA)
  12. strA = ""
  13. else
  14. if strRet<>"" then strA = strA & strRet & vbCrLf
  15. end if
  16. Wscript.Echo i & vbTab & strRet
  17. Next
  18. Sub WriteToFile(strFile,str)
  19. Dim fso, f
  20. Set fso = CreateObject("Scripting.FileSystemObject")
  21. Set f = fso.OpenTextFile(strfile, 8, True)
  22. f.Write str
  23. set f= nothing
  24. set fso=nothing
  25. End Sub
  26. Function bytes2BSTR(vIn)
  27. Dim i
  28. strReturn = ""
  29. For i = 1 To LenB(vIn)
  30. ThisCharCode = AscB(MidB(vIn,i,1))
  31. If ThisCharCode < &H80 Then
  32. strReturn = strReturn & Chr(ThisCharCode)
  33. Else
  34. NextCharCode = AscB(MidB(vIn,i+1,1))
  35. strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
  36. i = i + 1
  37. End If
  38. Next
  39. bytes2BSTR = strReturn
  40. End Function
  41. Function OpenUrl(strUrl)
  42. on Error Resume Next
  43. Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
  44. xmlhttp.open "GET",(strUrl ),false
  45. xmlhttp.send
  46. OpenUrl=bytes2BSTR(xmlhttp.ResponseBody)
  47. Set xmlhttp = Nothing
  48. End Function
  49. Function getMid(str, str1, str2)
  50. Dim i
  51. Dim j
  52. str11 = ""
  53. i = InStr(str, str1)
  54. If i > 0 Then
  55. j = InStr(i, str, str2)
  56. If j > 0 Then
  57. str11 = Mid(str, i + Len(str1), j - i - Len(str1))
  58. End If
  59. End If
  60. getMid = str11
  61. End Function
复制代码
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
发表于 2005 年 7 月 24 日 12:16:27 | 显示全部楼层
【腾讯云】2核2G云服务器新老同享 99元/年,续费同价
大家小心自己的E-mail。
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
回复

使用道具 举报

发表于 2005 年 7 月 24 日 23:39:35 | 显示全部楼层
不懂怎么使用
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
回复

使用道具 举报

发表于 2005 年 8 月 1 日 17:12:55 | 显示全部楼层
看懂了十个好方法可以做宣传了
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
回复

使用道具 举报

发表于 2005 年 8 月 3 日 21:52:03 | 显示全部楼层
好东西
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
回复

使用道具 举报

发表于 2005 年 8 月 3 日 23:27:31 | 显示全部楼层
我也不懂  懂了先盗你的
Jgwy.Com - Free Web Hosting Guide & Directory In China since 2001! Jgwy.Net-Jglt.Net
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|金光论坛

GMT+8, 2024 年 11 月 19 日 23:28 , Processed in 0.020197 second(s), 20 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表