用vba解决空挡接龙617局

素心1218

空当接龙617局是比较难的一局，现利用vba代码自动演示过关过程，代码如下：

1. Declare Function FindWindow Lib "user32" Alias _
   
2.   "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
3.    
   
4. Declare Function SendMessage Lib "user32" Alias _
   
5.   "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   
6.   
   
7. Const WM_CHAR = &H102
   
8.   
   
9. Sub f()
   
10. s = "83 80 83 81 80 " & _
    
11.   "20 27 72 " & _
    
12.   "48 46 41 48 42 " & _
    
13.   "89 48 70 74 78 07 40 27 " & _
    
14.   "10 14 004 10 01 16 19 " & _
    
15.   "20 002 42 21 20 " & _
    
16.   "32 34 24 32 42 34 30 38 " & _
    
17.   "58 53 63 57 56 50 " & _
    
18.   "10 10 13 15 35 13 12 18"
    
19.   
    
20. h = FindWindow("FreeWClass", "空当接龙游戏 #617")
    
21. For i = 1 To Len(s)
    
22.   c = Mid(s, i, 1)
    
23.   m = 0.1
    
24.   If c >= "0" And c <= "9" Then
    
25.     a = SendMessage(h, WM_CHAR, Asc(c), 0)
    
26.   Else
    
27.     m = 0.3
    
28.   End If
    
29.   m = m + Timer: Do While Timer < m: DoEvents: Loop
    
30. Next
    
31. End Sub

复制代码

dongdonggege

楼主的这种方法，是XP的方法，现在都过时了，win7的里面不适合。
其实我在16年，就发表了《vba空当接龙32147局》http://club.excelhome.net/thread-1304306-1-1.html。
当时我想实现能选局、自动打牌。
选局卡在点击“确定”按钮那儿，找不到句柄。自动打牌，当时手动F8可以，连续运行F5不行，今天回头看，还是只设置了DOWN键，没设置UP键。
win7，游戏的名称叫"空当接龙"，不叫"空当接龙游戏 #617"。
SendMessage不能用，得用PostMessage。

我选取了部分玩法，就是你第一组的83、80、83、81、80.
程序如下：

1. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
2. 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
   
3. 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
   
4. Private Declare Function SendMessage& Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
   
5. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   
6. 
   
7. Const WM_KEYDOWN = &H100
   
8. Const WM_KEYUP = &H101
   
9. Const WM_CLOSE = &H10
   
10. 
    
11. Sub test() '空当接龙617局
    
12.     hwnd = FindWindow(vbNullString, "空当接龙")
    
13.     hwnd1 = FindWindowEx(hwnd, 0, "Static", vbNullString) 'win7系统获取打牌窗口
    
14.    
    
15.     PostMessage hwnd, WM_KEYDOWN, vbKey8, 0 '
    
16.     Sleep 100 '
    
17.     PostMessage hwnd, WM_KEYUP, vbKey8, 0 '
    
18.     Sleep 100 '
    
19.    
    
20.     PostMessage hwnd, WM_KEYDOWN, vbKey3, 0 '
    
21.     Sleep 100 '
    
22.     PostMessage hwnd, WM_KEYUP, vbKey3, 0 '
    
23.     Sleep 100 '
    
24.     '8-----3
    
25.     '-------------------------------
    
26.     PostMessage hwnd, WM_KEYDOWN, vbKey8, 0
    
27.     Sleep 100 '
    
28.     PostMessage hwnd, WM_KEYUP, vbKey8, 0
    
29.     Sleep 100 '
    
30.    
    
31.     PostMessage hwnd, WM_KEYDOWN, vbKey0, 0
    
32.     Sleep 100 '
    
33.     PostMessage hwnd, WM_KEYUP, vbKey0, 0
    
34.     Sleep 100 '
    
35.     '8-----0
    
36.     '--------------------------------------
    
37.     PostMessage hwnd, WM_KEYDOWN, vbKey8, 0
    
38.     Sleep 200 '
    
39.     PostMessage hwnd, WM_KEYUP, vbKey8, 0
    
40.     Sleep 200 '
    
41.    
    
42.     PostMessage hwnd, WM_KEYDOWN, vbKey3, 0
    
43.     Sleep 200 '
    
44.     PostMessage hwnd, WM_KEYUP, vbKey3, 0
    
45.     Sleep 200 '
    
46.     '8-----3
    
47.     '-----------------------------
    
48.    
    
49.     PostMessage hwnd, WM_KEYDOWN, vbKey8, 0
    
50.     Sleep 200 '
    
51.     PostMessage hwnd, WM_KEYUP, vbKey8, 0
    
52.     Sleep 200 '
    
53.    
    
54.     PostMessage hwnd, WM_KEYDOWN, vbKey1, 0
    
55.     Sleep 200 '
    
56.     PostMessage hwnd, WM_KEYUP, vbKey1, 0
    
57.     Sleep 200 '
    
58.     '8-----1
    
59.     '-----------------------------
    
60.    
    
61.     PostMessage hwnd, WM_KEYDOWN, vbKey8, 0
    
62.     Sleep 200 '
    
63.     PostMessage hwnd, WM_KEYUP, vbKey8, 0
    
64.     Sleep 200 '
    
65.    
    
66.     PostMessage hwnd, WM_KEYDOWN, vbKey0, 0
    
67.     Sleep 200 '
    
68.     PostMessage hwnd, WM_KEYUP, vbKey0, 0
    
69.     Sleep 200 '
    
70.     '8-----0
    
71.     '-----------------------------
    
72. End Sub

复制代码

麻烦楼主改成数组的，不然程序太长了。
改好了，希望能发表出来，学习下。