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

ASP
查询翻页优化
强制刷新和判断文件地址
asp缓存类
Byval与Byref的区别
全面认识ASP注入技巧
ubbcode函数
newasp中下载类
[ASP]精华代码
由给定的字符串生成关键字
经验几则
转换中文为unicode 转换unicode到正常文本
在ASP应用程序中限制重复提交同一表单
ASP 程序实现自动升级功能
在ASP编程中使用数组
asp组件编写准备工作
利用AdoDb.Stream对象来读取UTF-8格式的文本文件
把字符串转换成数据库SQL语句格式
access中链接表的问题
access数据库的一些少用操作,ASP,创建数据库文件,创建表,创建字段,ADOX
Asp Access 创建静态文件/HTML

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


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