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
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