已结贴
已结贴[此贴子已经被作者于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