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

ASP
如何编写适合FireFox的对话框?
关于处理GET方式提交的含有特殊字符的参数
对URL地址进行编码 优化2
在线管理数据库 类
用Asp备份与恢复SQL Server 数据库
计算两个时间之差的函数
asp实现sql的备份与恢复
SQL Server 存储过程的分页
sql 存储过程分页
邹建的分页存储过程改了一下
关于使用存储过程创建分页
SQL SERVER编写存储过程小工具
各种存储过程使用指南
SQL Server--怎样用ADO在SQL SERVER中建库,建表
几例在ASP存储过程的使用方法
用ASP+XML打造留言本
让 Asp 与 XML 交互
msxml3.dll 错误 ''800c0005''解决方案
MSXML4.0 版中的新增功能
关于ASP生成伪参数技巧

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


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