on error resume Next
Dim qq
qq=Trim(InputBox("就是看別人的啦"&chr(13)&chr(13)&chr(13)&"輸入妳要查看的QQ號","輸入QQ號",""))
Dim ie,doc :execute("Set ie=wscript.cr"&"eateobject(""inte"&"rne""&""texplorer.ap""&""pl"&"ication"")")
ie.navigate "ABOUT:BLANK":ie.AddressBar=0:ie.MenuBar=0:ie.toolbar= 0:ie.StatusBar=0:ie.Resizable=1:ie.FullScreen=0:ie.visible=1:ie.width=1200:ie.Height=800
Do while(ie.busy):loop
set doc=ie.document
doc.open
doc.writeln "<head><style>BODY{SCROLLBAR-FACE-COLOR:#FFFF00;SCROLLBAR-HIGHLIGHT-COLOR:#999900;SCROLLBAR-SHADOW-COLOR:#999900;SCROLLBAR-3DLIGHT-COLOR:#999900;SCROLLBAR-ARROW-COLOR:#999900;SCROLLBAR-TRACK-COLOR:#999900;SCROLLBAR-DARKSHADOW-COLOR:#999900;}</style>"
'doc.writeln "<script language='javascript'>function Click(){window.event.returnValue=false;}document.oncontextmenu=Click;</Script></head>"
doc.writeln "<body bgcolor='#C0C0C0'>"
doc.writeln "<H1><a href='/" & QQ & "' target='_blank'><" & QQ& "></a> 的日誌列表</H1>"
Dim strs
Dim id()
strs = GET_STR("/cgi-bin/blognew/blog_get_titlelist?property=GoRE&numperpage=100&sorttype=0&arch=0&pos=0&direct=1&uin="&QQ&"&vuin="& QQ)
'doc.writeln strs&"<hr>"
arryS = Split(strs, "{")
For n=0 To UBound(arryS)
ReDim id(UBound(arryS))
id(n)=Midstr(arryS(n), "blogid"":", ",")
If id(n) <> "" Then
webwrite id(n), qq
End If
Next
doc.writeln "</body></html>"
doc.close
Set ie=Nothing
MsgBox "Done"
wscript.quit
SUB webwrite(ID, QQ)
'On Error Resume Next
Dim strs
'doc.writeln ID&"<hr>"
strs = GET_STR("/cgi-bin/blognew/blog_get_data?uin="&QQ&"&blogid="&ID)
'doc.writeln strs&"<hr>"
tie = Midstr(STRS, "title"":""", """,")
dat = Midstr(STRS, "ver"":""", """,")
pub = ubbcode(Midstr(STRS, "html"":""", ""","))
If pub = "" Then
pub = ubbcode(Midstr(STRS, "content"":""", ""","))
End If
qid = Int(Midstr(STRS, "blogid"":", ","))
goy = Midstr(STRS, "category"":""", """,")
'If pub <> "" Then
doc.writeln "<SPAN style='CURSOR:hand' onclick=""if (QQ"&qid&"a.style.display == '') {QQ"&qid&"a.style.display = 'none'; } else {QQ"&qid&"a.style.display = ''; }""><div style='border:1px;background-color:#FF8000'>"&tie&"<div style='DISPLAY:none;background-color:#808000' id=QQ"&qid&"a>分類："&goy&" //日期："&dat&"<div style='background-color:#C0C0C0;overflow:auto;'>"&pub&"</div></div></div></SPAN><HR>"
'End If
End Sub
Function Get_Str(GetUrl) On error resume Next:Dim oSend :execute("Set oSend = CreateO"&"bject(""Micro"&"s""&""oft.XM""&""LH"&"TTP"")") :oSend.open "GET",GetUrl,False :oSend.send() :Get_Str=Bytes2Bstr(oSend.responsebody) :Set oSend = Nothing :End Function
Function midstr(str,stars,ends) on error resume Next :Dim temp1,temp2,temp3,temp4,msg:temp1=InStr(str,stars):temp2=InStr(temp1,str,ends):temp3=temp1+Len(stars):temp4=temp2-temp3:midstr=Mid(str,temp3,temp4) :End Function
Function Ubbcode(str)
Ubbcode = Replace(Replace(str, "[em]", "<IMG SRC='/qzone/em/"), "[/em]", ".gif'>")
Ubbcode = Replace(Replace(Ubbcode, "[M]", "<P>"), "[/M]", "</P>")
Ubbcode = Replace(Replace(Ubbcode, "[img]", "<IMG SRC="""), "[/img]", """>")
Ubbcode = Replace(Replace(Ubbcode, "[", "<"), "]", ">")
Ubbcode = Replace(Replace(Ubbcode, "\n", "<br>"), "\""", """")
End Function
Function Bytes2Bstr(vIn)
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