Archive for the 'Advanced' Tag

VB Net - Basic MSN Logging Program

Option Strict Off
Option Explicit On
Friend Class Form1
Inherits System.Windows.Forms.Form

Public myHandle As Integer
Dim playing As Boolean
Dim timeplaying As Integer
Dim timeinit As Integer

Function WinMinePID() As Integer
Dim Processes() As System.Diagnostics.Process
”Sets the function to -1 for use in the Gamestate function
WinMinePID = -1
”Gets the process using system diagnostics
Processes = System.Diagnostics.Process.GetProcessesByName(”winmine”)
”If the process exists then it sets the function to the process ID, else the function
‘’still = -1
If Processes.Length > 0 Then WinMinePID = Processes(0).Id
End Function
Sub StatExist()
Dim fileExists As Boolean
Dim stats As String = Application.StartupPath & “/stats.txt”
fileExists = My.Computer.FileSystem.FileExists(stats)
If fileExists = True Then
Else
My.Computer.FileSystem.WriteAllText(stats, (0) & ControlChars.NewLine & 0, False)
End If
Dim times As String = Application.StartupPath & “/times.txt”
fileExists = My.Computer.FileSystem.FileExists(times)
If fileExists = True Then
Else
My.Computer.FileSystem.WriteAllText(times, 0, False)
End If
End Sub
Function GameState() As Integer
”Gamestate Function
”<—0 = Normal—>
”<—1 = Mouse Down—>
”<—2 = Lost—>
”<—3 = Won—>
”<—4 = Face Down—>

”Declerations
Dim buffer As String : Dim addr, readlen, pid As Integer
On Error Resume Next
”Set pid to the process ID of minesweeper using the WinMinePID function
pid = WinMinePID()
stat.Text = “Process Not Found”
”Checks that the process exists
If pid = -1 Then Exit Function
‘Open the proccess with permissions (1F0FFF)
myHandle = OpenProcess(&H1F0FFF, False, pid)
buffer = Space(1)
addr = &H1005160
”Reads the memory at the address above
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
stat.Text = “Logging…”
”Sets the function to equal the value stored at the memory location
GameState = Asc(buffer)
End Function
Sub InitialTime()
Dim times As String = Application.StartupPath & “/times.txt”
timeinit = My.Computer.FileSystem.ReadAllText(times)
End Sub
Sub WriteLog()
StatExist()
Dim gs As Integer = (GameState())
If gs = 2 Then
TimeSave()
If playing = True Then playing = False : LostSave()
ElseIf gs = 3 Then
TimeSave()
If playing = True Then playing = False : WonSave()
Dim readlen As Integer
Dim buffer As String = Space(1)
Dim addr As Integer = &H100579C
”Reads the memory at the address above
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
MsgBox(Asc(buffer))
Else
playing = True
End If
End Sub
Function LostLoad() As Double
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim line As String
Dim lineno As Integer = 0
Dim reader As New IO.StringReader(My.Computer.FileSystem.ReadAllText(stats))
While True
lineno += 1
line = reader.ReadLine()
If lineno = 2 Then LostLoad = line : Exit While
End While
End Function
Sub LostSave()
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim Won As Integer = winsl.Text
Dim Lost As Integer = lossesl.Text
Lost += 1
My.Computer.FileSystem.WriteAllText(stats, (Won) & ControlChars.NewLine & Lost, False)
lossesl.Text = Lost

Dim times As String = My.Computer.FileSystem.CurrentDirectory & “/times.txt”

LostLoad()
End Sub
Function WonLoad() As Double
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim line As String
Dim lineno As Integer = 0
Dim reader As New IO.StringReader(My.Computer.FileSystem.ReadAllText(stats))
While True
lineno += 1
line = reader.ReadLine()
If lineno = 1 Then WonLoad = line : Exit While
End While
End Function
Sub WonSave()
StatExist()
Dim stats As String = My.Computer.FileSystem.CurrentDirectory & “/stats.txt”
Dim Won As Integer = winsl.Text
Dim Lost As Integer = lossesl.Text
Won += 1
My.Computer.FileSystem.WriteAllText(stats, (Won) & ControlChars.NewLine & Lost, False)
winsl.Text = Won
WonLoad()
End Sub

Sub TimeSave()
Dim readlen As Integer
Dim buffer As String = Space(1)
Dim addr As Integer = &H100579C
Call ReadProcessMemory(myHandle, addr, buffer, 1, readlen)
Dim times As String = Application.StartupPath & “/times.txt”
timeplaying = buffer + timeinit
MsgBox(timeplaying)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
WriteLog()
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
StatExist()
winsl.Text = WonLoad()
lossesl.Text = LostLoad()
InitialTime()
End Sub

Private Sub TextChangde(ByVal sender As Object, ByVal e As System.EventArgs) Handles winsl.TextChanged, lossesl.TextChanged
If WonLoad() = 0 And LostLoad() = 0 Then
wrl.Text = 0 & “%”
Else
Dim oneperc As Double
oneperc = (WonLoad() + LostLoad()) / 100
Dim percent As Double
percent = WonLoad() / oneperc
wrl.Text = percent & “%”
End If

End Sub
End Class

Needs a lot of redoing, it works but its very inefficiently coded

VB Net - Add Menus To Minesweeper

  Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
‘*********************************************************************************’
‘***********************************Add Menus*************************************’
‘*********************************************************************************’
MenuHook.SetHook(”Minesweeper”)
Dim menus As New Collection
menus.Add(”Stats”)
menus.Add(”Cheats”)
menus.Add(”About”)
MenuHook.AddMenus(”Other”, menus)
End Sub

Then, for the menuhook class, these are the functions:

Public Class MenuHook

Private Const MF_BYCOMMAND As Integer = &H0
Private Const MF_BYPOSITION As Integer = &H400
Private Const MF_POPUP As Integer = &H10
Private Const MF_STRING As Integer = &H0
Shared Offset As Integer = 2000
Private Const WM_COMMAND As Integer = &H111S
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Declare Function AppendMenu Lib “user32″ Alias “AppendMenuA” (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As String) As Integer
Private Declare Function CreatePopupMenu Lib “user32″ () As Integer
Private Declare Function DrawMenuBar Lib “user32″ (ByVal hwnd As Integer) As Integer
Public Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function GetMenu Lib “user32″ (ByVal hwnd As Integer) As Integer
Private Declare Function GetSubMenu Lib “user32″ (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
Private Declare Function GetMenuState Lib “user32″ (ByVal hMenu As Integer, ByVal wID As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function GetMenuItemCount Lib “user32″ (ByVal hMenu As Integer) As Integer
Private Declare Function InsertMenu Lib “user32″ Alias “InsertMenuA” (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As String) As Integer
Private Declare Function IsWindow Lib “user32″ (ByVal hwnd As Integer) As Integer
Private Delegate Function SubClassProcDelegate(ByVal hwnd As Integer, ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function SetCWPMSGHook Lib “dscwpmsg” (ByVal hwnd As Integer, ByVal AdrCWP As Integer, ByVal AdrMSG As SubClassProcDelegate) As Integer
Declare Function OpenProcess Lib “kernel32″ (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As Integer
Declare Function CloseHandle Lib “kernel32″ Alias “CloseHandle” (ByVal hObject As Integer) As Integer
Declare Function ReadProcessMemory Lib “kernel32″ (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
Private Shared hmen, hNote, hsub As Integer

Private Enum WindowStyles
WS_OVERLAPPED = &H0
WS_POPUP = &H80000000
WS_CHILD = &H40000000
WS_MINIMIZE = &H20000000
WS_VISIBLE = &H10000000
WS_DISABLED = &H8000000
WS_CLIPSIBLINGS = &H4000000
WS_CLIPCHILDREN = &H2000000
WS_MAXIMIZE = &H1000000
WS_BORDER = &H800000
WS_DLGFRAME = &H400000
WS_VSCROLL = &H200000
WS_HSCROLL = &H100000
WS_SYSMENU = &H80000
WS_THICKFRAME = &H40000
WS_GROUP = &H20000
WS_TABSTOP = &H10000
WS_MINIMIZEBOX = &H20000
WS_MAXIMIZEBOX = &H10000
WS_CAPTION = WS_BORDER Or WS_DLGFRAME
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
WS_CHILDWINDOW = WS_CHILD
End Enum

Public Enum Gameover
WON = 1
LOST = 2
End Enum

Public Shared Sub AddMenus(ByVal MenuTitle As String, ByVal MenuItems As Collection)
hmen = GetMenu(hNote)
hsub = CreatePopupMenu
For Each menuitem As String In MenuItems
Offset += 1
AppendMenu(hsub, MF_STRING, Offset, menuitem)
Next
InsertMenu(hmen, 10, MF_BYPOSITION Or MF_POPUP, hsub, MenuTitle)
DrawMenuBar(hNote)
Offset = 2000
End Sub

Public Shared Sub SetHook(ByVal WindowTitle As String)
hNote = FindWindow(vbNullString, WindowTitle)
If IsWindow(hNote) = 0 Then
Do Until IsWindow(hNote)
hNote = FindWindow(WindowTitle, vbNullString)
System.Windows.Forms.Application.DoEvents()
Loop
End If
Call SetCWPMSGHook(hNote, 0, AddressOf Callback)
End Sub

Private Shared Function Callback(ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case wMsg
Case WM_COMMAND
Debug.Print(wParam)
If wParam = 2001 Then
MsgBox(”a”)
ElseIf wParam = 2002 Then
MsgBox(”b”)
ElseIf wParam = 2003 Then
MsgBox(”c”)
ElseIf wParam = 2004 Then
MsgBox(”d”)
End If
End Select
End Function

End Class