‘需要有图片指纹样版,
Option Explicit
'》》》》》》》》》》》》》》》》》》》》》》》》》
'public sealed class SHA512Managed : System.Security.Cryptography.SHA512 'rounddown,roundup,round(2,4)取整
'鼠标光标
Private Type POINTAPI: x As Long: y As Long: End Type '定义坐标点类型
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long '检取光标的位置,以屏幕坐标表示
Private Declare Function SetCursorPos Lib “user32” (ByVal x As Long, ByVal y As Long) As Long '设置光标移动到的位置,以屏幕坐标表示
'》》》》》》》》》》》》》》》》》》》》》》》》》
'坐标转换
Private Declare Function ClientToScreen Lib “user32” (ByVal hWnd As Long, lpPoint As POINTAPI) As Long '客户区坐标到屏幕坐标
Private Declare Function ScreenToClient Lib “user32” (ByVal hWnd As Long, lpPoint As POINTAPI) As Long '屏幕坐标到客户区坐标
Private Declare Function MapWindowPoints Lib “user32” (ByVal hwndFrom As Long, ByVal hwndTo As Long, lpPoint As POINTAPI, ByVal cPoints As Long) As Long '2窗体相比坐标转换’如果lpPoint As POINTAPI,是 lppt As RECT类型,则cPoints=2
'》》》》》》》》》》》》》》》》》》》》》》》》》
'句柄
Private Declare Function GetWindow Lib “user32” (ByVal hWnd As Long, ByVal wCmd As Long) As Long '以句柄找句柄
'hwnd: 窗口句柄
'nCmd:说明指定窗口与要获得句柄的窗口之间的关系 该参数值可以是下列之一:
'GW_CHILD(&H5):如果指定窗口是父窗口,则获得的是在Tab序顶端的子窗口的句柄,否则为NULL 函数仅检查指定父窗口的子窗口,不检查继承窗口
'GW_ENABLEDPOPUP(&H6):(WindowsNT 5.0)返回的句柄标识了属于指定窗口的处于使能状态弹出式窗口(检索使用第一个由GW_HWNDNEXT 查找到的满足前述条件的窗口);如果无使能窗口,则获得的句柄与指定窗口相同
'GW_HWNDFIRST(&H0):返回的句柄标识了在Z序最高端的相同类型的窗口 如果指定窗口是最高端窗口,则该句柄标识了在Z序最高端的最高端窗口;如果指定窗口是顶层窗口,则该句柄标识了在z序最高端的顶层窗口:如果指定窗口是子窗口,则句柄标识了在Z序最高端的同属窗口
'GW_HWNDLAST(&H1):返回的句柄标识了在z序最低端的相同类型的窗口 如果指定窗口是最高端窗口,则该柄标识了在z序最低端的最高端窗口:如果指定窗口是顶层窗口,则该句柄标识了在z序最低端的顶层窗口;如果指定窗口是子窗口,则句柄标识了在Z序最低端的同属窗口
'GW_HWNDNEXT(&H2):返回的句柄标识了在Z序中指定窗口下的相同类型的窗口 如果指定窗口是最高端窗口,则该句柄标识了在指定窗口下的最高端窗口:如果指定窗口是顶层窗口,则该句柄标识了在指定窗口下的顶层窗口;如果指定窗口是子窗口,则句柄标识了在指定窗口下的同属窗口
'GW HWNDPREV(&H3):返回的句柄标识了在Z序中指定窗口上的相同类型的窗口 如果指定窗口是最高端窗口,则该句柄标识了在指定窗口上的最高端窗口;如果指定窗口是顶层窗口,则该句柄标识了在指定窗口上的顶层窗口;如果指定窗口是子窗口,则句柄标识了在指定窗口上的同属窗口
'GW_OWNER(&H4):返回的句柄标识了指定窗口的所有者窗口(如果存在) GW_OWNER与GW_CHILD不是相对的参数,没有父窗口的含义,如果想得到父窗口请使用GetParent()
Private Declare Function GetForegroundWindow Lib “user32” () As Long '返回当前激活窗口的句柄
Private Declare Function WindowFromPoint Lib “user32” (ByVal xPoint As Long, ByVal yPoint As Long) As Long '获得指定坐标下窗口句柄的函数
Private Declare Function MoveWindow Lib “user32” (ByVal hWnd As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long '调整移动窗体
Private Declare Function FindWindow Lib “user32” Alias “FindWindowA” (ByVal lpclassname As String, ByVal lpWindowName As String) As Long '获得指定类型,标题名的窗体句柄
'lpClassName如果该参数为null时,将会寻找任何与lpWindowName参数匹配的窗口 lpWindowName指向一个以NULL字符结尾的 用来指定窗口名(即窗口标题)的字符串 如果此参数为NULL,则匹配所有窗口名
Private Declare Function GetParent Lib “user32” (ByVal hWnd As Long) As Long '获父窗句柄
Private Declare Function FindWindowEx Lib “user32” Alias “FindWindowExA” _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long ’
'hwndParent:要查找的子窗口所在的父窗口的句柄(如果设置了hwndParent,则表示从这个hwndParent指向的父窗口中搜索子窗口)
'(1)如果hwndParent为 0 ,则函数以桌面窗口为父窗口,查找桌面窗口的所有子窗口
'如果hwndParent是HWND_MESSAGE,函数仅查找所有消息窗口
'(2)hwndChildAfter :子窗口句柄 查找从在Z序中的下一个子窗口开始 子窗口必须为hwndParent窗口的直接子窗口而非后代窗口 如果HwndChildAfter为NULL,查找从hwndParent的第一个子窗口开始 如果hwndParent 和 hwndChildAfter同时为NULL,则函数查找所有的顶层窗口及消息窗口
'(3)lpszClass:指向一个指定了类名的空结束字符串 如果该参数为一个成员
'(4)lpszWindow:指向一个指定了窗口名(窗口标题)的空结束字符串 如果该参数为 NULL,则为所有窗口全匹配
Private Declare Function GetWindowText Lib “user32” Alias “GetWindowTextA” _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long '声明句柄标题GetWindowText,如句柄不存在则返回0
Private Declare Function GetClassName Lib “user32” Alias “GetClassNameA” _
(ByVal hWnd As Long, ByVal lpclassname As String, ByVal nMaxCount As Long) As Long '声明句柄类型ClassName,如句柄不存在则返回0
'》》》》》》》》》》》》》》》》》》》》》》》》》
'窗 体
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type
Private Declare Function GetClientRect Lib “user32” (ByVal hWnd As Long, lpRect As RECT) As Long '取窗体大小位置,客户区绝对值
Private Declare Function GetWindowRect Lib “user32” (ByVal hWnd As Long, ByRef lpRect As RECT) As Long '取窗体大小位置,整个屏相对值
Private Declare Function SetForegroundWindow Lib “user32” (ByVal hWnd As Long) As Long '激活该窗口
Private Declare Function IsWindowVisible Lib “user32” (ByVal hWnd As Long) As Long '窗体可见,如窗口可见则返回TRUE(非零)
Private Declare Function FlashWindow Lib “user32” (ByVal hWnd As Long, ByVal bInvert As Long) As Long '闪烁显示的窗口
'Long,如窗口在调用前处于活动状态,则返回TRUE(非零) hwnd:Long,要闪烁显示的窗口的句柄 Invert:Long,TRUE(非零)表示切换窗口标题;FALSE返回最初状态
Private Declare Function SetWindowPos Lib “user32” (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'》》》》》》》》》》》》》》》》》》》》》》》》》
'画线与取色
Private Declare Function WindowFromDC Lib “user32” (ByVal hdc As Long) As Long '取回与某一设备场景相关的窗口的句柄
Private Declare Function GetWindowDC Lib “user32” (ByVal hWnd As Long) As Long '画线设备场景设定参照屏全屏句柄声明
Private Declare Function GetDCEx Lib “user32” (ByVal hWnd As Long, ByVal hrgnclip As Long, ByVal fdwOptions As Long) As Long '画线设备场景设定参照屏客户屏句柄声明,可无视子窗
Private Declare Function GetDC Lib “user32” (ByVal hWnd As Long) As Long '画线设定参照屏客户屏句柄声明
Private Declare Function ReleaseDC Lib “user32” (ByVal hWnd As Long, ByVal hdc As Long) As Long '释放DC参照屏,每次设定后要释放
Private Declare Function LineTo Lib “gdi32” (ByVal hdc As Long, ByVal nXEnd As Long, ByVal nYEnd As Long) As Long '画线声明
Private Declare Function GetPixel Lib “gdi32” (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long '取色
Private Declare Function SetPixel Lib “gdi32” (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal z As Long) As Long '着色
Private Declare Function StretchBlt Lib “gdi32” _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateRectRgn Lib “gdi32” (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'[说明]创建一个由点X1,Y1和X2,Y2描述的矩形区域
'》》》》》》》》》》》》》》》》》》》》》》》》》
'时间
Private Declare Function timeGetTime Lib “winmm.dll” () As Long '声明timeGetTime时间,电脑开机时长毫秒
Private Declare Sub Sleep Lib “kernel32.dll” (ByVal dwMilliseconds As Long) '程序暂停时长毫秒
'Sheet1.Cells(11, 4) = Format(time_use, “hh:mm:ss”)
'》》》》》》》》》》》》》》》》》》》》》》》》》
'发消息
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '声明发消息SendMessage
Private Declare Function PostMessage Lib “user32” Alias “PostMessageA” (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '声明发消息PostMessage
Private Const WM_LBUTTONDOWN = &H201 '按下鼠标左键
Private Const WM_LBUTTONUP = &H202 '释放鼠标左键
Private Const WM_SYSKEYDOWN = &H104 '表示一个系统键被按下,比如Alt键
Private Const WM_SYSKEYUP = &H105 '表示一个系统键被释放,比如Alt键
Private Const WM_KEYDOWN = &H100 '表示一个普通键被按下
Private Const WM_KEYUP = &H101 '表示一个普通键被释放
Private Const WM_SYSCOMMAND = &H112 '表示“常数键”被按下,
Private Const WM_COMMAND = &H111 '表示“常数键”被释放,
Private Const SC_CLOSE = &HF060& '关闭窗体0
Private Const SC_MINIMIZE = &HF020& '最小化窗体1
Private Const SC_MAXIMIZE = &HF030& '最大化窗体2
Private Const SC_RESTORE = &HF120& '恢复窗体大小 3
'显示消息
'Private Declare PtrSafe Function MsgBoxEx Lib “user32” Alias “MessageBoxTimeoutA” _
(ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As _
VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long '声明MsgBoxEx
Private Declare Function MsgBoxEx Lib “user32” Alias “MessageBoxTimeoutA” _
(ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As _
VbMsgBoxStyle, ByVal wlange As Long, ByVal dwTimeout As Long) As Long '声明MsgBoxEx
'hwnd:窗口句柄,可以设为0, lpText:消息框显示内容,类似于MsgBox函数的第一个参数Prompt,lpCaption:消息框标题,类似于MsgBox函数的第三个参数Caption
’ wType:消息框类型,类似于MsgBox函数的第二个参数Buttons, wlange:不是太明白这个参数,0或者1都看不出什么差别, dwTimeout:延时时间,单位是毫秒
'》》》》》》》》》》》》》》》》》》》》》》》》》
#If Win64 Then
Private Declare PtrSafe Sub SetThreadExecutionState Lib “kernel32” (ByVal esFlags As Long) '取消休眠
#Else
Private Declare Sub SetThreadExecutionState Lib “kernel32” (ByVal esFlags As Long) '取消休眠
#End If
Private Enum Execution_State '取消休眠
ES_SYSTEM_REQUIRED = &H1
ES_DISPLAY_REQUIRED = &H2
ES_AWAYMODE_REQUIRED = &H4
ES_CONTINUOUS = &H80000000
End Enum
'取消休眠需要执行的代码>>>>>>
'SetThreadExecutionState Execution_State.ES_SYSTEM_REQUIRED Or _
Execution_State.ES_DISPLAY_REQUIRED Or _
Execution_State.ES_CONTINUOUS '取消休眠
'SetThreadExecutionState Execution_State.ES_CONTINUOUS '启用休眠
'>>>>>>>>>>
'// BitBlt API dwRop parameter constants
Private Const SRCAND = &H8800C6 ’ (DWORD) dest = source AND dest
Private Const SRCCOPY = &HCC0020 ’ (DWORD) dest = source
Private Const SRCERASE = &H440328 ’ (DWORD) dest = source AND (NOT dest )
Private Const SRCINVERT = &H660046 ’ (DWORD) dest = source XOR dest
Private Const SRCPAINT = &HEE0086 ’ (DWORD) dest = source OR dest
Private Const SRCMERGEPAINT = &HBB0226
Private Const SRCDSNA = &H220326
'// CombineRgn API nCombineMode parameter constants
Private Const RGN_AND = 1&
Private Const RGN_OR = 2&
Private Const RGN_XOR = 3&
Private Const RGN_DIFF = 4&
Private Const RGN_COPY = 5&
'// SetStretchBltMode API nStretchMode parameter constants
Private Const STRETCH_ANDSCANS = 1
Private Const STRETCH_ORSCANS = 2
Private Const STRETCH_DELETESCANS = 3
Private Const STRETCH_HALFTONE = 4
'————————————————
Private Declare Function StretchDIBits Lib “gdi32” _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, _
lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib “gdi32” (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
'载屏另存
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Private Const OBJ_BITMAP As Long = 7
'Private Const SRCCOPY = &HCC0020
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
'Dim bi24BitInfo As BITMAPINFO
Private aBytes() As Byte
'Dim BMPbyte(0 To 53) As Byte
Private Declare Function GetCurrentObject Lib “gdi32.dll” _
(ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetDIBits Lib “gdi32” _
(ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function DeleteObject Lib “gdi32” (ByVal hObject As Long) As Long
Private Declare Function PrintWindow Lib “user32” (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long
Private Declare Function SelectObject Lib “gdi32” _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib “gdi32” (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib “gdi32” (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib “gdi32” _
(ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)
'公用函数
Function 休眠(开启 As Boolean) 'ok
If 开启 = False Then
SetThreadExecutionState Execution_State.ES_SYSTEM_REQUIRED Or _
Execution_State.ES_DISPLAY_REQUIRED Or _
Execution_State.ES_CONTINUOUS '取消休眠
ElseIf 开启 = True Then
SetThreadExecutionState Execution_State.ES_CONTINUOUS '启用休眠
End If
End Function
Function 弹窗(s_hint As String, t As Long) 'ok
Dim tt As Long
If t > 0 Then tt = t Else: tt = 1000
MsgBoxEx GetForegroundWindow, s_hint, “弹窗提示”, 1, 0, tt
End Function
'可用保留
Function 语音(s_Speak As String) 'ok
DoEvents
Application.Speech.Speak (s_Speak)
VBA.DoEvents
End Function
Function 定时分秒(nt As Double, st As Double) '定时分秒
Dim Savetime As Double, endtime As Double
Savetime = timeGetTime '记下开始时的时间,电脑开机时长
endtime = timeGetTime + (60 * nt + st) * 1000 '记下要结束的时间,电脑开机时长后nt分钟
Do While timeGetTime < endtime '循环等待
DoEvents '转让控制权,以便让操作系统处理其它的事件
Loop
End Function
Function 定时毫秒(n_mt As Long) '定时分秒
Dim Savetime As Double, endtime As Double
Savetime = timeGetTime '记下开始时的时间,电脑开机时长
endtime = timeGetTime + n_mt '记下要结束的时间,电脑开机时长后nt分钟
Do While timeGetTime < endtime '循环等待
DoEvents '转让控制权,以便让操作系统处理其它的事件
Loop
End Function
Private Function 初始化24位BMP信息头(x_w As Long, y_h As Long, bi24BitInfo As BITMAPINFO, BMPbyte() As Byte) As BITMAPINFO
'Dim bi24BitInfo As BITMAPINFO
'Private aBytes() As Byte
ReDim BMPbyte(0 To 53) As Byte
Dim w As Long, h As Long, r As Long, Bmplen As Long
w = x_w: h = y_h
If w Mod 4 > 0 Then
w = w + 4 - (w Mod 4)
End If ’
With bi24BitInfo.bmiHeader '初始化24位BMP信息头
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = w
.biHeight = h
.biSizeImage = 3 * (w) * (h)
End With
Bmplen = (w) * (h) * 3 + 54
'以下初始化BMP文件头信息到字节数组文件头 + 位图信息 + 位图像素数据
BMPbyte(0) = 66
BMPbyte(1) = 77
CopyMemory BMPbyte(2), Bmplen, 4 'bfSize As Long文件长 2-5
CopyMemory BMPbyte(6), 0, 4 'bfReserved1,2 As Integer 6-9
BMPbyte(8) = 0
BMPbyte(9) = 0
CopyMemory BMPbyte(10), 54, 4 'bfOffBits As Long 10-13
BMPbyte(12) = 0
BMPbyte(13) = 0
''以上文件头****************************************
CopyMemory BMPbyte(14), bi24BitInfo.bmiHeader.biSize, 4 'biSize As Long 14-17
CopyMemory BMPbyte(18), bi24BitInfo.bmiHeader.biWidth, 4 'biWidth As Long 18-21
CopyMemory BMPbyte(22), bi24BitInfo.bmiHeader.biHeight, 4 'biHeight As Long 22-25
CopyMemory BMPbyte(26), bi24BitInfo.bmiHeader.biPlanes, 2 'biPlanes As Integer 26-27
CopyMemory BMPbyte(28), 24, 2 'biBitCount As Integer 28-29,真彩24位色
CopyMemory BMPbyte(30), bi24BitInfo.bmiHeader.biCompression, 4 'biCompression As Long 30-33
CopyMemory BMPbyte(34), bi24BitInfo.bmiHeader.biSizeImage, 4 'biSizeImage As Long 34-37
'CopyMemory BMPbyte(38), bi24BitInfo.bmiHeader.biXPelsPerMeter, 4 'biXPelsPerMeter As Long 38-41
For r = 38 To 53
BMPbyte® = 0
Next
''以上写位图信息******************************************
'On Error Resume Next
End Function
Public Function 新简_TOTAL_后台截图_HASH(ByVal hwnd_1 As Variant, ByVal hwnd_2 As Variant, PathFile As Variant, n_hx As Long, _
取位_起点长宽() As Long, n_do_q As Long, n_do_z As Long, hash_局部 As Variant) As Long ’
'PathFile_0 = PathFile
Dim 存图 As Boolean: If Len(PathFile) > 2 Then 存图 = True
'存图 = True
Dim PathFile_0 As String: PathFile_0 = “D:\TOTAL_原图800X400.JPG”
Dim PathFile_3 As String: PathFile_3 = “D:\TOTAL_截单800X900.JPG”
Dim PathFile_2 As String: PathFile_2 = “D:\TOTAL_截单80X90.JPG”
Dim 转色存 As Boolean: 转色存 = True: 转色存 = False
Dim sn As Long: sn = 4
Dim 类_1 As String: 类_1 = “SunAwtFrame”
Dim 名_1 As String: 名_1 = “SAMSUNG-SM-N9600 (非商业用途)”
Dim do_hwnd As Long, do_hwnd_1 As Long, do_hwnd_2 As Long
do_hwnd = FindWindow(类_1, 名_1)
do_hwnd_1 = GetParent(do_hwnd)
If do_hwnd_1 > 0 Then
do_hwnd_2 = do_hwnd
Else
do_hwnd_2 = FindWindowEx(do_hwnd, 0, vbNullString, vbNullString)
If do_hwnd_2 > 0 Then
do_hwnd_1 = do_hwnd
End If
End If
hwnd_1 = do_hwnd_1
hwnd_2 = do_hwnd_2
Dim hWndTarget As Long
hWndTarget = hwnd_1
If hwnd_1 = 0 Or hwnd_2 = 0 Then
MsgBoxEx GetForegroundWindow, “后台截图 = 0”, “弹窗提示”, 1, 0, 2000 '1000毫秒
Exit Function
End If
Dim n As Long, n_0 As Long, n_1 As Long, n_2 As Long, n_3 As Long
Dim i As Long, i_0 As Long, i_1 As Long, i_2 As Long, i_3 As Long
Dim r As Long, r_0 As Long, r_1 As Long, r_2 As Long, r_3 As Long
Dim x As Long, x_0 As Long, x_1 As Long, x_2 As Long, x_3 As Long, x_q As Long
Dim y As Long, y_0 As Long, y_1 As Long, y_2 As Long, y_3 As Long, y_q As Long
Dim n_x As Long, n_y As Long, d_x As Double, d_y As Double
Dim n_n_x As Long, n_n_y As Long, h_n_x As Long, h_n_y As Long
Dim bgr_b As Long, bgr_g As Long, bgr_r As Long, bgr As Long
Dim xy_1 As POINTAPI, xy_2 As POINTAPI, xy_3 As POINTAPI, xy_4 As POINTAPI
Dim rc As RECT, rc_1 As RECT, rc_2 As RECT
Dim mDC(0 To 5) As Long, nDC(0 To 5) As Long, mBmp(0 To 5) As Long
Dim oldBmp(0 To 5) As Long, iBitmap(0 To 5) As Long
Dim w(0 To 5) As Long, h(0 To 5) As Long
Dim x_w As Long, y_h As Long
Dim x_w_in As Long, y_h_in As Long
Dim x_w_to As Long, y_h_to As Long
Dim jiben_long As Long: jiben_long = 400
GetWindowRect hWndTarget, rc '得到句柄窗口的矩形位置,大小
If (rc.Right - rc.Left) Mod 4 > 0 Then
x_w = rc.Right - rc.Left - ((rc.Right - rc.Left) Mod 4) + 4
Else
x_w = rc.Right - rc.Left
End If
y_h = rc.Bottom - rc.Top
i = -((rc.Right - rc.Left) Mod 4) + 4
'rounddown,roundup,round(2,4)取整
If x_w > y_h Then ’
n = Application.WorksheetFunction.RoundUp(y_h / jiben_long, 0)
w(0) = 2 * n * jiben_long: h(0) = n * jiben_long
n_n_x = 20: n_n_y = 10
Else
n = Application.WorksheetFunction.RoundUp(x_w / jiben_long, 0)
w(0) = n * jiben_long: h(0) = 2 * n * jiben_long
n_n_x = 10: n_n_y = 20
End If
w(1) = 8: h(1) = 9
w(2) = 80: h(2) = 90
d_x = w(0) / n_n_x
d_y = h(0) / n_n_y
h_n_x = 8
h_n_y = 9
x_w = w(0)
y_h = h(0)
nDC(0) = GetDC(hWndTarget) '得到指定窗口句柄DC
mDC(0) = CreateCompatibleDC(nDC(0)) '创建内存DC
mBmp(0) = CreateCompatibleBitmap(nDC(0), x_w, y_h)
oldBmp(0) = SelectObject(mDC(0), mBmp(0)) '把窗口位图选入内存DC
iBitmap(0) = GetCurrentObject(mDC(0), OBJ_BITMAP) '用于获得指定类型的当前选定对象
PrintWindow hWndTarget, mDC(0), 0 '把窗口截取保存到内存DC中,
Call GetClientRect(hwnd_2, rc_2) '取窗体边标
xy_1.x = rc_2.Left
xy_2.x = rc_2.Right
xy_1.y = rc_2.Top
xy_2.y = rc_2.Bottom
Call MapWindowPoints(hwnd_2, hwnd_1, xy_1, 1) '转换坐标
Call MapWindowPoints(hwnd_2, hwnd_1, xy_2, 1) '转换坐标
x_w_to = x_w
y_h_to = y_h
x_w_in = (xy_2.x - xy_1.x)
y_h_in = (xy_2.y - xy_1.y)
x_q = xy_1.x
y_q = xy_1.y
Call SetStretchBltMode(mDC(0), 4) 'BLACKONWHITE’COLORONCOLOR
Call StretchBlt(mDC(0), 0, 0, x_w_to, y_h_to, _
mDC(0), x_q, y_q, x_w_in, y_h_in, SRCCOPY)
If 存图 = True Then '存原整图
Dim bi24BitInfo_0 As BITMAPINFO
Dim BMPbyte_0() As Byte
Call 初始化24位BMP信息头(x_w, y_h, bi24BitInfo_0, BMPbyte_0())
ReDim aBytes_0(0 To (x_w) * (y_h) * 3 - 1) As Byte
GetDIBits mDC(0), iBitmap(0), 0, y_h, aBytes_0(0), bi24BitInfo_0, DIB_RGB_COLORS
If n_hx = 0 Then ''划格
’ '划20格x线
For n_x = 0 To n_n_x - 1
x = Int(d_x * n_x)
For y = 0 To y_h - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_0(i) = 0 'b
aBytes_0(i + 1) = 0 'g
aBytes_0(i + 2) = 255 'r
Next y
Next n_x
'划10格y线
For n_y = 0 To n_n_y - 1
y = Int(d_y * n_y)
For x = 0 To x_w - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_0(i) = 0 'b
aBytes_0(i + 1) = 255 'g
aBytes_0(i + 2) = 255 'r
Next x
Next n_y
ElseIf n_hx = 1 Then
'划0.5格x线
For n_x = 0 To n_n_x - 1
x = Int(d_x * (0.5 + n_x))
For y = 0 To y_h - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_0(i) = 0 'b
aBytes_0(i + 1) = 255 'g
aBytes_0(i + 2) = 0 'r
Next y
Next n_x
'划0.5格y线
For n_y = 0 To n_n_y - 1
y = Int(d_y * (0.5 + n_y))
For x = 0 To x_w - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_0(i) = 255 'b
aBytes_0(i + 1) = 0 'g
aBytes_0(i + 2) = 0 'r
Next x
Next n_y
End If ‘n_hx=0,n_hx=1’'划格
Open PathFile_0 For Binary As #1
Put #1, , BMPbyte_0()
Put #1, , aBytes_0()
Close #1
Erase aBytes_0
Erase BMPbyte_0
End If 'If 存图 = True Then '存原整图
'取截局部图
x_w = h_n_x: y_h = h_n_y
mDC(1) = CreateCompatibleDC(nDC(0)) '创建内存DC
mBmp(1) = CreateCompatibleBitmap(nDC(0), x_w, y_h)
oldBmp(1) = SelectObject(mDC(1), mBmp(1)) '把窗口位图选入内存DC
iBitmap(1) = GetCurrentObject(mDC(1), OBJ_BITMAP) '用于获得指定类型的当前选定对象
Call SetStretchBltMode(mDC(1), 4) 'BLACKONWHITE’COLORONCOLOR
ReDim hash_局部(n_do_q To n_do_z) As String
Dim L_s_hash As String
x_w_to = x_w
y_h_to = y_h
For n = n_do_q To n_do_z
x_q = 取位_起点长宽(n, 1) * d_x
y_q = 取位_起点长宽(n, 2) * d_y
x_w_in = 取位_起点长宽(n, 3) * d_x
y_h_in = 取位_起点长宽(n, 4) * d_y
Call StretchBlt(mDC(1), 0, 0, x_w_to, y_h_to, _
mDC(0), x_q, y_q, x_w_in, y_h_in, SRCCOPY)
Dim bi24BitInfo_1 As BITMAPINFO
Dim BMPbyte_1() As Byte
Call 初始化24位BMP信息头(x_w, y_h, bi24BitInfo_1, BMPbyte_1())
ReDim aBytes_1(0 To (x_w) * (y_h) * 3 - 1) As Byte
GetDIBits mDC(1), iBitmap(1), 0, y_h, aBytes_1(0), bi24BitInfo_1, DIB_RGB_COLORS
ReDim 灰度化(0 To h_n_x - 1, 0 To h_n_y - 1) As Long
For x = 0 To h_n_x - 1
For y = 0 To h_n_y - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
bgr_b = aBytes_1(i)
bgr_g = aBytes_1(i + 1)
bgr_r = aBytes_1(i + 2)
bgr = Round((bgr_b * 11 + bgr_g * 59 + bgr_r * 30) / 100, 0)
bgr = Int(bgr / sn) * sn
灰度化(x, y) = bgr
Sheet5.Cells(y + 2, x + 2) = bgr
Next y
Next x
'求HASH
ReDim x_hash(0 To h_n_x - 1) As String
L_s_hash = “”
For x = 0 To h_n_x - 1
For y = 1 To h_n_y - 1
If 灰度化(x, y) > 灰度化(x, y - 1) Then
x_hash(x) = x_hash(x) & “1”
Else
x_hash(x) = x_hash(x) & “0”
End If
Next y
x_hash(x) = Application.WorksheetFunction.Bin2Hex(x_hash(x), 2)
L_s_hash = L_s_hash & x_hash(x)
Next x
hash_局部(n) = L_s_hash
Next n
Erase aBytes_1
Dim out_y As Long: out_y = 1
Sheet2.Cells(out_y, 1) = “(n_n)”
Sheet2.Cells(out_y, 2) = “hash_名(n)”
Sheet2.Cells(out_y, 3) = “hash_样(n)”
Sheet2.Cells(out_y, 4) = “空”
Sheet2.Cells(out_y, 5) = “hash_局部(n)”
Sheet2.Cells(out_y, 6) = “空”
Sheet2.Cells(out_y, 7) = “差异度”
For n = n_do_q To n_do_z
out_y = n + 1
Sheet2.Cells(out_y, 1) = n
'Sheet2.Cells(out_y, 2) = “hash_名(n)”
'Sheet2.Cells(out_y, 3) = “hash_样(n)”
Sheet2.Cells(out_y, 4) = “”
Sheet2.Cells(out_y, 5) = hash_局部(n)
’ Sheet2.Cells(out_y, 6) = “”
If hash_局部(n) = “” Or Sheet2.Cells(out_y, 3) = “” Then
Sheet2.Cells(out_y, 7) = 0
Else
Sheet2.Cells(out_y, 7) = 指纹对比_差异度(hash_局部(n), Sheet2.Cells(out_y, 3))
End If
Next n
If 存图 = True Then '存hash大图
'存截800*900
x_w = 800: y_h = 900
x_w_to = x_w
y_h_to = y_h
mDC(3) = CreateCompatibleDC(nDC(0)) '创建内存DC
mBmp(3) = CreateCompatibleBitmap(nDC(0), x_w, y_h)
oldBmp(3) = SelectObject(mDC(3), mBmp(3)) '把窗口位图选入内存DC
iBitmap(3) = GetCurrentObject(mDC(3), OBJ_BITMAP) '用于获得指定类型的当前选定对象
Call SetStretchBltMode(mDC(3), 4) 'BLACKONWHITE’COLORONCOLOR
Call StretchBlt(mDC(3), 0, 0, x_w_to, y_h_to, _
mDC(0), x_q, y_q, x_w_in, y_h_in, SRCCOPY)
Dim bi24BitInfo_3 As BITMAPINFO
Dim BMPbyte_3() As Byte
Call 初始化24位BMP信息头(x_w, y_h, bi24BitInfo_3, BMPbyte_3())
ReDim aBytes_3(0 To (x_w) * (y_h) * 3 - 1) As Byte
GetDIBits mDC(3), iBitmap(3), 0, y_h, aBytes_3(0), bi24BitInfo_3, DIB_RGB_COLORS
'灰度化
For i = 0 To (x_w) * (y_h) * 3 - 1 Step 3
bgr_b = aBytes_3(i)
bgr_g = aBytes_3(i + 1)
bgr_r = aBytes_3(i + 2)
bgr = Round((bgr_b * 11 + bgr_g * 59 + bgr_r * 30) / 100, 0)
bgr = Int(bgr / sn) * sn
aBytes_3(i) = bgr 'b
aBytes_3(i + 1) = bgr 'g
aBytes_3(i + 2) = bgr 'r
Next i
For n_x = 0 To h_n_x - 1
x = Int(100 * n_x)
For y = 0 To y_h - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_3(i) = 0 'b
aBytes_3(i + 1) = 0 'g
aBytes_3(i + 2) = 255 'r
Next y
Next n_x
'划10格y线
For n_y = 0 To h_n_y - 1
y = Int(100 * n_y)
For x = 0 To x_w - 1
i = 3 * ((y_h - y - 1) * (x_w) + x)
aBytes_3(i) = 0 'b
aBytes_3(i + 1) = 255 'g
aBytes_3(i + 2) = 255 'r
Next x
Next n_y
PathFile_3 = “D:\TOTAL_” & n_do_z & “_截单800X900.JPG”
Open PathFile_3 For Binary As #1
Put #1, , BMPbyte_3()
Put #1, , aBytes_3()
Close #1
Erase aBytes_3
Erase BMPbyte_3
x_w_in = h_n_x: y_h_in = h_n_y
x_w_to = w(2): y_h_to = h(2)
x_w = w(2): y_h = h(2)
mDC(2) = CreateCompatibleDC(nDC(0)) '创建内存DC
mBmp(2) = CreateCompatibleBitmap(nDC(0), x_w, y_h)
oldBmp(2) = SelectObject(mDC(2), mBmp(2)) '把窗口位图选入内存DC
iBitmap(2) = GetCurrentObject(mDC(2), OBJ_BITMAP) '用于获得指定类型的当前选定对象
Call SetStretchBltMode(mDC(2), 4) 'BLACKONWHITE’COLORONCOLOR
Call StretchBlt(mDC(2), 0, 0, x_w_to, y_h_to, _
mDC(1), 0, 0, x_w_in, y_h_in, SRCCOPY)
Dim bi24BitInfo_2 As BITMAPINFO
Dim BMPbyte_2() As Byte
Call 初始化24位BMP信息头(x_w, y_h, bi24BitInfo_2, BMPbyte_2())
ReDim aBytes_2(0 To (x_w) * (y_h) * 3 - 1) As Byte
GetDIBits mDC(2), iBitmap(2), 0, y_h, aBytes_2(0), bi24BitInfo_2, DIB_RGB_COLORS
'灰度化
For i = 0 To (x_w) * (y_h) * 3 - 1 Step 3
bgr_b = aBytes_2(i)
bgr_g = aBytes_2(i + 1)
bgr_r = aBytes_2(i + 2)
bgr = Round((bgr_b * 11 + bgr_g * 59 + bgr_r * 30) / 100, 0)
bgr = Int(bgr / sn) * sn
aBytes_2(i) = bgr 'b
aBytes_2(i + 1) = bgr 'g
aBytes_2(i + 2) = bgr 'r
Next i
PathFile_2 = “D:\TOTAL_” & n_do_z & “_截单80X90.JPG”
Open PathFile_2 For Binary As #1
Put #1, , BMPbyte_2()
Put #1, , aBytes_2()
Close #1
Erase aBytes_2
Erase BMPbyte_2
End If 'If 存图 = True Then '存hash大图
For i = 0 To 3
DeleteObject iBitmap(i)
DeleteObject mBmp(i)
DeleteObject oldBmp(i)
DeleteDC mDC(i)
Next i
ReleaseDC hWndTarget, nDC(0)
'DeleteDC nDC(0)
End Function
Function 指纹对比_差异度(s_1 As Variant, s_2 As Variant) As Long '取指定句柄窗体图形指纹
Dim n As Long, n_1 As Long, n_2 As Long, n_3 As Long
n_1 = Len(s_1)
n_2 = Len(s_2)
If n_1 * n_2 = 0 Or n_1 <> n_2 Then
指纹对比_差异度 = 16
Else
n = 0
For n_3 = 1 To n_2
If Mid(s_1, n_3, 1) <> Mid(s_2, n_3, 1) Then
n = n + 1
End If
Next n_3
指纹对比_差异度 = n
'指纹对比_差异度 = Round(100 * n / n_2, 0)
End If
End Function
Function 发送窗体XY点单击(hWnd As Long, x As Long, y As Long) '向指定句柄窗体XY发送模拟单击
Dim hwndXY As Long '用于储存计算后PostMessage所用的坐标
hwndXY = x + y * 65536
Call PostMessage(hWnd, WM_LBUTTONDOWN, 0, hwndXY)
Call PostMessage(hWnd, WM_LBUTTONUP, 0, hwndXY)
End Function
Function 画窗体范围(hWnd As Long, n As Long)
Dim lrtb As RECT, xq As Long, xz As Long, yq As Long, yz As Long, xxyy As POINTAPI
’ Call GetClientRect(hWnd, lrtb)
Dim xd As Long, yd As Long, hdc As Long, m As Long
Call GetWindowRect(hWnd, lrtb)
xq = lrtb.Left
xz = lrtb.Right
yq = lrtb.Top
yz = lrtb.Bottom
xxyy.x = lrtb.Left
xxyy.y = lrtb.Top
’ Call ClientToScreen(hwnd, xxyy)
xq = xxyy.x
yq = xxyy.y
’ hdc = GetDCEx(hWnd, 0, DCX_CACHE)
xd = (xz + xq) \ 2
yd = (yz + yq) \ 2
’ hdc = GetDC(hWnd)
hdc = GetDC(0)
’ hdc = GetWindowDC(hwnd)
Do While m < n
LineTo hdc, xq, yd
LineTo hdc, xz, yd
LineTo hdc, xz, yq
LineTo hdc, xq, yq
LineTo hdc, xq, yz
LineTo hdc, xz, yz
LineTo hdc, xz, yq
LineTo hdc, xd, yq
LineTo hdc, xd, yz
m = m + 1
DoEvents '转让控制权,以便让操作系统处理其它的事件
Loop
ReleaseDC 0, hdc
End Function
Function total_control_点击(hWnd As Long, x As Long, y As Long)
Dim xy_1 As POINTAPI
xy_1.x = x
xy_1.y = y
Call ClientToScreen(hWnd, xy_1)
Call 发送窗体XY点单击(hWnd, xy_1.x, xy_1.y)
End Function
Private Sub 对屏刷金_Click()
Dim n_局 As Long, n_局数 As Long: n_局数 = Sheet1.Cells(2, 4)
Dim n_砖 As Long: n_砖 = Sheet1.Cells(2, 2)
Dim n_葵 As Long: n_葵 = Sheet1.Cells(2, 3)
Dim n_种 As Long: n_种 = 1
Dim n_n_y_q As Long: n_n_y_q = 1 '刷金
Dim n_n_y_z As Long: n_n_y_z = 11 ’ 刷金
Call 休眠(False) 'ok’无尽
Dim t_q As Long, t_z As Long, t_sum As Long
Dim t_1 As Long, t_2 As Long, t_12 As Long, n As Long
Dim xy_1 As POINTAPI, xy_2 As POINTAPI
Dim do_hwnd As Long, do_hwnd_1 As Long, do_hwnd_2 As Long, hdc As Long
Dim i As Long, i_1 As Long, i_2 As Long, i_x As Double, i_y As Double
Dim x As Long, y As Long, n_x As Long, n_y As Long, d_x As Long, d_y As Long
Dim x_1 As Long, y_1 As Long, x_2 As Long, y_2 As Long, x_3 As Long, y_3 As Long
Dim 类_1 As String, 名_1 As String, PathFile As String
Dim 类_2 As String, 名_2 As String
Dim lrtb_1 As RECT, sum_x_1 As Long, sum_y_1 As Long
Dim lrtb_2 As RECT, sum_x_2 As Long, sum_y_2 As Long
Dim w_x_1 As Long, h_y_1 As Long, w_x_2 As Long, h_y_2 As Long
Dim S_hash_1X1 As Variant, S_hash_7X7 As Variant, S_hash_8X8 As Variant
Dim n_差异 As Long
类_1 = “SunAwtFrame”
名_1 = “SAMSUNG-SM-N9600 (非商业用途)”
do_hwnd = FindWindow(类_1, 名_1)
do_hwnd_1 = GetParent(do_hwnd)
If do_hwnd_1 > 0 Then
do_hwnd_2 = do_hwnd
Else
do_hwnd_2 = FindWindowEx(do_hwnd, 0, vbNullString, vbNullString)
If do_hwnd_2 > 0 Then
do_hwnd_1 = do_hwnd
End If
End If
do_hwnd = do_hwnd_2
'求出 do_hwnd, do_hwnd_1, do_hwnd_2
'Stop
'定义点位
Dim 重新开始_x As Long, 重新开始_y As Long
Dim 选后开始_x As Long, 选后开始_y As Long
Dim 种后开战_x As Long, 种后开战_y As Long
Dim 大豆_x As Long, 大豆_y As Long
Dim 返重_x As Long, 返重_y As Long
Dim 战败再来_x As Long, 战败再来_y As Long
Dim 关闭购钻_x As Long, 关闭购钻_y As Long
Dim 关闭购光_x As Long, 关闭购光_y As Long
Dim 关闭购瓜_x As Long, 关闭购瓜_y As Long
Dim 关闭装备_x As Long, 关闭装备_y As Long
Dim 错误继续_x As Long, 错误继续_y As Long
Dim 植卡_x As Long, 植卡_qy As Long, 植卡_dy As Long, 植卡_y(1 To 8) As Long
植卡_qy = 16: 植卡_dy = 19
Dim 种位_qx As Long, 种位_dx As Long, 种位_x(1 To 9) As Long
种位_qx = 155: 种位_dx = 25
Dim 种位_qy As Long, 种位_dy As Long, 种位_y(1 To 5) As Long
种位_qy = 14: 种位_dy = 30
Call GetClientRect(do_hwnd_2, lrtb_2) '取窗体边标
sum_x_2 = lrtb_2.Right - lrtb_2.Left
sum_y_2 = lrtb_2.Bottom - lrtb_2.Top
i_x = sum_x_2 / 400
i_y = sum_y_2 / 200
重新开始_x = i_x * 200: 重新开始_y = i_y * 147
选后开始_x = i_x * 368: 选后开始_y = i_y * 187
返重_x = i_x * 388: 返重_y = i_y * 10
战败再来_x = i_x * 230: 战败再来_y = i_y * 190
关闭购钻_x = i_x * 340: 关闭购钻_y = i_y * 30
关闭购光_x = i_x * 330: 关闭购光_y = i_y * 30
关闭装备_x = i_x * 305: 关闭装备_y = i_y * 30
种后开战_x = i_x * 349: 种后开战_y = i_y * 33
错误继续_x = i_x * 200: 错误继续_y = i_y * 140
关闭购瓜_x = i_x * 305: 关闭购瓜_y = i_y * 35
大豆_x = i_x * 180: 大豆_y = i_y * 190
植卡_x = i_x * 16
For i = 1 To 8
植卡_y(i) = (植卡_qy + 植卡_dy * i) * i_y
Next i
For i = 1 To 9
种位_x(i) = (种位_qx + 种位_dx * i) * i_x
Next i
For i = 1 To 5
种位_y(i) = (种位_qy + 种位_dy * i) * i_y
Next i
Dim hash_局部
Dim 取位_起点长宽() As Long
ReDim 取位_起点长宽(n_n_y_q To n_n_y_z, 0 To 4) As Long
ReDim hash_名样(n_n_y_q To n_n_y_z, 1 To 2) As String
For y = n_n_y_q To n_n_y_z
n = Sheet3.Cells(y + 1, 1)
hash_名样(n, 1) = Sheet3.Cells(y + 1, 2)
hash_名样(n, 2) = Sheet3.Cells(y + 1, 3)
取位_起点长宽(n, 1) = Sheet3.Cells(y + 1, 5)
取位_起点长宽(n, 2) = Sheet3.Cells(y + 1, 6)
取位_起点长宽(n, 3) = Sheet3.Cells(y + 1, 7)
取位_起点长宽(n, 4) = Sheet3.Cells(y + 1, 8)
Next
For n = 1 To 1
t_1 = timeGetTime
Call 新简_TOTAL_后台截图_HASH(do_hwnd_1, do_hwnd_2, “0987”, 1, _
取位_起点长宽(), n_n_y_q, n_n_y_z, hash_局部)
t_2 = timeGetTime - t_1
’ Stop
Next
Dim 假定_true As Boolean, max_n As Long, min_n As Long
t_q = timeGetTime
Dim no_do As Long, S_to_do As String
no_do = 0
S_to_do = “”
Do While n_局 < n_局数 And no_do < 50 '循环操作
'Stop
no_do = 0
Do While no_do < 50 '循环刷屏救HASH
S_to_do = “”
’ Stop
t_1 = timeGetTime
Dim ha As String
ha = “”: n_差异 = 16: t_2 = 0
Do While t_2 = 0
Sleep 80
Call 新简_TOTAL_后台截图_HASH(do_hwnd_1, do_hwnd_2, “”, 1, _
取位_起点长宽(), n_n_y_q, n_n_y_z, hash_局部)
t_2 = timeGetTime - t_1
DoEvents
Loop
假定_true = False: min_n = 16
Dim n_use As Long
For n = n_n_y_q To n_n_y_z
n_差异 = 指纹对比_差异度(hash_名样(n, 2), hash_局部(n))
If min_n > n_差异 Then
min_n = n_差异
n_use = n
End If
Next n
If min_n <= 6 Then
假定_true = True
S_to_do = hash_名样(n_use, 1)
Exit Do
End If
If 假定_true = False Then 'all假定_true = False
no_do = no_do + 1
S_to_do = “no_do”
Call 定时分秒(0, 0.5)
End If ''all假定_true = False
DoEvents '转让控制权,以便让操作系统处理其它的事件。
Loop ’ '循环刷屏救HASH
'按展内容进行操作
If S_to_do = “购买黄瓜” Then '按展内容进行操作
'Stop
Call total_control_点击(do_hwnd, 关闭购瓜_x, 关闭购瓜_y): Sleep 20
ElseIf S_to_do = “云存错误” Then
'Stop
Call total_control_点击(do_hwnd, 错误继续_x, 错误继续_y): Sleep 20
ElseIf S_to_do = “购买阳光” Then
'Stop
Call total_control_点击(do_hwnd, 关闭购光_x, 关闭购光_y): Sleep 20
ElseIf S_to_do = “购买钻石” Then
'Stop
Call total_control_点击(do_hwnd, 关闭购钻_x, 关闭购钻_y): Sleep 20
ElseIf S_to_do = “选择神器” Then
'Stop
Call total_control_点击(do_hwnd, 关闭装备_x, 关闭装备_y): Sleep 20
ElseIf S_to_do = “游戏暂停” Then
'Stop
Call total_control_点击(do_hwnd, 重新开始_x, 重新开始_y): Sleep 20
Call 定时分秒(0, 8.5)
'Stop
ElseIf S_to_do = “刷金选植” Then
'Stop
Call total_control_点击(do_hwnd, 选后开始_x, 选后开始_y): Sleep 20
'Call SetForegroundWindow(do_hwnd)
Call 定时分秒(0, 7.5)
'Stop
ElseIf S_to_do = “刷金开种” Then
'Stop
For i = 2 To 5 '种砖
Call total_control_点击(do_hwnd, 植卡_x, 植卡_y(n_葵)): Sleep 50
Call total_control_点击(do_hwnd, 种位_x(i), 种位_y(n_种)): Sleep 80
Call total_control_点击(do_hwnd, 植卡_x, 植卡_y(n_砖)): Sleep 50
Call total_control_点击(do_hwnd, 种位_x(i), 种位_y(n_种)): Sleep 100
DoEvents
Next i
Call 定时分秒(0, 0.5)
Call total_control_点击(do_hwnd, 种后开战_x, 种后开战_y)
Call 定时分秒(0, 3.5)
’ Stop
ElseIf S_to_do = “刷金可豆” Then
'Call 定时分秒(0, 0.5)
For i = 1 To 3 '种豆
Call total_control_点击(do_hwnd, 种位_x(1), 种位_y(n_种)): Sleep 50
Call total_control_点击(do_hwnd, 大豆_x, 大豆_y): Sleep 20
Call total_control_点击(do_hwnd, 种位_x(2), 种位_y(n_种))
Call 定时分秒(0, 1)
Dim n_j As Long
If i >= 3 Then
Call 定时分秒(0, 2)
n_j = 2
Else
n_j = 2
End If
For i_2 = 1 To n_j Step 1 '收金
Call 定时分秒(0, 0.5)
For y = 种位_y(n_种) - 种位_dy * i_y To 种位_y(n_种) + 种位_dy * i_y Step Round(种位_dy * i_y / 3, 0)
For x = 种位_x(6) To 种位_x(1) Step -Round(种位_dx * i_x / 2, 0)
Call total_control_点击(do_hwnd, x, y): Sleep 10
DoEvents
Next x
Next y
Sleep 50
DoEvents
Next i_2
DoEvents
Next i
Call 定时分秒(0, 1)
Call total_control_点击(do_hwnd, 返重_x, 返重_y)
Call 定时分秒(0, 0.2)
n_局 = n_局 + 1
t_z = timeGetTime
t_sum = t_z - t_q
Sheet1.Cells(2, 5) = “总局数”
Sheet1.Cells(2, 6) = n_局数
Sheet1.Cells(3, 5) = “当前局”
Sheet1.Cells(3, 6) = n_局
Sheet1.Cells(4, 5) = “总用分钟”
Sheet1.Cells(4, 6) = Round((t_sum \ 1000) / 60, 2)
Sheet1.Cells(5, 5) = “单局平均秒”
If n_局 > 0 Then
Sheet1.Cells(5, 6) = Round((t_sum \ 1000) / n_局, 2)
End If
Sheet1.Cells(6, 5) = “结束时间”
Sheet1.Cells(6, 6) = Format(Time, “hh:mm:ss”)
DoEvents
ElseIf S_to_do = “战果战败” Then
'Stop
Call total_control_点击(do_hwnd, 战败再来_x, 战败再来_y): Sleep 20
ElseIf S_to_do = “no_do” Then
'Stop
Else '没内容时不进行操作
End If '按展内容进行操作
DoEvents '转让控制权,以便让操作系统处理其它的事件。
Loop ’ '循环操作
Call 休眠(True)
End Sub
Private Sub 无屏刷金_Click()
Dim n_局 As Long, n_局数 As Long: n_局数 = Sheet1.Cells(2, 4)
Dim n_砖 As Long: n_砖 = Sheet1.Cells(2, 2)
Dim n_葵 As Long: n_葵 = Sheet1.Cells(2, 3)
Dim n_种 As Long: n_种 = 1
Call 休眠(False) 'ok
Dim t_q As Long, t_z As Long, t_sum As Long
Dim xy_1 As POINTAPI, xy_2 As POINTAPI
Dim do_hwnd As Long, do_hwnd_1 As Long, do_hwnd_2 As Long, hdc As Long
Dim i As Long, i_1 As Long, i_2 As Long, i_x As Double, i_y As Double
Dim x As Long, y As Long, n_x As Long, n_y As Long, d_x As Long, d_y As Long
Dim 类_1 As String, 名_1 As String, PathFile As String
Dim 类_2 As String, 名_2 As String
类_1 = “SunAwtFrame”
名_1 = “SAMSUNG-SM-N9600 (非商业用途)”
Dim n_次 As Long, 合_brg As Long: 合_brg = 192
do_hwnd = FindWindow(类_1, 名_1)
do_hwnd_1 = GetParent(do_hwnd)
If do_hwnd_1 > 0 Then
do_hwnd_2 = do_hwnd
Else
do_hwnd_2 = FindWindowEx(do_hwnd, 0, vbNullString, vbNullString)
If do_hwnd_2 > 0 Then
do_hwnd_1 = do_hwnd
End If
End If
Dim lrtb As RECT, sum_x As Long, sum_y As Long
do_hwnd = do_hwnd_2
Call GetClientRect(do_hwnd, lrtb) '取窗体边标
sum_x = lrtb.Right - lrtb.Left
sum_y = lrtb.Bottom - lrtb.Top
i_x = sum_x / 400
i_y = sum_y / 200
'定议点位
Dim 重新开始_x As Long, 重新开始_y As Long
重新开始_x = i_x * 200: 重新开始_y = i_y * 147
Dim 选后开始_x As Long, 选后开始_y As Long
选后开始_x = i_x * 368: 选后开始_y = i_y * 187
Dim 植卡_x As Long, 植卡_qy As Long, 植卡_dy As Long, 植卡_y(1 To 8) As Long
植卡_x = i_x * 16: 植卡_qy = 16: 植卡_dy = 19
For i = 1 To 8
植卡_y(i) = (植卡_qy + 植卡_dy * i) * i_y
Next i
Dim 种位_qx As Long, 种位_dx As Long, 种位_x(1 To 9) As Long
种位_qx = 155: 种位_dx = 25
For i = 1 To 9
种位_x(i) = (种位_qx + 种位_dx * i) * i_x
Next i
Dim 种位_qy As Long, 种位_dy As Long, 种位_y(1 To 5) As Long
种位_qy = 14: 种位_dy = 30
For i = 1 To 5
种位_y(i) = (种位_qy + 种位_dy * i) * i_y
Next i
Dim 种后开战_x As Long, 种后开战_y As Long
种后开战_x = i_x * 349: 种后开战_y = i_y * 33
Dim 大豆_x As Long, 大豆_y As Long
大豆_x = i_x * 180: 大豆_y = i_y * 190
Dim 返重_x As Long, 返重_y As Long
返重_x = i_x * 388: 返重_y = i_y * 10
t_q = timeGetTime
For n_局 = 1 To n_局数
Call total_control_点击(do_hwnd, 重新开始_x, 重新开始_y)
Call 定时分秒(0, 9)
Call total_control_点击(do_hwnd, 选后开始_x, 选后开始_y)
Call 定时分秒(0, 8)
For i = 2 To 5 '种砖
Call total_control_点击(do_hwnd, 植卡_x, 植卡_y(n_砖))
Call 定时分秒(0, 0.1)
Call total_control_点击(do_hwnd, 种位_x(i), 种位_y(n_种))
Call 定时分秒(0, 0.2)
Next i
Call 定时分秒(0, 2)
For i = 2 To 5 '种葵
Call total_control_点击(do_hwnd, 植卡_x, 植卡_y(n_葵))
Call 定时分秒(0, 0.1)
Call total_control_点击(do_hwnd, 种位_x(i), 种位_y(n_种))
Call 定时分秒(0, 0.2)
DoEvents
Next i
Call 定时分秒(0, 0.5)
Call total_control_点击(do_hwnd, 种后开战_x, 种后开战_y)
Call 定时分秒(0, 4)
For i = 1 To 3 '种豆
Call total_control_点击(do_hwnd, 种位_x(2), 种位_y(n_种))
Call total_control_点击(do_hwnd, 大豆_x, 大豆_y): Sleep 50
Call total_control_点击(do_hwnd, 种位_x(2), 种位_y(n_种))
Call 定时分秒(0, 1)
If i = 3 Then Call 定时分秒(0, 1)
For i_2 = 1 To 2 Step 1 '收金
Call 定时分秒(0, 0.5)
'Call total_control_屏色点单击(do_hwnd_1, do_hwnd_2, _
种位_x(1) - Round(10 * i_x, 0), 种位_y(2), 种位_x(5), 种位_y(4), _
合_brg, n_次, Round(5 * i_x, 0))
For y = 种位_y(n_种) - Round(种位_dy * i_y, 0) To 种位_y(n_种) + Round(种位_dy * i_y, 0) Step Round(种位_dy * i_y / 3, 0)
For x = 种位_x(1) To 种位_x(6) Step Round(种位_dx * i_x / 2, 0)
Call total_control_点击(do_hwnd, x, y): Sleep 20
DoEvents
Next x
Next y
Sleep 50
DoEvents
Next i_2
DoEvents
Next i
Call 定时分秒(0, 1)
Dim 错误继续_x As Long, 错误继续_y As Long
错误继续_x = i_x * 200: 错误继续_y = i_y * 140
Call total_control_点击(do_hwnd, 错误继续_x, 错误继续_y): Sleep 20
Call total_control_点击(do_hwnd, 返重_x, 返重_y)
Call 定时分秒(0, 0.5)
t_z = timeGetTime
t_sum = t_z - t_q
Sheet1.Cells(2, 5) = “总局数”
Sheet1.Cells(2, 6) = n_局数
Sheet1.Cells(3, 5) = “当前局”
Sheet1.Cells(3, 6) = n_局
Sheet1.Cells(4, 5) = “总用分钟”
Sheet1.Cells(4, 6) = Round((t_sum \ 1000) / 60, 2)
Sheet1.Cells(5, 5) = “单局平均秒”
If n_局 > 0 Then
Sheet1.Cells(5, 6) = Round((t_sum \ 1000) / n_局, 2)
End If
Sheet1.Cells(6, 5) = “结束时间”
Sheet1.Cells(6, 6) = Format(Time, “hh:mm:ss”)
DoEvents
Next n_局
Call 休眠(True)
End Sub