已结贴
已结贴[此贴子已经被作者于2017-1-15 05:27编辑过]
程序代码:Const sUrl = "http://b.qzone.", QQ = "228415425" 'qq号可根据需要更换
Dim Title As String
Private Sub Form_Load()
Dim a As String, i As Integer, j As Integer
a = sUrl & "blog_get_titlelist?uin=" & QQ & "&numperpage=100"
Title = Inet1.OpenURL(a) '获取日志标题数据
i = InStr(Title, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
While i > 0
i = i + 9
j = InStr(i, Title, Chr(34) & "},")
If j > i Then
List1.AddItem Mid(Title, i, j - i) '显示日志标题
i = InStr(j, Title, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
Else
i = 0
End If
Wend
End Sub
Private Sub List1_Click()
Dim a As String, i As Integer, j As Integer, k As Integer, l As Integer, id As String, t As String
Text1 = ""
i = InStr(Title, "blogid" & Chr(34) & ":")
While i > 0
i = i + 8
j = InStr(i, Title, ",")
If j > i Then
id = Mid(Title, i, j - i) '获取id
k = InStr(j, Title, "title" & Chr(34) & ":" & Chr(34))
k = k + 8
l = InStr(i, Title, Chr(34) & "},")
a = Mid(Title, k, l - k) '获取标题
If a = List1 Then
a = sUrl & "blog_output_data?bdm=b.qzone." & id & "&uin=" & QQ
Text1 = Inet1.OpenURL(a)
Exit Sub
End If
Else
i = 0
End If
i = InStr(j, Title, "blogid" & Chr(34) & ":")
Wend
End Sub
程序代码:Const sUrl = "http://b.qzone."
Dim Title As String, QQ As String
Private Sub Command1_Click()
'显示日志列表
Dim a As String, i As Integer, j As Integer
If Not IsNumeric(Text1) Then Exit Sub '如果qq号码不是全数字则不执行
QQ = Trim(Text1)
List1.Clear
a = sUrl & "blog_get_titlelist?uin=" & QQ & "&numperpage=100"
Title = Inet1.OpenURL(a) '获取日志标题数据
i = InStr(Title, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
While i > 0
i = i + 9
j = InStr(i, Title, Chr(34) & "},")
If j > i Then
List1.AddItem Mid(Title, i, j - i) '显示日志标题
i = InStr(j, Title, Chr(34) & "title" & Chr(34) & ":" & Chr(34))
Else
i = 0
End If
Wend
Text1.SetFocus
End Sub
Private Sub Form_Load()
On Error Resume Next
Command1_Click '显示默认空间日志列表
End Sub
Private Sub List1_Click()
'显示选择的日志内容
Dim a As String, i As Integer, j As Integer, k As Integer, id As String
i = InStr(Title, "blogid" & Chr(34) & ":")
k = 0
While i > 0
i = i + 8
If k = List1.ListIndex Then
j = InStr(i, Title, ",")
id = Mid(Title, i, j - i) '获取选择的日志id
a = sUrl & "blog_output_data?bdm=b.qzone." & id & "&uin=" & QQ '拼接该日志实际网址
WebBrowser1.Silent = True
WebBrowser1.Navigate a '显示该网址内容,如果只想显示文章内容,不想显示该qq空间其他内容
Exit Sub '则需要做去<scrip>和所有css执行语句
End If
k = k + 1
i = InStr(i, Title, "blogid" & Chr(34) & ":")
Wend
WebBrowser1.SetFocus '让浏览器获得焦点符合操作习惯
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1) '获得焦点时字符全选择,方便输入新号码
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8 Then Exit Sub '只接受数字输入
If KeyAscii = 13 Then SendKeys "{tab}" '如输入回车键则转移焦点
KeyAscii = 0 '取消讨厌的叮声或禁止其他键输入
End Sub