CSDN信息查看,一款可以查看博客信息的小Tools。
打开博客,我们可以看到下面的信息:
打开源码,我们可以找到下面的信息:
图中黄色信息就是我们需要提取的信息。
将信息提取出来,再利用label控件将信息显示出来。
所以,CSDN信息查看查看这个工具,就是可以在免登录CSDN的情况下活的这些信息,并可以保存在一个文件中。
首先,我们打开软件:
点击获取:
所有的信息都可以浏览啦,我们也可以选择保存到文件,在D:MayuSoftCSDNinfoInfo.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:MayuSoftCSDNinfo" + namet.Text + ".jpg" If Dir("D:MayuSoft", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("D:MayuSoft") '创建文件夹 If Dir("D:MayuSoftCSDNinfo", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("D:MayuSoftCSDNinfo") 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:MayuSoftCSDNinfo" + namet.Text + ".jpg" If Dir("D:MayuSoft", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("D:MayuSoft") '创建文件夹 If Dir("D:MayuSoftCSDNinfo", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("D:MayuSoftCSDNinfo") 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:MayuSoftCSDNinfoInfo.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