This is similar to what I use in Fire Client.
Code:
Usage:
Needed controls:
Code:
Code:
Public Class Client
Inherits NativeWindow
<Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> _
Private Shared Function GetFocus() As IntPtr
End Function
<Runtime.InteropServices.DllImport("user32.dll")> _
Public Shared Function MapVirtualKey _
(ByVal uCode As UInteger, ByVal uMapType As UInteger) As UInteger
End Function
<Runtime.InteropServices.DllImport("user32.dll")> _
Public Shared Function VkKeyScan _
(ByVal ch As Char) As Short
End Function
<Runtime.InteropServices.DllImport("user32.dll")> _
Public Shared Function ClientToScreen _
(ByVal Handle As IntPtr, ByRef Point As Point) As Boolean
End Function
Enum WM
lButtonDown = 513
lButtonUp = 514
rButtonDown = 516
rButtonUp = 517
MouseMove = 512
SetFocus = 7
KeyDown = 256
KeyUp = 257
[Char] = 258
NCHitTest = 132
End Enum
Enum MK
lButton = 1
rButton = 2
End Enum
Sub New(ByVal RsHandle As IntPtr)
Me.AssignHandle(RsHandle)
ClientGraphics = Graphics.FromHwnd(RsHandle)
End Sub
Private Sub CheckFocus()
If GetFocus() <> Me.Handle Then Me.DefWndProc(Message.Create(Me.Handle, 7, 0, 0))
End Sub
Private Sub Pause(ByVal time As Integer)
Threading.Thread.Sleep(time)
Application.DoEvents()
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM.NCHitTest Then
_LastMousePos = New Point(m.LParam)
If DrawMPos Then DrawMouse()
End If
MyBase.WndProc(m)
End Sub
Private ClientGraphics As Graphics
Private _DrawMPos As Boolean = False
Public Property DrawMPos() As Boolean
Get
Return _DrawMPos
End Get
Set(ByVal value As Boolean)
_DrawMPos = value
End Set
End Property
Public Overrides Sub DestroyHandle()
ClientGraphics.Dispose()
MyBase.DestroyHandle()
End Sub
Public Overrides Sub ReleaseHandle()
ClientGraphics.Dispose()
MyBase.ReleaseHandle()
End Sub
Public Sub DrawMouse()
Me.ClientGraphics.FillRectangle(Brushes.Red, New Rectangle(MousePos - New Point(2, 2), New Size(5, 5)))
End Sub
Public Sub LeftSilentClick(Optional ByVal Pause As Integer = 70)
CheckFocus()
Me.DefWndProc(Message.Create(Me.Handle, WM.lButtonDown, MK.lButton, MakeLWord(MousePos)))
Application.DoEvents()
Threading.Thread.Sleep(Pause)
Me.DefWndProc(Message.Create(Me.Handle, WM.lButtonUp, MK.lButton, MakeLWord(MousePos)))
End Sub
Public Sub RightSilentClick(Optional ByVal Pause As Integer = 70)
CheckFocus()
Me.DefWndProc(Message.Create(Me.Handle, WM.rButtonDown, MK.rButton, MakeLWord(MousePos)))
Application.DoEvents()
Threading.Thread.Sleep(Pause)
Me.DefWndProc(Message.Create(Me.Handle, WM.rButtonUp, MK.rButton, MakeLWord(MousePos)))
End Sub
Private Function MakeLWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As IntPtr
Return (HiWord << 16) Or (LoWord And &HFFFF)
End Function
Private Function MakeLWord(ByVal P As Point) As IntPtr
Return (P.Y << 16) Or (P.X And &HFFFF)
End Function
Dim _LastMousePos As Point = New Point(0, 0)
Public Property MousePos() As Point
Get
Dim P As New Point
ClientToScreen(Me.Handle, P)
Return _LastMousePos - P
End Get
Set(ByVal value As Point)
Dim P As New Point
ClientToScreen(Me.Handle, P)
_LastMousePos = value + P
Me.WndProc(Message.Create(Me.Handle, WM.NCHitTest, IntPtr.Zero, MakeLWord(_LastMousePos)))
End Set
End Property
Private Function RandomPoint(ByVal R As Rectangle) As Point
Dim L As New Random
Return New Point(L.Next(R.Left, R.Right), L.Next(R.Top, R.Bottom))
End Function
Public Sub SmoothMove(ByVal Dest As Drawing.Point, ByVal Speed As Single)
Dim Cur As Double
Dim F As Drawing.Point = Me.MousePos
Dim D As Drawing.Point = Dest - Me.MousePos
For Cur = 0 To 1 Step (Speed / (Math.Sqrt(D.X ^ 2 + D.Y ^ 2)))
Me.MousePos = F + New Drawing.Point(D.X * Cur, D.Y * Cur)
Application.DoEvents()
Threading.Thread.Sleep(3)
Next
End Sub
Public Function SmoothArch(ByVal Destination As Point, Optional ByVal Speed As Double = 7) As Drawing2D.GraphicsPath
Dim C As New Drawing2D.GraphicsPath
Dim X As Integer() = {Me.MousePos.X, Destination.X} : Array.Sort(X)
Dim Y As Integer() = {Me.MousePos.Y, Destination.Y} : Array.Sort(Y)
Dim Between As Rectangle = Rectangle.FromLTRB(X(0), Y(0), X(1), Y(1))
Between.Inflate(3, 3)
C.AddCurve(New Point() {MousePos, RandomPoint(Between), Destination})
C.Flatten()
For Each P As PointF In C.PathPoints
SmoothMove(New Point(P.X, P.Y), Speed)
Next
Return C
End Function
Public Sub SilentLogin(ByVal UserName As String, ByVal Password As String)
Dim DMP As Boolean = Me.DrawMPos
Me.DrawMPos = True
CheckFocus()
Dim Button1Area As New Rectangle(395, 275, 135, 33)
Dim Button2Area As New Rectangle(235, 305, 135, 33)
Dim TextArea As New Rectangle(361, 250, 20, 5)
SmoothArch(RandomPoint(Button1Area))
Pause(200)
Me.LeftSilentClick()
Pause(200)
SmoothArch(RandomPoint(TextArea))
Pause(200)
Me.LeftSilentClick()
Pause(200)
Me.SilentText(UserName)
Pause(100)
Me.SilentText(Chr(13))
Pause(100)
Me.SilentText(Password, 50)
Pause(100)
SmoothArch(RandomPoint(Button2Area))
Pause(200)
Me.LeftSilentClick()
Me.DrawMPos = DMP
End Sub
Public Sub SilentText(ByVal text As String, Optional ByVal Pause As Integer = 30)
CheckFocus()
Application.DoEvents()
For Each D As Char In text
Dim K As Integer = VkKeyScan(D)
Dim M As IntPtr = MapVirtualKey(K, 0)
Me.DefWndProc(Message.Create(Me.Handle, WM.KeyDown, K, M))
Me.DefWndProc(Message.Create(Me.Handle, WM.Char, Asc(D), 0))
Me.DefWndProc(Message.Create(Me.Handle, WM.KeyUp, K, M))
Threading.Thread.Sleep(Pause + New Random().Next(0, 100))
Application.DoEvents()
Next
End Sub
End ClassUsage:
Needed controls:
- WebBrowser called "WebBrowser1"
- Button called "LoadWorld"
- Button called "LoginButton"
Code:
Dim MyRSClient As Client
Private Sub LoadWorld_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LoadWorld.Click
Me.WebBrowser1.AllowNavigation = False
Me.WebBrowser1.Navigate("http://va1.runescape.com/lang/en/aff/runescape/game.ws?lowmem=1&plugin=0")
End Sub
Private Sub LoginButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LoginButton.Click
If MyRSClient Is Nothing Then Return
MyRSClient.SilentLogin("username here", "Password here")
End Sub
Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
Debug.WriteLine("Stolen")
MyRSClient = New Client(StealMethod.Steal(sender))
End Sub
Private Sub WebBrowser1_Navigating(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserNavigatingEventArgs) Handles WebBrowser1.Navigating
e.Cancel = e.Url.ToString Like "http://*runescape.*/"
For Each El As HtmlElement In CType(sender, WebBrowser).Document.GetElementsByTagName("IFRAME")
El.OuterHtml = ""
Application.DoEvents()
Next
End Sub
Public NotInheritable Class StealMethod
Public Shared Function Steal(ByVal Browser As WebBrowser) As IntPtr
If Not Browser.Url.ToString Like "http://*.runescape.com/lang/*/aff/runescape/game.ws?lowmem=*&plugin=*" Then
Return Nothing
End If
For Each El As HtmlElement In Browser.Document.GetElementsByTagName("IFRAME")
El.OuterHtml = ""
Application.DoEvents()
Next
Dim List As List(Of IntPtr) = GetChildWindows(Browser.Handle)
List.Reverse()
Return List(0)
End Function
Public Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As List(Of IntPtr)
Dim result As New List(Of IntPtr)()
Dim listHandle As Runtime.InteropServices.GCHandle = Runtime.InteropServices.GCHandle.Alloc(result)
Try
EnumChildWindows(ParentHandle, AddressOf EnumWindow, Runtime.InteropServices.GCHandle.ToIntPtr(listHandle))
Catch ex As Exception
Throw ex
If listHandle.IsAllocated Then
listHandle.Free()
End If
End Try
Return result
End Function
Private Shared Function EnumWindow(ByVal handle As IntPtr, ByVal pointer As IntPtr) As Boolean
Dim gch As Runtime.InteropServices.GCHandle = Runtime.InteropServices.GCHandle.FromIntPtr(pointer)
Dim list As List(Of IntPtr) = TryCast(gch.Target, List(Of IntPtr))
If list Is Nothing Then
Throw New InvalidCastException("GCHandle Target could not be cast as List(Of IntPtr)")
End If
list.Add(handle)
Return True
End Function
<Runtime.InteropServices.DllImport("user32")> _
Public Shared Function EnumChildWindows(ByVal window As IntPtr, ByVal callback As EnumWindowProc, ByVal i As IntPtr) As Boolean
End Function
Public Delegate Function EnumWindowProc(ByVal hWnd As IntPtr, ByVal parameter As IntPtr) As Boolean
End Class
