当前位置: 首页 > 图文教程 > 网络编程 > ASP > 抓取动网论坛Email地址的一段代码
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
评论 (0) All