Keskustelu: Ohjelmointikysymykset: PHP: Miinaharavan tietojen lukeminen

' [k]väännelty SharpDevelop 3.2'lla[/k]
Imports Accessibility
Imports [linkki "http://www.kotisivutila.fi/neansivut/downloads/AccLayer.zip"]AccLayer[/linkki]
Imports Microsoft.Win32
Imports System.Threading
Imports System.Windows.Forms

Public Partial Class MainForm

   Private Structure ClientStruct
      Dim [Object] As Object
      Dim Left As Integer
      Dim Top As Integer
      Dim Width As Integer
      Dim Location As Point
      Dim [Size] As Size
      Dim Height As Integer
      Dim Mines As Integer
      Dim Level As Integer
   End Structure

   'Private Structure CellMapStruct '***

      'Dim X As Integer
      'Dim y As Integer
      'Dim x2 As Integer
      'Dim y2 As Integer
      ' jne...
   'End Structure

   Private WMINE As ClientStruct

   'Private CellMap() As CellMapStruct '***

   Private sKey As String = "Software\Microsoft\Winmine"

   Dim AccProp As Object = Nothing

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub MainFormLoad(sender As Object, e As EventArgs)

      Me.Top = 550
      Me.Left = _
      (Screen.PrimaryScreen.WorkingArea.Width / 2) _
      - (Me.Width / 2)

      Dim procName As String = "winmine"
      Dim NotAccessible As Boolean = False
      Dim appFolder As String = ""

      If appFolder <> String.Empty Then
         appFolder += "\"
      End If

      KillProcess(procName)
      Dim fullPath As String = appFolder + procName + ".exe"
      StartProcess(fullPath)
      Thread.Sleep(200)

      Dim MyObject As IAccessible  = _
      AccLayer.Acc.GetAccessibleObjectFromHandle _
      (GetProcessHandle(procName))

      Try
         MyObject.accHitTest(1, 1)
      Catch ex As Exception
         NotAccessible = True
      End Try

      If NotAccessible Then
         MsgBox("SHIT! It doesn't Work")
         Exit Sub
      End If

      Dim Children As Object = _
      AccLayer.Acc.GetAccessibleChildren(MyObject)
      Dim MyChild As Object = Nothing

      For i As Integer = 0 To Children.GetUpperBound(0)
         If Children(i).accName = MyObject.accName Then
            MyChild = Children(i): Exit For
         End If
      Next

      If Not MyChild Is Nothing Then
         AccProp = New AccPropertySet(MyChild)
         WMINE.[Object] = MyChild
         AccProp = Nothing: MyChild = Nothing
         timer1.Interval = 250
         timer1.Start
      End If

      MyObject = Nothing

   End Sub

   Sub StartProcess(ByVal fullPath As String)

      Dim sInfo As New ProcessStartInfo

      With sInfo
         .FileName = fullPath
         .WindowStyle = ProcessWindowStyle.Normal
      End With

      Dim proc As New Process

      With proc
         .StartInfo = sInfo
         .Start
      End With

   End Sub

   Sub KillProcess(ByVal AppName As String)
      Dim procs() As Process = Process.GetProcesses()
      For Each proc As Process In procs
        With proc
           If .ProcessName.ToLower _
              = AppName.ToLower Then
              .Kill
           End If
        End With
      Next
      procs = Nothing

   End Sub

   Function IsRunningProcess(ByVal AppName As String) As Boolean

      Dim procs() As Process = Process.GetProcesses()
      For Each proc As Process In procs
        With proc
           If .ProcessName.ToLower _
              = AppName.ToLower Then
              Return True
              procs = Nothing
              Exit Function
           End If
        End With
      Next
      procs = Nothing
      Return False

   End Function

   Function GetProcessHandle(ByVal AppName As String) As Object

      Dim procs() As Process = Process.GetProcesses()
      For Each proc As Process In procs
        With proc
           If .ProcessName.ToLower _
              = AppName.ToLower Then
              Return .MainWindowHandle
              procs = Nothing
              Exit Function
           End If
        End With
      Next
      procs = Nothing
      Return Nothing
   End Function

   Sub Timer1Tick(sender As Object, e As EventArgs)

      Timer1.Stop
      If Not IsRunningProcess("winmine") Then
         MsgBox("SHIT! MineSweeper is not running...")
         Me.Close
      End If

      Try
         AccProp = New AccPropertySet(WMINE.[Object])
         WMINE.Left = AccProp.Location.Left
         WMINE.Top = AccProp.Location.Top
         WMINE.Width = AccProp.Location.Width _
         - AccProp.Location.X
         WMINE.Height = AccProp.Location.Height _
         - AccProp.Location.Y
         WMINE.[Size] = New Size(WMINE.Width,WMINE.Height)
         WMINE.Location = New Point( _
         AccProp.Location.X, AccProp.Location.Y)
         WMINE.Mines = GetRegistryValue("Mines")
         WMINE.Level = GetRegistryValue("Difficulty")
      Catch ex As Exception
         MsgBox("SHIT! Can't connect to object...")
         Me.Close
      End Try

      Try
         Using bmp As New Bitmap(WMINE.Width, WMINE.Height)

            Using g As Graphics = Graphics.FromImage(bmp)
               g.CopyFromScreen(New Point(WMINE.Left, _
               WMINE.Top), New Point(0, 0), WMINE.[Size])

               ' tähän kohtaan voi sitten aivan itse rakennella
               ' toiminnon, jolla kartoittaa solualueet kuvasta
               '(bmp) jotta pääsee vertailemaan kuvan solualueiden
               ' mahdollisia värityksen muutoksia, tyyliin ...
               ' Dim LevelTag As Integer
               ' If LevelTag <> WMINE.Level Then
                  ' Select Case WMINE.Level
                      ' Case 1
                        ' Redim Preserve CellMap( _
                        ' tämän_tason_solujen_määrä) '***
                      ' Case 2
                         'jne..
                     ' Case 3
                        'jne..
                  ' End Select
                  'For i As Integer = 0 To CellMap.GetUpperBound(0)
                     'CellMap(i).x = x.piste kuvasta bmp
                     ' jne...
                  'Next
                   'LevelTag = WMINE.Level
               'End If

               'For i As Integer = 0 To CellMap.GetUpprBound(0)
                  'If bmp.GetPixel(CellMap(i).x, _
                  'CellMap(i).y).ToArgb <> Color.Gray.ToArgb Then 'esim.
                      ' Do something...
                  'End If
               'Next

            End Using
         End Using

      Catch ex As Exception
         MsgBox("SHIT! It doesn't work")
      End Try

      Timer1.Start

   End Sub

   Function GetRegistryValue( _
   ByVal sKeyName As String) As Object

      Dim reg As RegistryKey
      Dim strTemp As String = String.Empty
      reg = Registry.CurrentUser.OpenSubKey(sKey)
      reg.OpenSubKey(sKeyName)
      If Not (reg Is Nothing) Then
         Return reg.GetValue(sKeyName)
      Else
         Return Nothing
      End If
      reg.Close()

   End Function

   Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)
      KillProcess("winmine")
      WMINE = Nothing
      Me.Dispose
   End Sub

   Sub MainFormFormClosed(sender As Object, e As FormClosedEventArgs)
      End
   End Sub

End Class