用VB读取QQ空间信息

近期访客

心情

上面那张发错了... 
心情

档案
这个用picturebox显示动态QQ秀

强！

核心代码公开在我的QQ空间里，希望对大家有用
http://user.qzone.qq.com/369029696?ptlang=2052

好玩意，顶楼主了
能发一份给偶吗
[email protected]
顶
顶
顶

我现在只能用手机上网,不能给你发源码了,不好意思!

什么时候有时间，就什么时候发吧，谢谢

我还是把源码贴过来吧
核心代码：
 '---------------------------------------查看档案----------------------------------------------
 function qqinfo(qq)
  on error resume next
  Set Doc = CreateObject("Microsoft.XMLDOM") 
  Doc.async = False 
  Doc.load("http://users.cnc.qzone.qq.com/fcg-bin/cgi_access_self.fcg?uin=" & qq & chr(38) & "type=3") 
  Set root = Doc.documentElement 
  blo=split("A,B,AB,其它",",")
   msg= msg & vbcrlf & "QQ ： " & root.selectSingleNode("uin").text
   msg= msg & vbcrlf & "昵称： " & root.selectSingleNode("nickname").text
   msg= msg & vbcrlf & "生日： " & root.selectSingleNode("birthday").text
   msg= msg & vbcrlf & "血型： " & blo(root.selectSingleNode("bloodtype").text-1)
   msg= msg & vbcrlf & "居住： " & root.selectSingleNode("province").text & root.selectSingleNode("city").text
   msg= msg & vbcrlf & "职业： " & root.selectSingleNode("career").text
   msg= msg & vbcrlf & "空间： " & root.selectSingleNode("spacename").text
   msg= msg & vbcrlf & "爱好： " & root.selectSingleNode("interest").text
  uininfo=msg:msg=""
  msgbox uininfo,0+48,"用户信息"
end function
'--------------------------------------------------------------------------------------------------
'---------------------------------------查看日志----------------------------------------------
function rizhi(qq)
  on error resume next
  Set Doc = CreateObject("Microsoft.XMLDOM")
  Doc.async = False
  Doc.Load ("http://feeds.qzone.qq.com/cgi-bin/cgi_rss_out?uin=" & qq )
  Set root = Doc.documentElement
  Set node = root.childNodes.nextNode()
  For nodei = 0 To node.childNodes.Length - 1


  Set NowNode = node.childNodes(nodei)
    if nownode.nodeName="item" then 
      msg = msg & vbCrLf & "  标题:" & NowNode.selectSingleNode("title").Text 
      msg = msg & vbcrlf & "  日期:" & NowNode.selectSingleNode("pubDate").Text 
      msg = msg & vbcrlf & "  分类:" & NowNode.selectSingleNode("category").Text 
      msg = msg & vbcrlf & "  链接:" & NowNode.selectSingleNode("link").Text
      'msg = msg & vbcrlf & "  概要:" & NowNode.selectSingleNode("description").Text
      msg = msg & vbcrlf 
    end if
  Next
  rizhiinfo=msg: msg=""
  msgbox rizhiinfo,0+48,"日志信息"
end function
'--------------------------------------------------------------------------------------------------
'---------------------------------------查看签名----------------------------------------------
function qianmin(qq)
  on error resume next
  Set Doc = CreateObject("Microsoft.XMLDOM")
  Doc.async = False
  Doc.Load ("http://e.cnc.qzone.qq.com/cgi-bin/cgi_emotion_indexlist.cgi?uin=" & qq & chr(38) & "emotionarchive=-1")
  Set root = Doc.documentElement
  Set node = root.childNodes.nextNode()
  For nodei = 0 To node.childNodes.Length - 1
  Set NowNode = node.childNodes(nodei)
    if nownode.nodeName="item" then 
      msg = msg & vbCrLf & "  标题:" & NowNode.selectSingleNode("title").Text 
      msg = msg & vbcrlf & "  日期:" & NowNode.selectSingleNode("pubDate").Text
      msg = msg & vbcrlf 
    end if
  next
  qianmininfo=msg:msg=""
  msgbox qianmininfo,0+48,"签名信息"
end function
'--------------------------------------------------------------------------------------------------
'-----------------------------------查看访客和好友-----------------------------------------
function hudong(qq)
  on error resume next
  Set Doc = CreateObject("Microsoft.XMLDOM")
  Doc.async = False
  Doc.Load ("http://users.cnc.qzone.qq.com/fcg-bin/cgi_access_self.fcg?uin=" & qq & chr(38) & "type=4")


  Set root = Doc.documentElement
  Set node = root.childNodes.nextNode()
  visitor="最近访问："
  favor="空间好友："
  For nodei = 0 To root.childNodes.Length - 1
  Set NowNode = root.childNodes(nodei)
    if nownode.nodeName="visitorlist" then 
      visitor = visitor & vbCrLf & "  ID  : " & NowNode.selectSingleNode("uin").Text
      visitor = visitor & vbcrlf & "  空间: " & NowNode.selectSingleNode("spacename").Text
      visitor = visitor & vbcrlf 
    end if
    if nownode.nodeName="favorlist" then 
      favor = favor & vbCrLf & "  ID  : " & NowNode.selectSingleNode("uin").Text
      favor = favor & vbcrlf & "  昵称: " & NowNode.selectSingleNode("nick").Text
      favor = favor & vbcrlf 
    end if
  next
  msgbox visitor,0+48,"访客信息"
  msgbox favor,0+48,"好友信息"
end function
'--------------------------------------------------------------------------------------------------

直接把你的源码打包，发出了，不就OK了

能不能把源码贴出来？
这个程序挺好，我一直需要这样的！