已结贴

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