迅雷VIP账号获取.VBS

主要是发个帖测试一下伟大的ChinaUnix的代码高亮

' 迅雷VIP账号获取        yurenchen 2011/4/12
'
' 从http://www.vi88.com/xlvip/ 采集的,不知道是不是真的
'----------------------------------------------------------------

Dim content,i,j,HTTP,Re
ReDim href(50),ID(50),PW(50)
Set HTTP=CreateObject("Msxml2.XMLHTTP")
Set Re=New RegExp

Sub getHref()
    URL = ""
    With HTTP
        .open "GET", URL, False : .setRequestHeader "If-Modified-Since","0" : .send : content= .responseText
    End With

    With Re
        .Global=True : .IgnoreCase=True
        .Pattern=""(\d+/\d+)"" title=""[^>]+发布共享迅雷VIP会员账号迅游"">"
        Set M1= .Execute(content)
    End With
    i=0
    For Each m In M1
        href(i)=m.subMatches(0) : i=i+1
    Next
End Sub

Sub getId(href)
    With HTTP
        .open "GET", href, False : .setRequestHeader "If-Modified-Since","0" : .send : content= .responseText
    End With

    With Re
        .Global=True : .IgnoreCase=True
        .Pattern="迅雷7VIP会员账号(\d+)密码""" target=_blank>([^<]+)"
        Set M2= .Execute(content)
    End With

    For Each m In M2
        id(j)=m.subMatches(0) : pw(j)=m.subMatches(1) : j=j+1
    Next
End Sub

getHref
j=0
For x=0 To i-1
    getId(href(x))
Next

Set FSO=CreateObject("Scripting.FileSystemObject")
Set WS=CreateObject("Wscript.Shell")
d=ws.SpecialFolders("desktop")
Set txt=fso.OpenTextFile(d & "\迅雷VIP.txt",2,1)
For x=0 To j-1
'    MsgBox ID(x) & vbCrLf & PW(x)
    txt.Write  ID(x) & vbTab & PW(x) & vbCrLf
Next

ws.Popup "结果已保存到桌面\迅雷vip.txt",1,"操作完毕",64