Option Explicit
Const C_WorkProgress = 4
Class UI_Class
Public Form, Tip, config, AppName, Starting, Angel
Private Menu, hMenu1(1), hMenu2(0), timing
Private Tooptip
Private DisablePowerSave
Private Sub Create()
Dim i, v, s, j, arr
Set Menu = Control.Menu()
Set Form = Api.NewForm()
Set Tooptip = Control.Tooptip()
With Form
Form.Caption = "软件"
Call Api.ECall("user32.dll", "SetWindowLongA", .hWnd, -16, Api.ECall("user32.dll", "GetWindowLongA", .hWnd, -16) And Not (&H10000 Or &H40000))
.Move 0, 0, 0, 0
.Width = (790 - .ScaleWidth) * Globals("Screen").TwipsPerPixelX + .Width
.Height = (430 - .ScaleHeight) * Globals("Screen").TwipsPerPixelY + .Height
.Move (Globals("Screen").Width - .Width) \ 2, (Globals("Screen").Height - .Height) \ 2
Tooptip.Create .hWnd
End With
Const Width = 100
Const Top = 335
Const Margin = 2
Const UpDate = "2021-10-07"
Dim iLeft
config = ".\Angel.ini"
AppName = "Angel_BP"
If CDate(UpDate) > CDate(File.ReadINI(AppName, "UpDate", config, "2020-01-01")) Then
File.Delete config
File.WriteINI AppName, "UpDate", UpDate, config
End If
Call CreateListView
arr = Array("使用帮助", "常用功能", "会员服务", "启动游戏", "中止全部", "清除进度")
For i = 0 To UBound(arr)
With Form.Controls.Add("VB.CommandButton", arr(i))
.Caption = arr(i)
.Move 660 + 60 * (i \ 3), Top + (20 + Margin) * (i Mod 3), 60, 21
.Visible = True
End With
Next
Form.Controls("启动游戏").ToolTipText = "快捷键(F9)"
Form.Controls("中止全部").ToolTipText = "快捷键(F10)"
Form.Controls("清除进度").ToolTipText = "手动中止后。游戏进度会被保存以备启动继续。清除后可以完全重新开始"
arr = Array(227, 653) '230
For i = 0 To UBound(arr)
With Form.Controls.Add("VB.Line", "Line" & i)
.X1 = arr(i)
.X2 = .X1
.Y1 = Top
.Y2 = .Y1 + 65
.BorderColor = &H555555
.Visible = True
End With
Next
iLeft = 10
arr = Array("上号间隔" & Space(6) & "秒", 5, 1, "登录重试" & Space(6) & "次", 3, 1, "服务端口" & Space(6) & "号", 8888, 0)
For i = 0 To UBound(arr) Step 3
s = Left(arr(i), 4)
With Form.Controls.Add("VB.TextBox", s & "T")
.Move iLeft + 68, Top + (20 + Margin) * i \ 3, 30, 20
.Visible = True
.Text = File.ReadINI(AppName, s & "T.Text", config, arr(i + 1))
End With
With Form.Controls.Add("VB.CheckBox", s)
.Caption = arr(i)
.Move iLeft, Top + (20 + Margin) * i \ 3, 120, 20
.Visible = True
.Value = File.ReadINI(AppName, s & ".Value", config, arr(i + 2))
End With
Call Form_Event(Form.Controls(s & "T"), &H30000 * &H100, 0)
Call Form_Event(Form.Controls(s), &H100 * &H100, 0)
Next
iLeft = 130
arr = Array("上号等待", 50, "同时线程", 6, "游戏降耗", 0)
For i = 0 To UBound(arr) Step 2
With Form.Controls.Add("VB.TextBox", arr(i))
.Move iLeft + 60, Top + (20 + Margin) * i \ 2, 30, 20
.Visible = True
.Text = File.ReadINI(AppName, arr(i) & ".text", config, arr(i + 1))
End With
With Form.Controls.Add("VB.Label", arr(i) & "L")
.Move iLeft, Top + 3 + (20 + Margin) * i \ 2, 100, 20
.Caption = arr(i) & "："
.Visible = True
End With
Call Form_Event(Form.Controls(arr(i)), &H30000 * &H100, 0)
Next
Form.Controls("上号等待").ToolTipText = "登录游戏时的读条时间：秒"
iLeft = 235
arr = Array("窗口排列", "左竖叠加|左竖平铺|左横平铺|右竖叠加|右竖平铺|右横平铺|隐藏窗口", "方向按键", "上下左右|W A S D|数字键盘", "游戏完成", "不做处理|播放音乐|关闭电脑")
For i = 0 To UBound(arr) Step 2
With Form.Controls.Add("VB.Label", arr(i) & "L")
.Move iLeft, Top + 3 + (20 + Margin) * i \ 2, 60, 20
.Caption = arr(i) & "："
.Visible = True
End With
With Form.Controls.Add("VB.ComboBox", arr(i))
.Move iLeft + 60, Top + (20 + Margin) * i \ 2, 73
.Visible = True
Call Control.SetComboBox(Form.Controls(arr(i)), arr(i + 1), 0)
.ListIndex = File.ReadINI(AppName, arr(i) & ".ListIndex", config, 0)
End With
Call Form_Event(Form.Controls(arr(i)), &H100 * &H100, 0)
Next
iLeft = iLeft + 140
arr = Array("定时功能", "|a0启动辅助|a0终止辅助|a0关闭游戏|a0关闭电脑|a0清理进程", "异常设置", "|a1游戏超时|a1准备超时", "其他设置", "|A1防止休眠|a0开机启动|a0开机上号|a1自动截图|a1自动滑块|a0飞车路径")
For i = 0 To UBound(arr) Step 2
With Form.Controls.Add("VB.Label", arr(i) & "L")
.Move iLeft, Top + 3 + (20 + Margin) * i \ 2, 60, 20
.Caption = arr(i) & "："
.Visible = True
End With
s = Replace(arr(i + 1), "|A", "|", 1, -1, vbTextCompare)
s = File.ReadINI(AppName, arr(i), config, arr(i) & s)
File.WriteINI AppName, arr(i), s, config
With Form.Controls.Add("QQSpeed.ComboList", arr(i))
.Move iLeft + 60, Top + (20 + Margin) * i \ 2, 73
.Visible = True
.object.List = s
End With
v = Split(arr(i + 1), "|")
For j = 1 To UBound(v)
If Left(v(j), 1) = "A" Then
ComboBox_ItemCheck Mid(v(j), 3), Array(arr(i), j-1)
End If
Next
Next
Form.SetEvent Form.Controls(arr(0)), Me, "ActiveXEvents", "ComboBox"
iLeft = iLeft + 140
arr = Array("使用权限", "免费使用|试用会员|登录会员", "启动方式", "提取名字", "优化方式", "进程优化|帧数优化")
For i = 0 To UBound(arr) Step 2
With Form.Controls.Add("VB.Label", arr(i) & "L")
.Move iLeft, Top + 3 + (20 + Margin) * i \ 2, 60, 20
.Caption = arr(i) & "："
.Visible = True
End With
With Form.Controls.Add("VB.ComboBox", arr(i))
.Move iLeft + 60, Top + (20 + Margin) * i \ 2, 73
.Visible = True
Call Control.SetComboBox(Form.Controls(arr(i)), arr(i + 1), 0)
.ListIndex = File.ReadINI(AppName, arr(i) & ".ListIndex", config, 0)
End With
Next
Call Form_Event(Form.Controls("优化方式"), &H100 * &H100, 0)
SetListView1 Form.Controls("启动方式").ListIndex
Form.SetUnloadEvent Me, "Form_Unload"
Const WM_HOTKEY = &H312
Const WM_CLOSE = &H10
Const WM_NOTIFY = &H4E
Const WM_COMMAND = &H111
Const WM_SIZE = &H5
Const WM_USER = &H400
Const WM_APP = &H8000&
Form.SetEventLong Form.hWnd, Array(WM_CLOSE, WM_NOTIFY, WM_HOTKEY, WM_COMMAND, WM_SIZE, WM_APP + 4), Me, "Form"
Form.Show
arr = Array(&H78, &H79, &H24)
For i = 0 To UBound(arr)
Call Api.ECall("user32", "RegisterHotKey", Form.hWnd, i + 1, 0, arr(i))
Next
Starting = 1
' s = "C:\Users\Administrator\Desktop\脚本\VBS+\SkinH_VB6.dll"
' Call Api.ECall(Api.ProcAddress(s, "SkinH_AttachEx"), False, Api.StrConv("C:\Users\Administrator\Desktop\脚本\VBS+\皮肤\QQ2008.she"& chr(0),&H80), "")
End Sub
Private Function times(ByVal s, ByVal d)
Dim i, t
i = InStr(s, "|")
If i = 0 Then i = InStrRev(s, ":")
t = Left(s, i - 1)
s = Mid(s, i + 1)
Select Case Int(s)
Case 3
d = DateAdd("s", DateDiff("s", "00:00:00", t), Now())
times = Api.Format(d, "yyyy-mm-dd HH:mm:ss")
Case Else
d = DateAdd("s", d, Time())
d = DateAdd("d", IIf(DateDiff("s", d, t) <= 0, 1, 0), Date)
times = Api.Format(d, "yyyy-mm-dd") & " " & t
End Select
times = times & "|" & s
End Function
Public Sub Timer_Timer()
Dim i, v, arr, s, t
If UBound(timing) >= 0 Then
arr = Split(timing(0), "|")
i = InStr("启动辅助|终止辅助|关闭游戏|关闭电脑", arr(2))
If i Then i = -10
If Now() >= DateAdd("s", i, arr(0)) Then 'CDate(arr(0)) Then
t = File.ReadINI(AppName, arr(2), config)
Select Case arr(1)
Case 2
Set v = CString.Array(timing)
Call v.Shift
s = Form.Controls("定时功能").object.List
s = Replace(s, "|1" & arr(2), "|0" & arr(2))
Form.Controls("定时功能").object.List = s
File.WriteINI AppName, "定时功能", s, config
Case Else
timing(0) = times(t, -i) & "|" & arr(2)
Set v = CString.Array(timing)
End Select
If i Then i = Window.MessageBox(Form.hWnd, "启动定时功能：" & arr(2) & vbTab & t, "定时功能：", vbOKCancel + 64, 10)
If i > 0 And i <> 2 Then
Select Case arr(2)
Case "启动辅助"
Call Form_Event(Form.Controls("启动游戏"), 0, 0)
Case "终止辅助"
Call Form_Event(Form.Controls("中止全部"), 0, 0)
Case "关闭游戏"
Call Api.Shell("taskkill /f /t /im GameApp.exe", 0)
Call Api.Shell("taskkill /f /t /im QQSpeed_loader.exe", 0)
Case "关闭电脑"
Call Api.Shell("shutdown -f -s -t 30")
Case "清理进程"
Call Api.Shell("taskkill /f /t /im IIPSHostApp.exe", 0)
Call Api.Shell("taskkill /f /t /im QQSpeedChatBrowser.exe", 0)
v = Array("BugReport", "#32770", "QQ飞车", "#32770", "错误", "#32770", "游戏圈", "TXGuiFoundation")
End Select
End If
timing = Api.ArrayFormat(v.sort())
End If
End If
If DisablePowerSave Then
If DisablePowerSave Mod 20 = 0 Then
If DisablePowerSave >= 40 Then
DisablePowerSave = 0
i = -1
Else
i = 1
End If
Call Api.ECall("user32", "mouse_event", &H1, i, i, 0, 0)
End If
DisablePowerSave = DisablePowerSave + 1
End If
End Sub
Private Sub Form_Event(Obj, wParam, lParam)
Dim i, b
Select Case TypeName(Obj)
Case "CommandButton"
Select Case Obj.Name
Case "使用帮助"
Call Window.MessageBox(Form.hWnd, "选择启动方式提取名字，软件左边空白点击右键选择最下方提取名字", "提示", 64, 5)
Case "常用功能"
' MsgBox Angel.MessageBoxSelf("测试", "说明", 0, 0, "123", "456", "123", "456")
Dim JsClass, arr
JScript.AddCode File.ReadTextEx(IIf(IsDebug, "QQSpeed_Common.js", "自定义脚本.js"), "utf-8")
Set JsClass = JScript.Eval("new QQSpeed_Common")
Set JsClass.UI = Me
arr = Split(Control.Keys(JsClass, 4), "|")
i = Angel.MessageBoxSelfA("常用功能", "选择功能", arr)
If i Then
Call Api.CallObj(JsClass, arr(i - 1), 1)
End If
Case "会员服务"
MsgBox "请登录！", 4096
Case "清除进度"
Globals("QQSpeed").RemoveAll
Case Else
Dim j, y
With Form.Controls("ListView1").object.ListView
j = 0
y = Int(Form.Controls("同时线程").Text)
For i = 1 To .ListItems.Count
Select Case Obj.Name
Case "启动游戏"
' j = j + 1
' If .ListItems(i).Checked Then '继续游戏
'Call Api.ECall("kernel32.dll", "ResumeThread", Int(.ListItems(i).Tag))
' ElseIf j <= y Then
' .ListItems(i).Checked = True
' ListView1_ItemCheck .ListItems(i)
' End If
If .ListItems(i).Checked Then
j = j + 1
End If
Case "中止全部"
If .ListItems(i).Checked Then
.ListItems(i).Checked = False
ListView1_ItemCheck .ListItems(i)
End If
End Select
Next
If Obj.Name = "启动游戏" Then
For i = 1 To .ListItems.Count
If j >= y Then Exit For
If Not .ListItems(i).Checked Then
b = True
If Globals("QQSpeed").Exists(i - 1) Then
b = Globals("QQSpeed").Item(i - 1)(0)(C_WorkProgress + 3) = 0
End If
If b Then
.ListItems(i).Checked = True
ListView1_ItemCheck .ListItems(i)
j = j + 1
End If
End If
Next
End If
End With
End Select
Case "CheckBox"
Select Case Obj.Name
End Select
File.WriteINI AppName, Obj.Name & ".Value", Obj.Value, config
Case "TextBox"
Select Case wParam \ &H100
Case &H20000
If IsNumeric(Obj.Text) = False Then
Obj.Text = "0"
ElseIf Obj.Text < 0 Then
Obj.Text = "0"
End If
Case &H30000
File.WriteINI AppName, Obj.Name & ".Text", Obj.Text, config
End Select
Case "ComboBox"
Select Case wParam \ &H100
Case &H100
Select Case Obj.Name
Case "使用权限"
Case "启动方式"
If Obj.ListIndex = 1 Then
If Angel.Vip Is Nothing Then
Obj.ListIndex = 0
Exit Sub
End If
End If
SetListView1 Obj.ListIndex
End Select
File.WriteINI AppName, Obj.Name & ".ListIndex", Obj.ListIndex, config
End Select
End Select
End Sub
Public Sub Form_GetMessage(cHwnd, Message, wParam, lParam)
Dim i, j, Obj, b
Select Case Message
Case &H8004&
i = Globals("QQSpeed").Item(wParam - 1)(0)(C_WorkProgress + 3)
i = IIf(i And 2, i \ &H10000, 5) * 2
If i Then
With Form.Controls("StatusBar").object
.Panels(i).Text = Int(.Panels(i).Text) + 1
End With
End If
With Form.Controls("ListView1").object.ListView
' Call Api.ECall("Kernel32.dll", "CloseHandle",.ListItems(wParam).Tag)
For i = wParam + 1 To .ListItems.Count
If .ListItems(i).Checked = False Then
b = True
If Globals("QQSpeed").Exists(i - 1) Then
b = Globals("QQSpeed").Item(i - 1)(0)(C_WorkProgress + 3) = 0
End If
If b Then
.ListItems(i).Checked = True
ListView1_ItemCheck .ListItems(i)
Exit For
End If
Else
j = j + 1
End If
Next
End With
If b = False And j = 0 Then
Select Case Form.Controls("游戏完成").ListIndex
Case 1
Call Api.ECall("winmm.dll", "mciSendStringW", "open ""http://music.player.E5%90%8D%E4%BE%A6%E6%8E%A2%E6%9F%AF%E5%8D%97.mid?0.mp3"" alias mysong", 0, 0, 0)
Call Api.ECall("winmm.dll", "mciSendStringW", "play mysong", 0, 0, 0)
MsgBox "游戏已全部完成!", 4096
Call Api.ECall("winmm.dll", "mciSendStringW", "Close mysong", 0, 0, 0)
Case 2
Const SHUTDOWN = 0
Const RESTART = 1
Const POWEROFF = 2
Const SE_SHUTDOWN_PRIVILEGE = 19
Call Api.ECall("ntdll.dll", "RtlAdjustPrivilege", SE_SHUTDOWN_PRIVILEGE, 1, 0, Api.VarPtr(i) + 8) '提权
Call Api.ECall("ntdll.dll", "NtShutdownSystem", SHUTDOWN)
End Select
End If
Case &H4E 'WM_NOTIFY
Select Case Api.ReadMem(lParam)
Case Tooptip.hWnd
Select Case Api.ReadMem(lParam + 8)
End Select
End Select
Case &H10 '内置的窗口好像不响应这个'
MsgBox "WM_CLOSE", , Message
Case &H5 'WM_SIZE'
If Form.WindowState = 1 Then
'Form.Visible = False
End If
Case &H111 ' "WM_COMMAND"
For Each Obj In Form.Controls
If InStr("CommandButton|CheckBox|TextBox|ComboBox", TypeName(Obj)) Then
If Obj.hWnd = lParam Then
Form_Event Obj, wParam, lParam
End If
End If
Next
Case &H312
Select Case wParam
Case 1
Call Form_Event(Form.Controls("启动游戏"), 0, 0)
Case 2
Call Form_Event(Form.Controls("中止全部"), 0, 0)
Case 3
Call ListView1_MouseMove(1, 0, &H202 * Globals("Screen").TwipsPerPixelX, 0)
End Select
End Select
End Sub
Public Sub ComboBox_Click(byEvent, Parameters)
Select Case Parameters(0).Value
Case "定时功能"
'Form.Controls(Parameters(0).Value).Object.List="测试一下|0开机启动|1自动截图|0自动重启|0自动滑块|0飞车路径"
Case "异常设置"
With Form.Controls(Parameters(0).Value).object
.Tips = "|在游戏中超时没有结束|定时终止辅助"
End With
Case "其他设置"
End Select
End Sub
Public Sub ComboBox_ItemCheck(byEvent, Parameters)
Dim s, t, b, i, v, Name
With Form.Controls(Parameters(0)).object
Name = .ComboBox.List(Parameters(1))
Select Case Parameters(0)
Case "定时功能"
i = UBound(timing)
If i >= 0 Then
For t = 0 To i
If InStr(timing(t), Name) Then
Exit For
End If
Next
i = t > i
End If
If .ComboBox.Selected(Parameters(1)) Then
s = Control.TimeDialog()
b = 1
If Len(s) Then
t = times(s, 0) & "|" & Name
If i = -1 Then
Set v = CString.Array(timing)
v.push (t)
Else
timing(i) = t
Set v = CString.Array(timing)
End If
timing = Api.ArrayFormat(v.sort())
End If
Else
Set v = CString.Array(timing)
v.splice i, 1
timing = Api.ArrayFormat(v.sort())
End If
Case "其他设置"
Select Case Name
Case "防止休眠"
DisablePowerSave = IIf(.ComboBox.Selected(Parameters(1)), 1, 0)
Case "飞车路径"
If .ComboBox.Selected(Parameters(1)) Then
b = 1
s = File.Select("请选择QQ飞车路径", "支持文件（*.exe）|*.exe")
End If
End Select
End Select
If Len(s) Then
File.WriteINI AppName, Name, s, config
ElseIf b Then
.ComboBox.Selected(Parameters(1)) = False
Exit Sub
End If
File.WriteINI AppName, Parameters(0), .List, config
End With
End Sub
Public Sub ComboBox_MouseMove(byEvent, Parameters)
Dim v, s
On Error Resume Next
Select Case Parameters(0).Value
Case "定时功能"
Case "异常设置"
Case "其他设置"
v = Array("防止系统休眠屏幕保护", "开机自动启动辅助", "开机自动启动辅助并开始上号刷", "出好东西自动截图", "登录飞车自动过滑块", "如果启动不了飞车。可以尝试填写安装飞车的路径")
End Select
With Form.Controls(Parameters(0).Value).object.ComboBox
If .Selected(Parameters(1).Value) Then
s = File.ReadINI(AppName, .List(Parameters(1).Value), config)
If Len(s) Then s = .List(Parameters(1).Value) & "：" & s
End If
If Len(s) = 0 Then s = v(Parameters(1).Value)
.ToolTipText = s
End With
End Sub
Private Sub SetListView1(ByVal i)
Dim v
v = Array("序号", 50, "账号", 100, IIf(i = 0, "飞车名字", "密码"), 100, "大区", 100, "操作", 100, "提示", 100)
With Form.Controls("ListView1").object.ListView
Call ListView1_Clear
.ColumnHeaders.Clear
For i = 0 To UBound(v) Step 2
.ColumnHeaders.Add , , v(i), v(i + 1)
Next
.OLEDropMode = Form.Controls("启动方式").ListIndex
.ColumnHeaders(3).Tag = File.ReadINI(AppName, "隐藏密码.Value", config, "0")
End With
End Sub
Private Sub CreateListView()
Dim i, v, w, ListView
v = Array("Licenses\ED4B87C4-9F76-11d1-8BF7-0000F8754DA1\", "knlggnmntgggrninthpgmnngrhqhnnjnslsh", "Licenses\4250E830-6AC2-11cf-8ADB-00AA00C00905\", "kjljvjjjoquqmjjjvpqqkqmqykypoqjquoun")
w = UBound(v)
For i = 0 To w Step 2
If Api.ECall("advapi32", "RegOpenKeyW", &H80000000, v(i), Api.VarPtr(w) + 8) Then
Call Api.ECall("advapi32", "RegCreateKeyW", &H80000000, v(i), Api.VarPtr(w) + 8)
Call Api.ECall("advapi32", "RegSetValueW", w, 0, 1, v(i + 1), Len(v(i + 1)))
End If
Call Api.ECall("advapi32", "RegCloseKey", w)
Next
If Api.ActiveXObject("MSComctlLib.ImageListCtrl") Is Nothing Then
If MsgBox("系统缺少控件“mscomctl32.ocx”，是否安装？" & vbCrLf & "需要管理员权限运行！", 4096 + vbYesNo, "本电脑缺少控件") = vbYes Then
Call Api.ECall(".\plugin\mscomctl32.ocx", "DllRegisterServer")
End If
End If
' Set Angel = Api.ActiveXObject("QQSpeed.Angel")
' If Angel Is Nothing Then
i = ".\plugin\QQSpeed.ocx"
w = Api.ProcAddress(i, "DllRegisterServer")
If w > 0 Then Call Api.ECall(w, False)
Set Angel = CreateObject("QQSpeed.Angel")
' End If
With Form.Controls.Add("QQSpeed.UI", "ListView1")
.Visible = True
.Width = 570
.Height = 327
Set ListView = .object.ListView
End With
Call Angel.Init(Api)
Set Tip = Control.Tray()
Tip.Add ListView.hWnd, Globals("App").Title, Api.ECall("user32.dll", "SendMessageA", Form.hWnd, &H7F, 1, 0)
hMenu1(0) = Menu.Create(ListView.hWnd, Join(Array("启动选中", "中止选中", "-", "退上一个", "跳下一个", "设为完成", "清除进度", "-", "选择全部", "选择反向", "删除选中", "清空全部", "-", "提取名字"), Chr(0)))
With Form.Controls.Add("QQSpeed.UI", "ListView2")
.Visible = True
.Left = 570
.Width = Form.ScaleWidth - 570
.Height = 327
Set ListView = .object.ListView
ListView.MultiSelect = False
.object.CanDrag = True
End With
v = Array("任务功能", 100, "局数", 50, "分钟", 50)
For i = 0 To UBound(v) Step 2
ListView.ColumnHeaders.Add , , v(i), v(i + 1)
Next
v = Split(File.ReadINI(AppName, "ListView2", config, "顺子大作战|5|0|1|跳跳派对|4|0|1|绝命车王|2|0|0|----|0|0|0|互助接力赛|2|0|1|酷币大作战|50|0|0|" & _
"双人冲锋战|3|0|1|超能竞速赛|2|0|1|狂野追逐|5|0|1|变身派对|5|0|1|极速对决|4|0|1|----|0|0|0|----|0|0|0|----|0|0|0|" & _
"全城通缉令|7|0|1|-----|0|0|0"), "|")
w = 0
hMenu2(0) = Menu.Create(ListView.hWnd, Join(Array("选中全部", "取消全部", "反向选择"), Chr(0)))
For i = 0 To UBound(v) Step 4
With ListView
w = w + 1
.ListItems.Add , , v(i)
.ListItems(w).SubItems(1) = File.ReadINI(AppName, v(i) & ".局数", config, CStr(v(i + 1)))
.ListItems(w).SubItems(2) = File.ReadINI(AppName, v(i) & ".分钟", config, CStr(v(i + 2)))
.ListItems(w).Checked = File.ReadINI(AppName, v(i) & ".Value", config, CStr(v(i + 3)))
End With
Next
Form.SetEvent Form.Controls("ListView1"), Me, "ActiveXEvent"
Form.SetEvent Form.Controls("ListView2"), Me, "ActiveXEvent"
'状态栏'
v = Array("总数：", 0, "冻结：", 0, "错密：", 0, "停封：", 0, "完成：", 0)
Form.Licenses.Add "MSComctlLib.SBarCtrl"
With Form.Controls.Add("MSComctlLib.SBarCtrl", "StatusBar")
.Visible = True
.object.Panels.Clear
w = UBound(v)
w = (.Width - w) / (w + 1)
For i = 0 To UBound(v)
.object.Panels.Add , , v(i)
.object.Panels(i + 1).Width = w
Next
End With
End Sub
Private Sub Import(TextFile)
Dim i, j, zh, s
With Form.Controls("ListView1").object.ListView
Call ListView1_Clear
s = Split(File.ReadTextEx(TextFile), vbCrLf)
For i = 0 To UBound(s)
zh = Split(s(i), "----")
If UBound(zh) > 0 Then
j = j + 1
.ListItems.Add , , j
.ListItems(j).SubItems(1) = zh(0)
If .ColumnHeaders(3).Tag = "1" Then
.ListItems(j).SubItems(2) = String(Len(zh(1)), "*")
.ListItems(j).ListSubItems(2).Tag = zh(1)
Else
.ListItems(j).SubItems(2) = zh(1)
End If
End If
Next
With Form.Controls("StatusBar").object
.Panels(2).Text = j
End With
End With
End Sub
Public Sub ListView1_ColumnCheck(ColumnHeader)
If ColumnHeader.Index = 3 And Form.Controls("启动方式").ListIndex = 1 Then
Dim i, Index
Index = IIf(ColumnHeader.Tag = "1", 0, 1)
File.WriteINI AppName, "隐藏密码.Value", Index, config
ColumnHeader.Tag = Index
With Form.Controls("ListView1").object.ListView
For i = 1 To .ListItems.Count
If Index = 1 Then
.ListItems(i).ListSubItems(2).Tag = .ListItems(i).SubItems(2)
.ListItems(i).SubItems(2) = String(Len(.ListItems(i).SubItems(2)), "*")
Else
.ListItems(i).SubItems(2) = .ListItems(i).ListSubItems(2).Tag
End If
Next
End With
End If
End Sub
Public Sub ListView1_ItemEdit(x, y, Obj)
If x = 3 Then
Dim i, v
v = Array(2, "电信", "联通", "电信2", "")
For i = 0 To UBound(v)
Obj(i) = v(i)
Next
End If
End Sub
Public Sub ListView1_DragDrop(Data, Effect, Button, Shift, x, y)
If Data.GetFormat(15) Then Call Import(Data.Files(1))
End Sub
Public Sub ListView1_DragOver(Data, Effect, Button, Shift, x, y)
Effect = Abs(Data.GetFormat(15))
End Sub
Public Sub ListView1_ItemClick(Item)
Dim arr, s, t, i, j
If Globals("QQSpeed").Exists(Item.Index - 1) Then
arr = Globals("QQSpeed").Item(Item.Index - 1)
j = arr(0)(C_WorkProgress) + 1
For i = 1 To UBound(arr)
arr(i) = Join(arr(i))
If i = j Then arr(i) = arr(i) & " <<< " & arr(0)(C_WorkProgress + 2)
Next
t = IIf(arr(0)(C_WorkProgress + 3) And 1, "任务完成", "任务信息")
arr(0) = ""
s = Join(arr, vbCrLf)
With Form.Controls("ListView1").object.ListView
Call Tooptip.Tips(.hWnd, t, s, 0, Item.Top, .Width, Item.Top + Item.Height)
End With
End If
End Sub
Public Sub ListView1_ItemCheck(Item)
If Item.Checked Then
Dim b, arr
If Globals("QQSpeed").Exists(Item.Index - 1) Then
arr = Globals("QQSpeed").Item(Item.Index - 1)
If arr(0)(C_WorkProgress + 3) And 1 Then
b = MsgBox("该账号已经完成！是否重新启动？", 4096 + 4, "账号：" & Item.Index) = 6
If b = False Then
Item.Checked = False
Exit Sub
End If
End If
Else '没有进度
b = True
End If
If b Then
Dim i, j, c, v
With Form.Controls("ListView2").object.ListView
arr = Array(Array(0, Item.SubItems(1), _
IIf(Form.Controls("ListView1").object.ListView.ColumnHeaders(3).Tag = "1" And Form.Controls("启动方式").ListIndex = 1, Item.ListSubItems(2).Tag, Item.SubItems(2)), Item.SubItems(3), _
0, 0, 0, 0)) '进度, 句柄, 局数, 传递
c = .ColumnHeaders.Count
For i = 0 To .ListItems.Count - 1
If .ListItems(i + 1).Checked Then
ReDim v(c)
v(1) = .ListItems(i + 1).Text
For j = 1 To c - 1
v(j + 1) = .ListItems(i + 1).SubItems(j)
Next
j = UBound(arr) + 1
ReDim Preserve arr(j)
arr(j) = v
End If
Next
End With
End If
arr(0)(0) = Api.CreateThread("ThreadStart " & Item.Index - 1)
Globals("QQSpeed").Item(Item.Index - 1) = arr
Item.Tag = arr(0)(0)
ElseIf Api.Val(Item.Tag) Then
Api.StopThread Item.Tag
Item.Tag = ""
End If
End Sub
Public Sub ListView2_ItemClick(Item)
With Form.Controls("ListView2").object.ListView
Call Tooptip.Tips(.hWnd, "测试", "ListView2文本说明", 0, Item.Top, .Width, Item.Top + Item.Height)
End With
End Sub
Public Sub ListView2_ItemChange(x, y, Obj)
Obj.Text = Api.Val(Obj.Text)
If Obj.Text < 0 Then Obj.Text = 0
With Form.Controls("ListView2").object.ListView.ListItems(y)
.Checked = (Obj.Text > 0) Or (.SubItems(IIf(x = 1, 2, 1)) > 0)
File.WriteINI AppName, .Text & IIf(x = 1, ".局数", ".分钟"), Obj.Text, config
End With
End Sub
Public Sub ListView2_ItemEdit(x, y, Obj)
Obj(0) = 1
End Sub
Public Sub ListView2_DragDrop(Data, Effect, Button, Shift, x, y)
Dim i, j, c, arr
With Form.Controls("ListView2").object.ListView
c = .ColumnHeaders.Count + 1
ReDim arr(.ListItems.Count * c - 1)
For i = 0 To .ListItems.Count - 1
arr(i * c) = .ListItems(i + 1).Text
For j = 1 To c - 2
arr(i * c + j) = .ListItems(i + 1).SubItems(j)
Next
arr(i * c + j) = IIf(.ListItems(i + 1).Checked, 1, 0)
Next
End With
File.WriteINI AppName, "ListView2", Join(arr, "|"), config
End Sub
Public Sub ListView2_ItemCheck(Item)
File.WriteINI AppName, Item.Text & ".Value", Item.Checked, config
End Sub
Public Sub ListView2_MouseUp(Button, Shift, x, y)
Dim i, Index
If Button = 2 Then
With Form.Controls("ListView2").object.ListView
Index = Menu.Pop(.hWnd, hMenu2(0), x, y)
If Index = 0 Then Exit Sub
For i = 1 To .ListItems.Count
If Index = 3 Then
.ListItems(i).Checked = Not .ListItems(i).Checked
Else
.ListItems(i).Checked = (Index = 1)
End If
ListView2_ItemCheck .ListItems(i)
Next
End With
End If
End Sub
Public Sub ListView1_MouseUp(Button, Shift, x, y)
Dim i, Index, arr
If Button = 2 Then
With Form.Controls("ListView1").object.ListView
Index = Globals("InGame")
For i = 9 To Api.ECall("user32", "GetMenuItemCount", hMenu1(0))
Call Menu.Set(hMenu1(0), i - 1, IIf(Index > 0, 16, 8), "")
Next
Call Menu.Set(hMenu1(0), i - 2, 1, IIf(Form.Controls("启动方式").ListIndex = 0, "提取名字", "导入文本"))
Index = Menu.Pop(.hWnd, hMenu1(0), x, y)
' Call Menu.Set(hMenu1(0), Index - 1, 1 + 4 + 16, "测试")
' Dim pszText
' pszText = Space(255)
'MsgBox Left(pszText, Api.ECall("user32", "GetMenuStringW", hMenu1(0), Index, pszText, Len(pszText), 0)), , Index
Select Case Index
Case 12
Call ListView1_Clear
Case 14
Dim Names
If Form.Controls("启动方式").ListIndex = 0 Then
Names = GetGameNames("QQ飞车*【*区】*")
If UBound(Names) >= 0 Then
Call ListView1_Clear
End If
For i = 0 To UBound(Names)
.ListItems.Add , , i + 1
.ListItems(i + 1).SubItems(2) = Names(i)
Next
Else
Names = File.Select("请选择QQ账号", "支持文件（*.txt）|*.txt")
If Len(Names) Then Call Import(Names)
End If
Case Else
y = .ListItems.Count
For i = 1 To .ListItems.Count
Select Case Index
Case 1, 2
If .ListItems(i).Selected Then
.ListItems(i).Checked = (Index = 1)
ListView1_ItemCheck .ListItems(i)
End If
Case 4, 5, 6, 7
If Globals("QQSpeed").Exists(i - 1) Then
If Index = 7 Then
Globals("QQSpeed").Remove i - 1
Else
arr = Globals("QQSpeed").Item(i - 1)
If Index = 6 Then
arr(0)(C_WorkProgress + 3) = 1
' arr(0)(C_WorkProgress) = UBound(arr) + 1
ElseIf Index = 5 Then
arr(0)(C_WorkProgress) = arr(0)(C_WorkProgress) + 1
ElseIf arr(0)(C_WorkProgress) > 0 Then
arr(0)(C_WorkProgress) = arr(0)(C_WorkProgress) - 1
End If
Globals("QQSpeed").Item(i - 1) = arr
End If
ElseIf Index = 6 Then
arr = Array(Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
arr(0)(C_WorkProgress + 3) = 1
Globals("QQSpeed").Item(i - 1) = arr
End If
Tip.Tips "更改进度，需要中止后再启动！", "提示"
Case 9 '选择全部'
.ListItems(i).Selected = True
Case 10 '选择反向
.ListItems(i).Selected = Not .ListItems(i).Selected
Case 11
x = y - i + 1
If .ListItems(x).Selected Then .ListItems.Remove x
End Select
Next
End Select
End With
End If
End Sub
Public Sub ListView1_MouseMove(Button, Shift, x, y)
Select Case CLng(x / Globals("Screen").TwipsPerPixelX)
Case &H202 '单击左键，显示窗体
If y = 0 Then
With Form
If .WindowState = 1 Then
.WindowState = 0
.Visible = True
End If
Call Api.ECall("user32", "SetForegroundWindow", .hWnd)
End With
End If
End Select
End Sub
Private Sub ListView1_Clear()
With Form.Controls("ListView1").object.ListView
.ListItems.Clear
Globals("QQSpeed").RemoveAll
End With
End Sub
Private Function GetGameNames(Name)
Dim hWnds, i, v, ret()
hWnds = Window.EnumWindows(0, "GAMEAPP", Name, 2)
If UBound(hWnds) = -1 Then
GetGameNames = Array()
Exit Function
End If
ReDim ret(UBound(hWnds))
For i = 0 To UBound(hWnds)
v = Split(Window.GetText(hWnds(i)), "【")
ret(i) = Left(v(3), InStr(v(3), "】") - 1)
Next
GetGameNames = ret
End Function
Public Sub Form_LoadOver() '防止杀毒 挂起卡住界面'
Dim v, i
If Starting = 0 Then Class_Terminate
Starting = 2
v = Array("http://www.bccn.net/paste/5047", "QQSpeed", 128, _
"ivmowo310ib", "", ".\plugin\dmsoft\dm.dll", "imFbdosa3za", "QMPlugin.bgkms6_10", ".\plugin\bgkms.dll")
i = (UBound(v) + 1) \ 3
Form.Tag = "0/" & i
Me.Caption = " 正在加载数据(0/" & i & ")..."
Form.MousePointer = 13
Form.Tag = HttpLoaderEx(v, Me, "HttpOver") & "/" & i
If Not File.FileExists(".\自定义脚本.js") Then
Api.NewHttp().GetHttpEx "https://www.yuque" & Chr(46) & "com/api/docs/orzzua?book_id=19888673", Array(Me, "ReadMe", ".\自定义脚本.js")
End If
End Sub
Public Sub ReadMe(xmlhttp, Args)
If xmlhttp.ReadyState = 4 Then
' With CreateObject("htmlfile")
' .parentWindow.execScript "iData =" & xmlhttp.responseText
' .Write .parentWindow.iData.data.content
' File.WriteText Args, .body.innerText,,True
' End With
File.WriteTextEx Args, CString.htmlFormat(CString.JsonParse(xmlhttp.ResponseText).Data.content), , "utf-8"
End If
End Sub
Public Sub HttpOver(xmlhttp, Args)
If HttpClass(xmlhttp, Args) Then
Dim v, i
v = Split(Form.Tag, "/")
v(0) = v(0) + 1
Form.Tag = v(0) & "/" & v(1)
Me.Caption = " 正在加载数据(" & Form.Tag & ")..."
If v(0) = Int(v(1)) Then
Me.Caption = "QQ飞车白嫖-粉丝免费使用"
Form.MousePointer = 0
If System.IsUserAnAdmin() = 0 Then
MsgBox "请使用管理员权限打开软件！！！", 4096 + 16, "错误"
End If
Call Form_Event(Form.Controls("启动方式"), &H100 * &H100, 0)
Args = Split(File.ReadINI(AppName, "定时功能", config), "|")
Set v = CString.Array()
For i = 1 To UBound(Args)
If Left(Args(i), 1) = "1" Then
v.push times(File.ReadINI(AppName, Mid(Args(i), 2), config), 0) & "|" & Mid(Args(i), 2)
End If
Next
timing = Api.ArrayFormat(v.sort())
With Form.Controls.Add("VB.Timer", "Timer")
.Interval = 500
.Enabled = True
End With
Form.SetEvent Form.Controls("Timer"), Me, "Timer" '没句柄的对象事件'
' Call Api.Shell("regsvr32 plugin\*.dll /s", 0)
' Call Api.Shell("regsvr32 plugin\*.ocx /s", 0)
v = Array("dmsoft\dm.dll", "bgkms.dll")
On Error Resume Next
For i = 0 To UBound(v)
Call Api.ECall(".\plugin\" & v(i), "DllRegisterServer") '注册插件'
Next
End If
End If
End Sub
Public Property Let Caption(Text)
Call Api.ECall("user32.dll", "SetWindowTextW", Form.hWnd, Text)
End Property
Public Property Get Caption()
Caption = Form.Caption
End Property
Private Function IIf(p, a, b)
If p Then
IIf = a
Else
IIf = b
End If
End Function
Public Sub UnLoad()
Class_Terminate
End Sub
Public Sub Form_Unload(Cancel)
If Globals("InGame") Then Cancel = MsgBox("游戏进行中，确定了要退出？", 4096 + 1, "关闭窗口") - 1
If Cancel = 0 Then '关闭'
End If
End Sub
Private Sub Class_Initialize()
Call Api.ECall("comctl32.dll", "InitCommonControls")
Set Globals("QQSpeed") = CreateObject("Scripting.Dictionary")
Call Create
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Tip.Remove
'Api.UnloadForm Form
Call Api.ECall("kernel32", "TerminateProcess", -1, 0)
End Sub
End Class