CSDN工具-CSDN信息查看
CSDN信息查看，一款可以查看博客信息的小Tools。
打开博客，我们可以看到下面的信息：
打开源码，我们可以找到下面的信息：
图中黄色信息就是我们需要提取的信息。
将信息提取出来，再利用label控件将信息显示出来。
所以，CSDN信息查看查看这个工具，就是可以在免登录CSDN的情况下活的这些信息，并可以保存在一个文件中。
首先，我们打开软件：
点击获取：
所有的信息都可以浏览啦，我们也可以选择保存到文件，在D:\MayuSoft\CSDNinfo\Info.txt目录下可以找到保存的信息。
疑惑的是，已经下载下来了头像信息，但是无法加在到image控件中，似乎头像图片存在缺陷或者VB6.0本身的局限性。
我们可以更高级一点：
或者，我们可以将所有的博客主ID保存在一个文件中，读取出所有的博客主的信息然后保存在另一个TXT文件中，这样就可以统计一些CSDN博客的文档信息了有木有。
这是我们的主要函数：
Function getimg(datee As String)
Dim name As String
website = "http://blog.csdn.net/" + datee
webpage = getHTTPPage(website)
temp = GetByDiv(webpage, "blog_rank", "</ul>") '获取临时的信息
title = GetByDiv(GetByDiv(webpage, "<a href=", "a></h2>"), ">", "<")
pictemp = GetByDiv(webpage, "blog_userface", "style=")
userpic = GetByDiv(pictemp, "<img src=", " title=")
blogpage = GetByDiv(webpage, "blog_statistics", "</ul>")
userpic = Left(userpic, Len(userpic) - 1)
userpic = Right(userpic, Len(userpic) - 1)
fangwen.Caption = "访问：" + GetByDiv(temp, "<li>访问：<span>", "</span></li>") '获取访问
jifen.Caption = "积分：" + GetByDiv(temp, "<li>积分：<span>", "</span> </li>") '获取积分
paiming.Caption = "排名：" + GetByDiv(temp, "<li>排名：<span>", "<") '获取等级
yuanchuang.Caption = "原创：" + GetByDiv(blogpage, "<li>原创：<span>", "</span></li>")
zhuanzai.Caption = "转载：" + GetByDiv(blogpage, "<li>转载：<span>", "</span></li>")
yiwen.Caption = "译文：" + GetByDiv(blogpage, "<li>译文：<span>", "</span></li>")
pinglun.Caption = "评论：" + GetByDiv(blogpage, "<li>评论：<span>", "</span></li>")
Form1.Caption = title
name = "D:\MayuSoft\CSDNinfo\" + namet.Text + ".jpg"
If Dir("D:\MayuSoft", vbDirectory) = "" Then '判断文件夹是否存在
MkDir ("D:\MayuSoft") '创建文件夹
If Dir("D:\MayuSoft\CSDNinfo", vbDirectory) = "" Then '判断文件夹是否存在
MkDir ("D:\MayuSoft\CSDNinfo")
End If
End If
URLDownloadToFile 0, userpic, name, 0, 0
'Image1.Picture = LoadPicture(name)
End Function
加上其他的一些功能：
Option Explicit
Dim website As String
Dim webpage As String
Dim temp As String
Dim pictemp As String
Dim userpic As String
Dim blogpage As String
Dim title As String
Dim q As Boolean
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Function getHTTPPage(URL) '获取网站源码
On Error Resume Next
Dim http
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", URL, False
getHTTPPage = http.Send()
If http.ReadyState <> 4 Then
Debug.Print "无法连接服务器"
getHTTPPage = "无法连接服务器"
Exit Function
End If
getHTTPPage = BytesToBstr(http.responseBody, "UTF-8")
Set http = Nothing
End Function
Function BytesToBstr(body, Cset) '转码
Dim objstream
Set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
Set objstream = Nothing
End Function
Function GetByDiv(ByVal code As String, ByVal divBegin As String, divEnd As String) '获取分隔符所夹的内容
Dim lgStart As String
Dim lens As String
Dim lgEnd As String
lens = Len(divBegin)
lgStart = InStr(1, code, divBegin) + CLng(lens)
lgEnd = InStr(lgStart, code, divEnd)
GetByDiv = Mid(code, lgStart, lgEnd - lgStart)
End Function
Function getimg(datee As String)
Dim name As String
website = "http://blog.csdn.net/" + datee
webpage = getHTTPPage(website)
temp = GetByDiv(webpage, "blog_rank", "</ul>") '获取临时的信息
title = GetByDiv(GetByDiv(webpage, "<a href=", "a></h2>"), ">", "<")
pictemp = GetByDiv(webpage, "blog_userface", "style=")
userpic = GetByDiv(pictemp, "<img src=", " title=")
blogpage = GetByDiv(webpage, "blog_statistics", "</ul>")
userpic = Left(userpic, Len(userpic) - 1)
userpic = Right(userpic, Len(userpic) - 1)
fangwen.Caption = "访问：" + GetByDiv(temp, "<li>访问：<span>", "</span></li>") '获取访问
jifen.Caption = "积分：" + GetByDiv(temp, "<li>积分：<span>", "</span> </li>") '获取积分
paiming.Caption = "排名：" + GetByDiv(temp, "<li>排名：<span>", "<") '获取等级
yuanchuang.Caption = "原创：" + GetByDiv(blogpage, "<li>原创：<span>", "</span></li>")
zhuanzai.Caption = "转载：" + GetByDiv(blogpage, "<li>转载：<span>", "</span></li>")
yiwen.Caption = "译文：" + GetByDiv(blogpage, "<li>译文：<span>", "</span></li>")
pinglun.Caption = "评论：" + GetByDiv(blogpage, "<li>评论：<span>", "</span></li>")
Form1.Caption = title
name = "D:\MayuSoft\CSDNinfo\" + namet.Text + ".jpg"
If Dir("D:\MayuSoft", vbDirectory) = "" Then '判断文件夹是否存在
MkDir ("D:\MayuSoft") '创建文件夹
If Dir("D:\MayuSoft\CSDNinfo", vbDirectory) = "" Then '判断文件夹是否存在
MkDir ("D:\MayuSoft\CSDNinfo")
End If
End If
URLDownloadToFile 0, userpic, name, 0, 0
'Image1.Picture = LoadPicture(name)
End Function
Private Sub Form_Load()
End Sub
Private Sub gets_Click()
getimg (namet.Text)
If savec.Value = 1 Then
Open "D:\MayuSoft\CSDNinfo\Info.txt" For Output As #1
Print #1, namet.Text; " "; Form1.Caption; " "; fangwen.Caption; " "; jifen.Caption; " "; yuanchuang.Caption; " "; zhuanzai.Caption; " "; yiwen.Caption; " "; pinglun.Caption
Close #1
End If
End Sub
Private Sub namet_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call gets_Click
End Sub
下载
@ Mayuko
