form1.frm

只供学习,只是个爱好而于。

  Case 0
    StatusBar1.Panels(2).Text = "模式：初级"
  Case 1
    StatusBar1.Panels(2).Text = "模式：中级"
  Case 2
    StatusBar1.Panels(2).Text = "模式：高级"
  Case 3
    StatusBar1.Panels(2).Text = "模式：自定义"
  End Select
  
  '计算自动扫雷所用时间
  mTime = (CLng(mWidth * mHeight) - MineNum) * CInt(txtSleep.Text) \ 1000 + 1
  lblInfo.Caption = "大概 " & mTime & " 秒可以完成扫雷任务。"
  
  'SendMessage的最后一个参数lParam在发送WM_LBUTTONDOWN消息时代表坐标，如何把坐标X,Y合并成lParam呢
  'Delphi是用MakelParam(x,y)
  'a = postmessage(hwand,WM_LBUTTONDOWN , 0, (x And &hFFFF)+(y And &HFFFF)*&H10000)
  
'  For Row = 0 To mHeight      '从第一行开始，由左向右，从上而下
'    For Col = 0 To mWidth
  '自动扫雷的问题，如果已经是按过的，就是被自动翻开的，读取一下内存值，发现已经是翻开状态的，就不要再移动点击了，那样就显得有点假
  '这样子的自动扫雷，是一行一行的顺序扫下来，以后考虑使用随机扫雷，这样显得真实一点
  '如果扫雷是已经开始游戏的状态，或者是已经结束或完成的状态，考虑让鼠标自动点击那个笑脸的图标，让游戏重新开始
  '自动移动指针时，发现有时指针会跑到别的地方，乱闪(可用隐藏指针功能，没点击时隐藏，自动点击时显示,ShowCursor)
  '一个奇怪的问题，当扫雷到了最后的时候，光标不会停在最后一个，而停在倒数第几个,一般最后会是雷
  
  '自动点击笑脸图标按钮，重新开始一局(255,75,扫雷中笑脸按钮所在的位置)这个高度不算标题栏的高度和菜单的高度，只算客户区的高度
'  SetForegroundWindow hMine
'  mP.x = 255
'  mP.y = 75 - 45
'  Call ClientToScreen(hMine, mP)
'  SetCursorPos mP.x, mP.y
  
'  Call SendMessage(hMine, WM_LBUTTONDOWN, 0, MakelParam(255, 30))
'  Call SendMessage(hMine, WM_LBUTTONUP, 0, MakelParam(255, 30))

'  mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  
'发送键盘消息F2键，也可以重新开始新游戏
  'Call SendMessage(hMine, WM_KEYDOWN, VK_F2, 0&)
  'Call SendMessage(hMine, WM_KEYUP, VK_F2, 0&)
  
  'sendkeys ( )
  
'  SetForegroundWindow hMine
'  keybd_event VK_F2, 0, 0, 0
'  keybd_event VK_F2, 0, KEYEVENTF_KEYUP, 0   ' release H
'  DoEvents
  
'虽然下面的语句有效，但是好像程序却没有从内存中清除干净,VB的结束键仍然有效，窗体已经不见，要手动结束程序
'  Call SendMessage(Command2.hwnd, WM_KEYDOWN, VK_SPACE, 0&)
'  Call SendMessage(Command2.hwnd, WM_KEYUP, VK_SPACE, 0&)

  For Row = 0 To (mHeight - 1)    '从第一行开始，由左向右，从上而下
    For Col = 0 To (mWidth - 1)
      '如果按下ESC键，则停止自动扫雷
      If GetAsyncKeyState(VK_ESCAPE) <> 0 Then
        Call CloseHandle(pMine)
        Exit Sub
      End If
      
      If ReadProcessMemory(pMine, miStart + Row * 32 + Col, lpBuffer, nSize, lpNumberOfBytesRead) Then
        'If lpBuffer <> 143 Or (lpBuffer > &H40 And lpBuffer <= &H48) Then '即$8F为雷,&H40到&H48代表0-8
        'If lpBuffer <> 143 Or (lpBuffer < &H40 And lpBuffer > &H48) Then
          mP.x = xOffset + 16 * Col
          mP.y = yOffset + 16 * Row
        If lpBuffer <> 143 Then '即$8F为雷,&H40到&H48代表0-8
          If OptAuto.Value Then     '自动扫雷
            If chkSleep.Value Then   '如果选中了延时
              'ShowWindow hMine, SW_SHOW     '激活扫雷窗口
              '原此处放激活窗口的代码
              If IsIconic(hMine) <> 0 Then     '如果扫雷窗口是最小化，则恢复其窗口
                ShowWindow hMine, SW_RESTORE
              End If
              If GetForegroundWindow <> hMine Then  '如果扫雷窗口不是前台窗口，则设置为前台窗口
                SetForegroundWindow hMine
              End If
              
              'If lpBuffer >= &H40 And lpBuffer <= &H48 Then     '如果是0-8的数字则退出不自动点击
              'If lpBuffer < &H40 And lpBuffer > &H48 Then
              If lpBuffer = &HF Then    '如果不是雷，而且没有翻开过,&H0F
                'Sleep 50      '延时
                Sleep CInt(txtSleep.Text)
                DoEvents      '转移控制权
                '移动鼠标指针，感觉就像真的在自动扫雷一样
                Call ClientToScreen(hMine, mP)
                Call SetCursorPos(mP.x, mP.y)
                
                '模拟了鼠标左键的点击事件
                '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标左键按下的消息
                Call SendMessage(hMine, WM_LBUTTONDOWN, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
                '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标左键抬起的消息
                Call SendMessage(hMine, WM_LBUTTONUP, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
              
              End If
            End If
            
          ElseIf OptNotMine.Value Then
            '在非雷区标注问号
            '模拟了鼠标右键的点击事件
            '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标右键按下的消息
            Call SendMessage(hMine, WM_RBUTTONDOWN, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
            Call SendMessage(hMine, WM_RBUTTONUP, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
            '模拟了鼠标右键的点击事件即标注雷
            '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标右键按下的消息
            Call SendMessage(hMine, WM_RBUTTONDOWN, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
            '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标右键抬起的消息
            Call SendMessage(hMine, WM_RBUTTONUP, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
          End If

        Else    '=&H8F(143),有雷
          'If OptMine.Value Or OptAuto.Value Then      '标记雷区或自动扫雷都要用右键给雷区插小红旗
          If OptMine.Value Then
            '模拟了鼠标右键的点击事件
            '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标右键按下的消息
            Call SendMessage(hMine, WM_RBUTTONDOWN, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
            '向 扫雷 窗体的 （xOffset+16*col,yOffset+16*row）处 发送鼠标右键抬起的消息
            Call SendMessage(hMine, WM_RBUTTONUP, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
          ElseIf OptAuto.Value Then
            'Debug.Print Row; ","; Col

            Sleep CInt(txtSleep.Text)
            DoEvents      '转移控制权

            '移动鼠标指针，感觉就像真的在自动扫雷一样
            '鼠标乱移的错误出现在下面的两句，因为mP中存的光标位置已经被换过了，此时再换就不对了
            Call ClientToScreen(hMine, mP)
            Call SetCursorPos(mP.x, mP.y)
            
            Call SendMessage(hMine, WM_RBUTTONDOWN, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
            Call SendMessage(hMine, WM_RBUTTONUP, 0, MakelParam(xOffset + 16 * Col, yOffset + 16 * Row))
          
          End If
        End If
      End If
    Next
  Next
  
  Call CloseHandle(pMine)
  

End Sub

Private Sub Command2_Click()
  'MsgBox "你要退出吗？", vbInformation
    Unload Me
  'VarPtr,变量的内存地址
'  Dim hMine As Long  '扫雷窗体的句柄
'  Dim lPos As Long
'
'  hMine = FindWindow(vbNullString, "扫雷")    '找 扫雷 窗口
'  mP.X = 20 + 16 * 3    '68
'  mP.Y = 60 + 16 * 3    '108
'  '这个位置是第4行第4个
'  '这个位置是第1排第7个
'  lPos = mP.X + mP.Y * 65536    '7077956
'
'  Call SendMessage(hMine, WM_LBUTTONDOWN, 0, lPos)
'  Call SendMessage(hMine, WM_LBUTTONUP, 0, lPos)

'  Call SendMessage(hMine, WM_LBUTTONDOWN, 0, MakeDWord(20 + 16 * 3, 60 + 16 * 3))
'  Call SendMessage(hMine, WM_LBUTTONUP, 0, MakeDWord(20 + 16 * 3, 60 + 16 * 3))
   
End Sub

Private Sub Form_Load()
  '判断操作系统版本
    Dim OSInfo As OSVERSIONINFO, PId As String
    Dim Ret As Long
    Dim OS As String, OSVersion As Single
    Dim Str1 As String
    OSVersion = CSng(GetOSVersion.osvOSVerMajor & "." & GetOSVersion.osvOSVerMinor)
    
    Select Case GetOSVersion.osvOSName
    Case 0    'Windows 32s
      OS = "Win32"
    Case 1    'Windows 95/98
      Select Case OSVersion
      Case 4: OS = "Win 95"
      Case 4.1: OS = "Win 98"
      Case 4.9: OS = "Wim Me"
      End Select

    Case 2    'Windows NT
      Select Case OSVersion
      Case 4: OS = "Win NT"
      Case 5#: OS = "Win 2000"
      Case 5.1: OS = "Win XP"

      End Select
    End Select
    
    If OS = "Win 2000" Then
      Opt2000.Value = True
    ElseIf OS = "Win XP" Then
      OptXP.Value = True
    Else    '非2000/XP系统
      MsgBox "对不起！本程序只能运行在Windows 2000/XP系统上面。", vbInformation, "I'm Sorry!"
    End If
    OptAuto.Value = True

End Sub

Private Sub RunMine()
  Dim Ret As Long
  Ret = MsgBox("现在要运行扫雷程序吗？", vbExclamation + vbYesNo, "是否现在运行扫雷")
  If Ret = vbYes Then
    '获得Windows所在的目录，然后检查扫雷程序是否存在，并给出相应提示
    'Debug.Print GetSystemDir
    If Dir$(GetSystemDir & "\winmine.exe") <> "" Then
      Shell GetSystemDir & "\winmine.exe", vbNormalFocus
    Else
      MsgBox "没有找到扫雷程序！可能是没有安装，在控制面板的“添加/删除程序”里选择“添加/删除Windows组件(&A)”中把附件中的游戏选上，确定就可以安装好了。", vbInformation
    End If
    
  Else
  
  End If
End Sub

Private Sub OptAuto_Click()
  chkSleep.Value = 1
  
End Sub

Private Sub txtSleep_Change()
'  Dim Ss As Integer, mTime As Long
'  '计算扫雷所需的时间秒数,取得高度和宽度，得到共有多少个按钮，然后再减去雷数
'  If txtSleep.Text = "" Then Exit Sub
'  Ss = CInt(txtSleep.Text)
'  mTime = (CLng(30 * 16) - 99) * Ss \ 1000
'  mTime = mTime + 1    '误差大概是小1
'  lblInfo.Caption = "大概 " & mTime & " 秒可以完成扫雷任务。"
  
End Sub

Private Sub txtSleep_KeyPress(KeyAscii As Integer)
  'If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
  If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
  'If KeyAscii = 8 Then KeyAscii = 8
  
End Sub