Keskustelu: Ohjelmointikysymykset: VB.NET: [VB.Net] Tekstin kaappaaminen ikkunasta

Imports System

Public Partial Class MainForm

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

   Sub WebBrowser1_DocumentCompleted(sender As Object, _
   e As WebBrowserDocumentCompletedEventArgs)

         Timer1.Interval = 500
         Timer1.Enabled = True
         Timer1.Start

   End Sub

   Sub MainForm_Shown(sender As Object, e As EventArgs)

      WebBrowser1.Url = _
      New Uri("https://www.ohjelmointiputka.net/morpion/peli.php")

   End Sub

   Sub Timer1_Tick(sender As Object, e As EventArgs)

      Timer1.Stop

      Static bodyTag As String
      Dim bodyStr As String = WebBrowser1.Document.Body.OuterHtml

      If bodyTag <> bodyStr Then
         textBox1.Clear
         Dim elems As HtmlElementCollection
         elems = WebBrowser1.Document.GetElementsByTagName("p")
         For i = 0 To elems.Count - 1
            Dim elemStr As String = elems.Item(i).InnerHtml.ToString
            'testi...
            If  elemStr.IndexOf("INPUT") = -1 And _
            elemStr.IndexOf("A href") = -1 Then
               textBox1.Text += elems.Item(i).InnerText _
               + Environment.NewLine
            End if
         Next
      End If

      bodyTag = bodyStr
      Timer1.Start

   End Sub

End Class

'Formille 2 buttonia, label ja 2 listboxia

Public Class Form1
    Dim WindowsStuff As Class1 = New Class1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ListBox1.Items.Clear()

        WindowsStuff.GetActiveWindows()
        For Each AW In WindowsStuff.ActiveWindowList
            ListBox1.Items.Add(AW.ToString & vbTab & WindowsStuff.GetWindowsText(AW))
        Next
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ListBox2.Items.Clear()
        Dim SelectedhWnd As IntPtr

        If ListBox1.SelectedIndex <> -1 Then
            SelectedHwnd = WindowsStuff.ActiveWindowList(ListBox1.SelectedIndex)
            Label2.Text = WindowsStuff.GetWindowsText(SelectedHwnd)
        Else
            Exit Sub
        End If

        WindowsStuff.GetChildWindows(SelectedhWnd)
        For Each item In WindowsStuff.ChildWindowList
            ListBox2.Items.Add(item.ToString & vbTab & WindowsStuff.GetWindowsText(item))
        Next

    End Sub
End Class

Imports System.Runtime.InteropServices
Public Class Class1

    Public Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal adress As CallBack, ByVal lParam As Integer) As Boolean

    Public Declare Function EnumWindows Lib "user32.dll" (ByVal Adress As CallBack, ByVal lparam As Integer) As Integer

    Public Delegate Function CallBack(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean

    Private Const WM_GETTEXT As Integer = &HD
    Declare Auto Function SendMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr

    Public Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As IntPtr) As Boolean

    Public ChildWindowList As List(Of IntPtr)
    Public ActiveWindowList As List(Of IntPtr)


    Public Function GetChildWindows(ByVal ParentHandle As IntPtr)
        ChildWindowList = New List(Of IntPtr)
        Dim ListHandle As GCHandle = GCHandle.Alloc(ChildWindowList)
        EnumChildWindows(ParentHandle, AddressOf EnumChildWindowList, GCHandle.ToIntPtr(ListHandle))
        Return ChildWindowList.ToArray
    End Function
    Public Function GetActiveWindows()
        ActiveWindowList = New List(Of IntPtr)
        EnumWindows(AddressOf EnumActiveWindowList, 0)
        Return ActiveWindowList.ToArray
    End Function
    Private Shared Function EnumChildWindowList(ByVal hWnd As IntPtr, ByVal lParam As integer) As Boolean
        Dim ChildWindowList As List(Of IntPtr) = GCHandle.FromIntPtr(lParam).Target
        ChildWindowList.Add(hWnd)
        Return True
    End Function
    Private Function EnumActiveWindowList(ByVal hWnd As IntPtr, ByVal lParam As Integer) As Boolean
        If IsWindowVisible(hWnd) Then
            ActiveWindowList.Add(hWnd)
        End If
        Return True
    End Function

    Public Function GetWindowsText(ByVal hWnd As IntPtr)
        Dim Name As String = Space(100)
        Dim NumText As Integer = SendMessage(hWnd, WM_GETTEXT, 50, Name)
        Return Trim(Name)
    End Function

End Class

Imports System
Imports System.IO
Imports mshtml

Public Partial Class MainForm

   Private basePath As String = String.Empty
   Private sourcePath As String = String.Empty
   Private tempPath As String = String.Empty

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

   Sub MainForm_Load(sender As Object, e As EventArgs)

      If   CheckInstances(Me.Text) Then
         Me.Dispose(): End
      End If

   End Sub

   Sub WebBrowser1_DocumentCompleted(sender As Object, _
   e As WebBrowserDocumentCompletedEventArgs)

         Timer1.Interval = 500: Timer1.Enabled = True: Timer1.Start

   End Sub

   Sub MainForm_Shown(sender As Object, e As EventArgs)
      WebBrowser1.Url = _
      New Uri("http://content.funny-games.biz/governor-of-poker-2.swf")
   End Sub

   Sub Timer1_Tick(sender As Object, e As EventArgs)

      If webBrowser1.ReadyState <> 4 Then
         Exit Sub
      End If

      Application.DoEvents

      Timer1.Stop

      Dim CurrentDocument As MSHTML.IHTMLDocument2 = _
      CType(WebBrowser1.Document.DomDocument, IHTMLDocument2)

      Dim embeds As IHTMLElementCollection = CurrentDocument.embeds

      If embeds.length > 0 Then

         If basePath = String.Empty Then

            Dim AppDataPath As String = Environment.GetFolderPath( _
            Environment.SpecialFolder.ApplicationData)

            AppDataPath += _
            "\Macromedia\Flash Player\#SharedObjects\33MMP4KX\"

            Dim sourceInfo As New DirectoryInfo(AppDataPath)

            For Each subDir As DirectoryInfo In sourceInfo.GetDirectories

               If subDir.Name.IndexOf(WebBrowser1.Url.Host) > -1 Then

                  'Käytä kerrallaan vain yhtä pelaajaprofiilia...
                  'Mikäli luot uuden profiilin niin muista poistaa
                  'flas-pelin listalta mahdollinen aiempi profiili.
                  Dim files() As FileInfo = _
                  subDir.GetFiles("Governor_of_Poker2_v100_demo_*")

                  If files.length > 0 Then
                     sourcePath = subDir.FullName + _
                     "\" + files(0).ToString
                     tempPath = Environment.GetFolderPath( _
                     Environment.SpecialFolder.Desktop)
                     tempPath += "\" + files(0).ToString
                  End if: Exit For

               End If

            Next

            sourceInfo = Nothing: AppDataPath = Nothing

         End If

         If sourcePath <> String.Empty Then

            FileCopy(sourcePath,tempPath)
            Do While Dir(tempPath) = ""
            Application.DoEvents: Loop

            Dim strFile As String
            Dim MyChar As Char() = CType("pokerGame:", Char())
            FileOpen(1, tempPath, OpenMode.Input, OpenAccess.Read)
            strFile = InputString(1, CType(LOF(1), Integer))
            FileClose(1): Dim pos As Integer = _
            strFile.IndexOf("pokerGame:")

            'Testi (tutki kamaa ja väännä itse oma parseri)...
            Try
               textBox1.Text = _
               strFile.Substring(pos, strFile.Length - pos)
            Catch ex As Exeption
               sourcePath = String.Empty
            End Try

            Kill(tempPath): strFile = Nothing

         End If

      End If

      Timer1.Start

   End Sub

   Private Function CheckInstances(ByVal AppName As String) As Boolean

      Dim MyProcess As Process() = _
      Process.GetProcessesByName(AppName)
      Dim IsAllReadyRunnig As Boolean

      If Not MyProcess Is Nothing Then
          If MyProcess.Length   > 1 Then
         IsAllReadyRunnig = True
      Else
         IsAllReadyRunnig = False
      End If

      End If

      MyProcess = Nothing

      Return IsAllReadyRunnig

   End Function

   Sub MainForm_FormClosing(sender As Object, e As FormClosingEventArgs)

      Try
         Timer1.Stop
      Catch ex As Exception
      End Try

      Timer1.Enabled = False
      Me.Dispose()

   End Sub

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

End Class

'EmbedSwfSpy.exe (Väännetty SharpDevelop 4.0 Beta 2:lla)
'Ohjausobjektit:
'Paneeli  (panel1), WebBrowser (webBrowser1) & Labelli (label1)
'(WebBrowser-kontrolli paneelin sisälle)
Imports System
Imports System.Runtime.InteropServices
Imports Accessibility '(Accessibility.dll)
Imports AccLayer '(AccLayer.dll) [linkki "http://www.tuubi.net/neansivut/downloads/AccLayer.zip"]löytyy täältä[/linkki]
Imports mshtml  '(Microsoft.mshtml.dll saatavilla Office PIAs-paketissa)
'PIAs Office XP:lle [linkki "http://www.microsoft.com/downloads/en/details.aspx?FamilyID=c41bd61e-3060-4f71-a6b4-01feba508e52&DisplayLang=en"]löytyy täältä[/linkki]
'PIAs Office 2003:lle [linkki "http://www.microsoft.com/downloads/en/details.aspx?familyid=3C9A983A-AC14-4125-8BA0-D36D67E0F4AD&displaylang=en"]löytyy täältä[/linkki]
'PIAs Office 2007:lle [linkki "http://www.microsoft.com/downloads/en/details.aspx?FamilyID=59daebaa-bed4-4282-a28c-b864d8bfa513&displaylang=en"]löytyy täältä[/linkki]
'PIAs Office 2010:lle [linkki "http://www.microsoft.com/downloads/en/details.aspx?FamilyID=5d57c998-b630-4f38-afaa-b79747a3da06"]löytyy täältä[/linkki]

Public Partial Class MainForm

   Private MyAccObject As IAccessible = Nothing
   Private AccNodeObject As IAccessible = Nothing

   Public Sub New()

      Me.InitializeComponent()

   End Sub

   Sub MainFormLoad(sender As Object, e As EventArgs)

      If  CheckInstances(Me.Text) Then
         Me.Dispose(): End
      End If

      Me.AccessibleName = "SwfSpyMainForm"
      Me.AccessibleRole = AccessibleRole.Window
      Me.webBrowser1.AccessibleName ="BrowserWindow"
      Me.webBrowser1.AccessibleRole = AccessibleRole.Window
      Me.panel1.AccessibleName = "BrowserPane"
      Me.panel1.AccessibleRole = AccessibleRole.Pane
      Me.label1.AccessibleName = "DataLabel"
      Me.label1.AccessibleRole = AccessibleRole.Window

   End Sub

   Sub MainFormShown(sender As Object, e As EventArgs)

      WebBrowser1.Url = _
      New Uri("http://content.funny-games.biz/governor-of-poker-2.swf")

   End Sub

   Sub WebBrowser1DocumentCompleted(sender As Object, _
   e As WebBrowserDocumentCompletedEventArgs)

      MyAccObject = Nothing

      Dim CurrentDocument As MSHTML.IHTMLDocument2 = _
      CType(WebBrowser1.Document.DomDocument, IHTMLDocument2)
      Dim embeds As IHTMLElementCollection = CurrentDocument.embeds

      If embeds.length > 0 Then

         Dim mother As IAccessible = _
         Acc.GetAccessibleObjectFromHandle(webBrowser1.Handle)

         If mother IsNot Nothing Then
            Dim children As Object() = _
            Acc.GetAccessibleChildren(mother)
            If children.Length > 0 Then
               For i As Integer = 0 To children.GetUpperBound(0)
                  Dim child As IAccessible = _
                  CType(children(i), IAccessible)
                  If child.accName = "BrowserWindow" Then
                     'kotrollien 'solmut' on etsitty:
                     'AccExplorer32.exe - ohjelmalla [linkki "http://www.expertti.comyr.com/downloads/AccEvent32.zip"]löytyy täältä[/linkki]
                     Erase children: children = _
                     Acc.GetAccessibleChildren(child)
                     child = CType(children(0), IAccessible)

                     Erase children: children = _
                     Acc.GetAccessibleChildren(child)
                     child = CType(children(3), IAccessible)

                     Erase children: children = _
                     Acc.GetAccessibleChildren(child)
                     child = CType(children(0), IAccessible)

                     Erase children: children = _
                     Acc.GetAccessibleChildren(child)
                     child = CType(children(3), IAccessible)

                     Erase children: children = _
                     Acc.GetAccessibleChildren(child)
                     child = CType(children(0), IAccessible)

                     If child.accName = webBrowser1.Url.ToString Then

                        AccNodeObject = child: child = Nothing
                        children = Nothing: mother = Nothing

                     End If: Exit For
                  End If
               Next i
            End If

            If AccNodeObject IsNot Nothing Then
               timer1.Interval = 250: timer1.Enabled = True: timer1.Start
            End If
         End If
      End If

   End Sub

   Sub Timer1Tick(sender As Object, e As EventArgs)

      If webBrowser1.ReadyState <> 4 Then
         Exit Sub
      End If

      If MyAccObject Is Nothing Then

         Dim children As Object() = _
         Acc.GetAccessibleChildren(AccNodeObject)
         Dim child As IAccessible = Nothing
         child = CType(children(0), IAccessible)

         Erase children: children = _
         Acc.GetAccessibleChildren(child)
         child = CType(children(0), IAccessible)

         Erase children: children = _
         Acc.GetAccessibleChildren(child)
         MyAccObject = CType(children(3), IAccessible)

         AccNodeObject = Nothing

      Else

         Dim MyChildren As Object() = _
         Acc.GetAccessibleChildren(MyAccObject)

         'Dim MyPointer As IntPtr = IntPtr.Zero: label1.Text = ""

         For i As Integer = 0 To MyChildren.GetUpperBound(0)

            Dim MyChild As IAccessible = Nothing
            Try
               MyChild = CType(MyChildren(i), IAccessible)
            Catch ex As Exception
            End Try

            If Not MyChild Is Nothing Then
               If MyChild.ToString = "System.__ComObject" Then
                  Try
                     MyChild.accHitTest(1, 1)
                  Catch ex As Exception
                  End Try
                  Try
                     'koska tämä tökkii...
                     'Dim MyProperties As AccPropertySet = _
                     'New AccPropertySet(MyChild)
                     'label1.Text = MyProperties.Value

                     'ja tämä tökkii...
                     'Dim MyProperties As AccPropertySet = _
                     'New AccPropertySet(MyChild)
                     'MyPointer=Marshal.GetIUnknownForObject(MyProperties)
                     'label1.Text += Marshal.PtrToStringAuto(MyPointer)

                     'niin päätin lukea suoraan liittymästä...
                     MyPointer = Marshal.GetIUnknownForObject(MyChild)
                     label1.Text += Marshal.PtrToStringAuto(MyPointer)
                     'elikä jos joku keksii keinon parsia dataa tai
                     'lukea muistia paremmin niin antakoon palaa...
                  Catch ex As Exception
                  End Try
               End If
            End If

         Next

         If MyPointer <> IntPtr.Zero Then
            Dim MyRefCount As Integer = Marshal.Release(MyPointer)
         End If

      End If

      timer1.Start

   End Sub

   Private Function CheckInstances(ByVal AppName As String) As Boolean

      Dim MyProcess As Process() = _
      Process.GetProcessesByName(AppName)

      Dim IsAllReadyRunnig As Boolean

      If Not MyProcess Is Nothing Then
          If MyProcess.Length   > 1 Then
            IsAllReadyRunnig = True
         Else
            IsAllReadyRunnig = False
      End If

      End If

      MyProcess = Nothing

      Return IsAllReadyRunnig

   End Function

   Sub MainFormFormClosing(sender As Object, e As FormClosingEventArgs)

      Try
         Timer1.Stop
      Catch ex As Exception
      End Try

      Timer1.Enabled = False
      Me.Dispose()

   End Sub

   Sub MainFormFormClosed(sender As Object, e As FormClosedEventArgs)

      End

   End Sub

End Class