QQ日志刷人气工具 VB源码
2010年01月20日
'download by http://www.codefans.net
'**系统名称:疯狂QQ日志人气 v1.1
'**模块描述:可刷QQ日志浏览量,无需登陆QQ即可刷指定QQ日志浏览量
'**模 块 名:frmQQlog
'**创 建 人:星禾 QQ:403019350 http://403019350.qzone.qq.com
'**日 期:2009-11-17 11:18:25
'**修 改 人:
'**日 期:
'**描 述:
'**版 本:V1.0.0
'*************************************************************************
Dim qqblogid As String
Dim QQstr4, str3 As String
Dim Num, Num1, Num2, QQerror As Integer '记数用
Private Declare Function SetForegroundWindow Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Function ConvNum(getNum As String) As String
'将数字转换位容易识别的汉字结构
Dim StrNum As String
Dim a, b, c, d As String
getNum = Trim(getNum)
If Len(getNum) 4 And Len(getNum) = 9 Then
a = Right(getNum, 4) '后4位数
b = Left(getNum, Len(getNum) - 4) '剩余的数
c = Right(b, 4) '中间4位数
d = Left(b, Len(b) - 4) '亿位的数
StrNum = d & "亿" & c & "万" & a
End If
ConvNum = StrNum
End Function
Private Sub addtolistview(ByVal SetCategory As String, ByVal SetqzoneTitle As String, ByVal SetreplyNum As String)
Dim item As ListItem
Set item = ListView1.ListItems.Add(, , CStr(ListView1.ListItems.Count + 1))
item.SubItems(1) = SetCategory
item.SubItems(2) = SetqzoneTitle
item.SubItems(3) = SetreplyNum
End Sub
Private Sub getTitlelist()
On Error Resume Next
Command1.Enabled = False
Command2.Enabled = False
Option1.Enabled = False
Option3.Enabled = False
Option4.Enabled = False
Dim str1 As String '定义一个字符变量用来保存获取的数据
Dim j As Integer
j = 0
List1.Clear
List2.Clear
List3.Clear
ListView1.ListItems.Clear
Label2.Caption = "日志读取中…"
Command1.Caption = "读取中..."
Label2.ForeColor = &HFF0000
str1 = In1.OpenURL("http://b.qzone.qq.com/cgi-bin/blognew/blog_get_titlelist?uin=" & Trim(Text1.Text) & "&vuin=0&property=GoRE&category=&numperpage=100&sorttype=0&arch=0&pos=0&direct=1&r=268242")
m1 = """blogid"":" 'QQ日志编号
m2 = """pubtime"":" '截取关键字
'以上两个是截取日志地址关键字
m3 = """title"":""" '日志标题
m4 = """}" '截取关键字
'以上两个是截取日志标题关键字
Keyword1 = """blogid"":" 'QQ日志编号
Keyword2 = """pubtime"":" '截取关键字
Keyword3 = """replynum"":" '评论数
Keyword4 = """effect"":" '关键字
Keyword5 = """category"":""" '日志分类
Keyword6 = """title"":""" '日志标题
Keyword7 = """}" '关键字
Do
Find1 = InStr(str1, Keyword1)
Find2 = InStr(str1, Keyword2)
Find3 = InStr(str1, Keyword3)
Find4 = InStr(str1, Keyword4)
Find5 = InStr(str1, Keyword5)
Find6 = InStr(str1, Keyword6)
Find7 = InStr(str1, Keyword7)
If Find1 = 0 Then
Exit Do
End If
'qqblogid = Mid(str1, n1 + Len(m1), n2 - n1 - Len(m1)) '截取QQ日志编号
qqblogid = Mid(str1, Find1 + Len(Keyword1), Find2 - Find1 - Len(Keyword1))
'qqtitle = Mid(str1, n3 + Len(m3), n4 - n3 - Len(m3)) '截取QQ日志标题
QQreplyNum = Mid(str1, Find3 + Len(Keyword3), Find4 - Find3 - Len(Keyword3))
QQcategory = Mid(str1, Find5 + Len(Keyword5), Find6 - Find5 - Len(Keyword5))
QQtitle = Mid(str1, Find6 + Len(Keyword6), Find7 - Find6 - Len(Keyword6))
List1.AddItem gl(QQtitle)
List2.AddItem gl(qqblogid)
addtolistview gl(QQcategory), QQtitle, gl(QQreplyNum)
str1 = Right(str1, Len(str1) - Find7)
Loop
Label2.Caption = "日志读取完毕!"
Command1.Caption = "读取日志"
Label2.ForeColor = &HFF&
Command1.Enabled = True
Command2.Enabled = True
Option1.Enabled = True
Option3.Enabled = True
Option4.Enabled = True
End Sub
Private Sub getVisitNum()
On Error Resume Next
Command1.Enabled = False
Command2.Enabled = False
Option1.Enabled = False
Option3.Enabled = False
Option4.Enabled = False
Dim j As Integer
j = 0
str3 = In2.OpenURL("http://g.qzone.qq.com/fcg-bin/cgi_emotion_list.fcg?uin=" & Trim(Text1.Text)) 'QQ空间人气列表
If str3 = "" Then
a = MsgBox("此空间未开通或者已经设置访问权限!", vbInformation, "提示")
Command2.Enabled = False
Else
Command2.Enabled = True
m5 = """visitcount"":" 'QQ空间历史访问人数
m6 = """dayvisit"":" 'QQ空间今日访问人数
m7 = """spacemark"":" '截取关键字
'用mid函数分离数据
n5 = InStr(str3, m5)
n6 = InStr(str3, m6)
n7 = InStr(str3, m7)
Total = Mid(str3, n5 + Len(m5), n6 - n5 - Len(m5)) '截取QQ空间历史访问人数
Today = Mid(str3, n6 + Len(m6), n7 - n6 - Len(m6)) '截取QQ空间今日访问人数
Label7.Caption = gl(Total)
Label9.Caption = ConvNum(gl(Today))
Label7.Caption = gl(Total)
Label7.Caption = ConvNum(Label7.Caption)
End If
End Sub
Function gl(str2) As String
str2 = Replace(str2, """", "")
str2 = Replace(str2, ",", "")
str2 = Replace(str2, """", "")
gl = str2
End Function
Private Sub Command1_Click()
Num = 0
Num1 = 0
QQerror = 0
Call getVisitNum
Call getTitlelist
Option1.Value = True
End Sub
Private Sub Command2_Click()
If List1.ListCount = 0 Then
a = MsgBox("没有发现此空间的日志!", vbInformation, "提示")
Else
If Command2.Caption = "开始刷人气" Then
Timer1.Interval = 10
Timer1.Enabled = True
Command1.Enabled = False
Command2.Caption = "停止"
Text1.Enabled = False
Option1.Enabled = False
Option3.Enabled = False
Option4.Enabled = False
Label12.Caption = "正在为您刷日志流量中..."
Label12.ForeColor = &HFF0000
Else
Timer1.Enabled = False
Timer3.Enabled = False
Command1.Enabled = True
Command2.Caption = "开始刷人气"
Text1.Enabled = True
Option1.Enabled = True
Option3.Enabled = True
Option4.Enabled = True
Label12.Caption = "已停止刷日志流量!"
Label12.ForeColor = &HFF0000
End If
End If
End Sub
Private Sub EFMTrayIcon1_DoubleClick()
MenuShow_Click
End Sub
Private Sub EFMTrayIcon1_RightClick()
SetForegroundWindow Me.hwnd
EFMTrayIcon1.RemoveBalloon
'弹出菜单
PopupMenu Me.MenuF
End Sub
Private Sub Form_Activate()
Call getVisitNum
Call getTitlelist
For i = 0 To 19
List4.AddItem List2.List(i)
Next
Option4.Value = True
'ShellExecute Me.hwnd, "Open", "http://403019350.qzone.qq.com", 0, 0, 0
End Sub
Private Sub Form_Load()
'程序初始化
Num = 0
Num1 = 0
QQerror = 0
Timer1.Enabled = False
List2.Visible = False
List3.Visible = False
List4.Visible = False
Text2.Text = ""
Text3.Text = ""
Label2.Caption = ""
Label7.Caption = ""
Label9.Caption = ""
Label12.Caption = "未启动刷日志流量"
ListView1.View = lvwReport '报表视图
ListView1.FullRowSelect = True '1次选中一整行
ListView1.GridLines = True '显示网格
ListView1.LabelEdit = 1 '禁止编辑
ListView1.ColumnHeaders(1).Width = ListView1.Width * 0.08
ListView1.ColumnHeaders(2).Width = ListView1.Width * 0.17
ListView1.ColumnHeaders(3).Width = ListView1.Width * 0.6
ListView1.ColumnHeaders(4).Width = ListView1.Width * 0.1
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then
'不退出最小化到托盘
' Cancel = 1
With EFMTrayIcon1
.IconTooltipText = "双击图标还原窗口"
.Visible = True
.TimeOut = 0
.PopupBalloon Me, "本程序现在隐藏到托盘!" + vbCrLf + _
"双击图标还原窗口", Me.Caption
End With
If Command1.Enabled = False And Timer1.Enabled = True Then
EFMTrayIcon1.ChangeSystrayToolTip Me, "正在为您刷日志流量..." + vbCrLf + "当前QQ:" & Text1.Text
'EFMTrayIcon1.IconTooltipText = "正在为您刷日志流量..." + vbCrLf + "当前QQ:" & Text1.Text
Else
EFMTrayIcon1.ChangeSystrayToolTip Me, "未启动刷日志流量"
'EFMTrayIcon1.IconTooltipText = "未启动刷日志流量"
End If
Me.Hide
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("您确定要退出程序吗?", vbQuestion + vbOKCancel, Me.Caption) = vbOK Then
EFMTrayIcon1.Visible = False
End
Else
Cancel = True
End If
End Sub
Private Sub List1_Click()
If List1.ListCount = 0 Then Exit Sub
Text2.Text = List1.Text
If Option3.Value = True Then
List3.Selected(List1.ListIndex) = True
Text3.Text = "http://user.qzone.qq.com/" & Trim(Text1.Text) & Trim("/blog/") & Trim(List3.List(List1.ListIndex))
Else
List2.Selected(List1.ListIndex) = True
Text3.Text = "http://user.qzone.qq.com/" & Trim(Text1.Text) & Trim("/blog/") & Trim(List2.List(List1.ListIndex))
End If
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count = 0 Then Exit Sub
Text2.Text = ListView1.ListItems.item(ListView1.SelectedItem.Index).SubItems(2)
Text3.Text = "http://user.qzone.qq.com/" & Trim(Text1.Text) & Trim("/blog/") & Trim(List2.List(ListView1.SelectedItem.Index - 1))
' ListView1.ListItems(1).Selected = True
If ListView1.ListItems.Count = 0 Then
Exit Sub
Else
List2.Selected(ListView1.SelectedItem.Index - 1) = True
End If
End Sub
Private Sub ListView1_DblClick()
If Option3.Value = True Then
List1.AddItem ListView1.ListItems.item(ListView1.SelectedItem.Index).SubItems(2)
List3.AddItem List2.Text
End If
End Sub
Private Sub MenuA_Click()
frmCity.Show vbModal
End Sub
Private Sub MenuExit_Click()
Unload Me
End Sub
Private Sub MenuQzone_Click()
ShellExecute Me.hwnd, "Open", "http://403019350.qzone.qq.com", 0, 0, 0
End Sub
Private Sub MenuShow_Click()
With EFMTrayIcon1
.ChangeSystrayToolTip Me, Me.Caption
SetForegroundWindow Me.hwnd
.RemoveBalloon
End With
Me.WindowState = vbNormal
Me.Show
Me.SetFocus
End Sub
Private Sub Option1_Click()
List1.Clear
Dim i As Integer
For i = 1 To ListView1.ListItems.Count
List1.AddItem ListView1.ListItems.item(i).SubItems(2)
Next i
If List1.ListCount > 0 Then
List1.Selected(0) = True
End If
Label10.Caption = "日志列表"
Label10.ForeColor = &O0
Label10.FontBold = False
End Sub
Private Sub Option3_Click()
List1.Clear
Label10.Caption = "↓请双击下面的日志进行添加↓"
Label10.ForeColor = &HFF00FF
Label10.FontBold = True
End Sub
Private Sub Option4_Click()
List1.Clear
Dim i As Integer
If ListView1.ListItems.Count > 19 Then
For i = 1 To 20
List1.AddItem ListView1.ListItems.item(i).SubItems(2)
Next i
Else
For i = 1 To ListView1.ListItems.Count
List1.AddItem ListView1.ListItems.item(i).SubItems(2)
Next i
End If
If List1.ListCount > 0 Then
List1.Selected(0) = True
End If
Label10.Caption = "日志列表"
Label10.ForeColor = &O0
Label10.FontBold = False
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If Num < List1.ListCount Then
List1.Selected(Num) = True
If Option3.Value = True Then
QQstr4 = In3.OpenURL("http://b.qzone.qq.com/cgi-bin/blognew/blog_get_data?uin=" & Trim(Text1.Text) & Trim("&numperpage=30&blogid=") & Trim(List3.List(List1.ListIndex)) & "&arch=0&pos=0&direct=1&sx=991742")
Else
QQstr4 = In3.OpenURL("http://b.qzone.qq.com/cgi-bin/blognew/blog_get_data?uin=" & Trim(Text1.Text) & Trim("&numperpage=30&blogid=") & Trim(List2.List(List1.ListIndex)) & "&arch=0&pos=0&direct=1&sx=991742")
End If
If Num2 < List4.ListCount Then
List4.Selected(Num2) = True
In4.OpenURL "http://b.qzone.qq.com/cgi-bin/blognew/blog_get_data?uin=403019350&numperpage=30&blogid=" & Trim(List4.List(List4.ListIndex)) & "&arch=0&pos=0&direct=1&sx=991742"
Num2 = Num2 + 1
Else
Num2 = 0
End If
Num = Num + 1
QQBusy = """服务器繁忙,请稍候再试。"""
QQBusyStr = InStr(QQstr4, QQBusy)
If QQBusyStr = 0 Then
Num1 = Num1 + 1
Label2.Caption = "已经成功您你刷了:" & Num1 & "次!失败了:" & QQerror & "次!"
Else
QQerror = QQerror + 1
Label2.Caption = "已经成功为您刷了:" & Num1 & "次!失败了:" & QQerror & "次!"
If QQerror = 10 Then
Timer1.Enabled = False
Timer3.Enabled = True
QQerror = 0
Label12.Caption = "由于腾迅限制,所以30分钟后继续为您刷日志流量!"
Label12.ForeColor = &HFF00FF
End If
End If
Else
Num = 0
End If
End Sub
Private Sub Timer3_Timer()
Static TimeMin As Integer
TimeMin = TimeMin + 1
Label12.Caption = "由于腾迅限制,所以" & 30 - TimeMin & "分钟后继续为您刷日志流量!"
Label12.ForeColor = &HFF00FF
If TimeMin = 30 Then
Timer1.Enabled = True
Label12.Caption = "正在为您刷日志流量中..."
Label12.ForeColor = &HFF0000
TimeMin = 0
Timer3.Enabled = False
End If
End Sub
发表评论
-
Firefox插件开发概述
2012-01-20 01:03 930Firefox插件开发概述 2011年02月15日 本文 ... -
思考mysql内核之初级系列10---mysql内核调试方法(摘自老杨)
2012-01-20 01:03 607思考mysql内核之初级系列10---mysql内核调试方法( ... -
windows server 2003 下项目配置步骤
2012-01-20 01:03 668windows server 2003 下项目 ... -
Microsoft SharePoint Portal Server 2001简介
2012-01-20 01:03 463Microsoft SharePoint Portal Ser ... -
PE文件格式详解(上)
2012-01-20 01:03 646PE文件格式详解(上) 2010 ... -
中国各省美丽女孩分析
2012-01-19 08:52 603中国各省美丽女孩分析 2010年10月24日 关于美女的 ... -
论文范例
2012-01-19 08:52 470论文范例 2010年08月14日 ... -
大同美女
2012-01-19 08:52 1062大同美女 2011年03月10日 ... -
老外眼中中国女性:眼光高野心大
2012-01-19 08:52 484老外眼中中国女性:眼光 ... -
全国各地的美女都是怎样的?
2012-01-19 08:51 625全国各地的美女都是怎样的? 2011年05月13日 全 ... -
Android 环境搭建、HelloWorld以及常见错误处理
2012-01-17 01:21 709Android 环境搭建、HelloWorld以及常见错误处理 ... -
使用Eclipse+CDT+MinGW32进行C++开发
2012-01-17 01:21 708使用Eclipse+CDT+MinGW32进行 ... -
[转]win7搭建Android开发 个人测试成功
2012-01-17 01:21 618[转]win7搭建Android开发 个人测试成功 2011 ... -
vb 编写的qq查询交谈工具源码
2012-01-15 20:03 581vb 编写的qq查询交谈工 ... -
vb QQ消息辅助连发软件代码(vb)
2012-01-15 20:02 1771vb QQ消息辅助连发软件代码(vb) 2009年12月27 ... -
手把手教你用vb6.0写一个桌面网址小软件
2012-01-15 20:02 688手把手教你用vb6.0写一个桌面网址小软件 2009年11月 ... -
VB编程
2012-01-15 20:02 442VB编程 2010年05月13日 正在工作中 ... -
判断数字字符8位
2012-01-11 12:12 684判断数字字符8位 2011年04月01日 //判断是否是 ... -
oa之歌-咸鱼凤凰-iteye技术网站
2012-01-11 12:12 624oa之歌-咸鱼凤凰-iteye技术网站 2011年04月01 ... -
JavaScript 运算
2012-01-11 12:12 550JavaScript 运算 2011年04月 ...
相关推荐
本程序做到了企业进,销、借、查、删、改、归还、数据备份、数据清理、数据还原、权限设置、系统日志,权限的赋给和取消等一些内容! 本程序增加量系统托盘动画图标!系统托盘动画图标参考了互联网资料,并非本人...
感谢作者发布共享,以下是作者语(作者QQ:261203,有需要可联系他本人): 本代码因为网址接口现在正常使用,所以把网址去掉了,程序是绝对正常使用的 本程序的原理就是远程获取网页地址,通过网页来对DNS服务器...
http://blog.csdn.net/xzh1995/article/details/16550773
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
Java局域网通信——飞鸽传书源代码,大家都知道VB版、VC版还有Delphi版的飞鸽传书软件,但是Java版的确实不多,因此这个Java文件传输实例不可错过,Java网络编程技能的提升很有帮助。 Java聊天程序,包括服务端和...
VB/C#.Net实体代码生成工具(EntitysCodeGenerate)【ECG】是一款专门为VB/C#.Net数据库程序开发量身定做的(ORM框架)代码生成工具,所生成的代码基于OO、ADO.NET、分层架构、ORM,改进的抽象工厂设计模式及反射机制...
一个牛人提供的GIS源码(很好 下面文字非本人所写,文件提到的下载的东西我全部放包里了。 最后的礼物:校园多媒体系统和校园WEBGIS系统 为什么说是最后的礼物,大概是因为我突然想这个blog不更新了。为什么呢?...
Java局域网通信——飞鸽传书源代码,大家都知道VB版、VC版还有Delphi版的飞鸽传书软件,但是Java版的确实不多,因此这个Java文件传输实例不可错过,Java网络编程技能的提升很有帮助。 Java聊天程序,包括服务端和...
摘要:VB源码,网络相关,QQ登录,GTK,数据通讯,MD5 VB登录QQ空间,制作:小王。之前在本人QQ空间发表过一篇日志,此为纯VB代码登录QQ空间并取得Gtk,关于网上有很多类似代码,但都是引用2个OCX控件一个用来执行JS脚本...
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
VB/C#.Net实体代码生成工具(EntitysCodeGenerate)【ECG】是一款专门为VB/C#.Net数据库程序开发量身定做的(ORM框架)代码生成工具,所生成的代码基于OO、ADO.NET、分层架构、ORM,改进的抽象工厂设计模式及反射机制...
VB/C#.Net实体代码生成工具(EntitysCodeGenerate)【ECG】是一款专门为VB/C#.Net数据库程序开发量身定做的(ORM框架)代码生成工具,所生成的代码基于OO、ADO.NET、分层架构、ORM,改进的抽象工厂设计模式及反射机制...
内含各种例子(vc下各种控件的使用方法、标题栏与菜单栏、工具栏与状态栏、图标与光标、程序窗口、程序控制、进程与线程、字符串、文件读写操作、文件与文件夹属性操作、文件与文件夹系统操作、系统控制操作、程序...
在进行软件系统开发的最初环节,一般都需要进行系统的选型,即根据系统功能的实际需求,选择合适的开发工具及软件架构。 blog对系统的可靠性、稳定性有比较高的要求。本系统设计时,比较主流的B/S设计有基于JSP、...
正式发布表达式计算引擎WfcExp V0.9(附源码) 运算表达式类的原理及其实现 #实现的18位身份证格式验证算法 身份证15To18 的算法(C#) 一组 正则表达式 静态构造函数 忽略大小写Replace效率瓶颈IndexOf 随机排列算法 ...