Identifying whether user is in an active game

**bulk_4me** · 06-19-2005 10:41 PM

Vala(0) instead of Vala in all your code.. duh.

**LockesRabb** · 06-19-2005 10:46 PM

Code:

    Dim Vala(0) As Byte
    
    ReadProcessMemory pHandle, &H645E54, Vala(0), &H1, 0&
    
    MsgBox Vala(0)
    Exit Sub

Still results in Type Mismatch... (BTW, thanks for helping thus far!)

**bulk_4me** · 06-19-2005 10:54 PM

In the same place?

**LockesRabb** · 06-19-2005 11:07 PM

Originally Posted by bulk_4me

In the same place?

Yeah... I don't get it- in the module, that variable is declared as Any, so it shouldn't matter what type of variable I use...

Feel free to IM me either on yahoo or aim, if you want. My contact info is in my profile.

**Dyndrilliac** · 06-19-2005 11:33 PM

Code:

Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Public Function InGame() As Boolean
    Dim lpWnd, lpId, lpHandle As Long
    Dim Buffer As Byte
    
    lpWnd = FindWindow("SWarClass", "Brood War")
    
    If (lpWnd <> 0) Then
        GetWindowThreadProcessId lpWnd, lpId
        lpHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lpId)
        ReadProcessMemory lpHandle, &H645E54, Buffer, 1, 0&
        CloseHandle lpHandle
    Else
        MsgBox "There has been an error, and Starcraft's Window cannot be found.", vbCritical, "Error!"
        End
    End If
    
    If (Buffer <> 1) Then
        InGame = False
    Else
        InGame = True
    End If
End Function

Try that, it should work. Your problem was you weren't calling ReadProcessMemory() correctly. There should be no "&H" to denote the value as Hex.

**LockesRabb** · 06-19-2005 11:56 PM

Dyndrilliac-

Excellent solution- it works perfectly. But I'd like to know what I did wrong, how was I not calling RPM correctly?

**Dyndrilliac** · 06-20-2005 12:03 AM

Like I said, you incorrectly told it the number of bytes you were writing to the Buffer. You have to make sure of two things: 1) That the number of bytes corresponds correctly with the datatype your using as the buffer (I.E.: a Long datatype must recieve 4 bytes, a Short must recieve 2, etc). 2) The number you give it must be just a number, (I.E.: You had an "&H" coming before the 1, this is unnecessary. Also, it errors because you can only do that with Long datatypes.

**bulk_4me** · 06-20-2005 12:07 AM

Originally Posted by Dyndrilliac

Like I said, you incorrectly told it the number of bytes you were writing to the Buffer. You have to make sure of two things: 1) That the number of bytes corresponds correctly with the datatype your using as the buffer (I.E.: a Long datatype must recieve 8 bytes, a Short must recieve 2, etc). 2) The number you give it must be just a number, (I.E.: You had an "&H" coming before the 1, this is unnecessary. Also, it errors because you can only do that with Long datatypes.

Gee.. the &H was the problem.

**LockesRabb** · 06-20-2005 12:08 AM

Originally Posted by bulk_4me

Gee.. the &H was the problem.

LOL Yeah, I felt like a fool when he pointed it out.

But hey, one learns something new everyday!

**LockesRabb** · 06-20-2005 12:11 AM

Ahhh... Makes sense now... Thanks for the solution! I'll make sure you get full credit for this function, if you want it!

If you don't mind, can you look at the timer problem I've been having? People seem to have gotten stuck on this and are unable to help, both on BWHacks.com and ValhallaLegends.com. Here're the threads:

http://www.bwhacks.com/forums/showthread.php?t=4987
http://forum.valhallalegends.com/php...?topic=11842.0

Thoughts would be appreciated. The timer issue has been driving me crazy. Literally. Heh.

**SubZero** · 06-20-2005 12:58 AM

Just declare Vala as a byte and remove the "Vala=" before the RPM(also, invoke RPM properly). I can't confirm this for sure, cos I havn't coded VB in eons.

Er, I did say you were declaring RPM wrongly. Geez. Why doesn't anyone listen to me? lol.

**LockesRabb** · 06-20-2005 01:05 AM

Originally Posted by SubZero

Er, I did say you were declaring RPM wrongly. Geez. Why doesn't anyone listen to me? lol.

I heard you- scroll up, you'll see I asked you for a clarification as to what you meant by me not invoking it properly. You were busy at the moment to respond to it, so somebody else took the opportunity to clarify. ;) :P

**Dyndrilliac** · 06-20-2005 02:17 AM

There are two mistakes that I as a programmer can see with your code.

1) GetTickCount() returns the number of milliseconds since your computer was turned on. This depending on how long your computer has been on can be a huge number, and therefore too big for a Long datatype to handle. In which case, you can use the Decimal datatype. It goes as high as 12 bytes, which is three times the maximum size of a Long integer. This problem however is the least likely (and least harmful, by far) of the two I see.

Source: GetTickCount()

2) You are once again giving the wrong parameters to the system functions. This time though you are doing extremely bad. The last parameter of WriteProcessMemory should almost always be NULL (0& in VB, NULL in C++). Also, you gave it the wrong amount of bytes to write to on one occassion.

In either case, the following code should work. By the way, I took the liberty of combining the InGame function and the MessagHook's sub-routine and making it neater.

Code:

Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private lpWnd, lpId, lpHandle As Long
Private bGameActive As Boolean

'Call this at program startup, preferable in a main sub-routine or in the main forms
'load event.
'This allows us to only have to call this stuff once, making us more memory efficient.
Public Sub Initialize()
    Dim iResult As Integer
    lpWnd = FindWindow("SWarClass", "Brood War")
    
    If (lpWnd <> 0) Then
        bGameActive = True
        GetWindowThreadProcessId lpWnd, lpId
        lpHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lpId)
    Else
        bGameActive = False
        iResult = MsgBox("Starcraft is not running! Please turn it on now, then hit Ok.", vbOKCancel + vbCritical, "Error!")
        If (iResult = vbOK) Then
            Call Initialize
        Else
            End
        End If
    End If
End Sub

'// Call this before closing the program, preferably on the main forms Unload event.
Public Sub CleanUp()
    If (bGameActive = False) Then
        Exit Sub
    Else
        CloseHandle lpHandle
        bGameActive = False
    End If
End Sub

'Call this sub-routine with your message as the first parameter and the length of time
'in milliseconds that you want as the delay for the second parameter.
Public Sub SendMessageHook(szMessage As String, lDelay As Long)
    If (bGameActive = False) Then
        Exit Sub
    End If
    Dim Delay As Long
    
    Delay = ((GetTickCount()) + lDelay)
'Notice that because we are writing a Long to memory, we use 4 bytes because that's the
'size of a Long datatype.
    WriteProcessMemory lpHandle, &H659180, Delay, 4, 0&
'Also take notice that we gave a NULL value for the last parameter.
    WriteProcessMemory lpHandle, &H658D1C, szMessage, Len(szMessage), 0&
End Sub

Public Function InGame() As Boolean
    If (bGameActive = False) Then
        Exit Sub
    End If
    Dim Buffer As Byte

    ReadProcessMemory lpHandle, &H645E54, Buffer, 1, 0&
    
    If (Buffer <> 1) Then
        InGame = False
    Else
        InGame = True
    End If
End Function

**LockesRabb** · 06-20-2005 03:10 AM

Nice, and clean. Logical too! It successfully places the message in the message offset. I modified the code to append a chr$(0) to the end of the message to ensure Starcraft displays the intended string since it will display until it hits a null byte.

However, as much as I wish it otherwise, the Timer write failed. Or if it succeeded, I did not see any results. If the code worked, it'd have displayed "This is a test" for ten seconds (10000 milliseconds) so I'd have had enough time to switch to SC and see it being displayed. I saw nothing being displayed... When I modify the memory directly to 0f0f0f0f, the string displays without a problem, but it stays on permanently.

This is my code with the updates you introduced:

Main.frm:

Code:

Private Sub cmdDisplay_Click()
    
    'Let's make sure the person is running Starcraft
    'and is currently in an active game.
    
    If InGame = False Then
            MsgBox "You must be in an active game!"
            Exit Sub
    End If
    
    If Text1.Text <> "" Then
        If SendSCMsg(Text1.Text, 10000) = True Then MsgBox "Done"
    End If
        
End Sub

Private Sub Form_Load()
    Initialize
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CleanUp
End Sub

Module.bas:

Code:

Option Explicit

'Process Function Management Declarations
'---------------------------------------------------
'Used to read and write to memory. Memory Writing must be enabled
'For this to work.


Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private lpWnd, lpId, lpHandle As Long
Private bGameActive As Boolean

Private Const GAME_STATE As Long = &H645E54

Public Function InGame() As Boolean
    If (bGameActive = False) Then
        Exit Function
    End If
    Dim Buffer As Byte

    ReadProcessMemory lpHandle, GAME_STATE, Buffer, 1, 0&
    
    If (Buffer <> 1) Then
        InGame = False
    Else
        InGame = True
    End If
End Function

Public Function SendSCMsg(Message As String, Delay As Long) As Boolean
    
    If (bGameActive = False) Then
        SendSCMsg = False
        Exit Function
    End If
    
    Message = Message & Chr$(0)
    
    Delay = ((GetTickCount()) + Delay)
    WriteProcessMemory lpHandle, &H659180, Delay, 4, 0&
    WriteProcessMemory lpHandle, &H658D1C, Message, Len(Message), 0&
    
    SendSCMsg = True
    
End Function

Public Sub Initialize()

    Dim iResult As Integer
    lpWnd = FindWindow("SWarClass", "Brood War")
    
    If (lpWnd <> 0) Then
        bGameActive = True
        GetWindowThreadProcessId lpWnd, lpId
        lpHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lpId)
    Else
        bGameActive = False
        iResult = MsgBox("Starcraft is not running! Please turn it on now, then hit Ok.", vbOKCancel + vbCritical, "Error!")
        If (iResult = vbOK) Then
            Call Initialize
        End If
    End If

End Sub

Public Sub CleanUp()
    If (bGameActive = False) Then
        Exit Sub
    Else
        CloseHandle lpHandle
        bGameActive = False
    End If
End Sub

**Dyndrilliac** · 06-20-2005 03:52 AM

As much as I hate to nitpick at peoples code, allow me to fix it yet again. There are a few minute syntax details that you seem to be ignoring.

Code:

Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private lpWnd, lpId, lpHandle As Long
Private bGameActive As Boolean

Sub Main()
    Call Initialize
    Dim bMainLoop As Boolean, strGameMessage As String, lngMessageDelay As Long, intMsgBoxResult As Integer

    Do While (bMainLoop = False)
        intMsgBoxResult = MsgBox("Would you like to send a message in Starcraft?", vbYesNo + vbQuestion, "Message Sender")
        If intMsgBoxResult = vbNo Then
            bMainLoop = False
        Else
            If (InGame() = False) Then
                MsgBox "The message cannot be sent, because you are not in a game! The program will now close.", vbCritical, "Error!"
                bMainLoop = False
            Else
                strGameMessage = InputBox("What message would you like to send?", "Message Input", "Enter message here.", 500, 700)
                lngMessageDelay = CLng(InputBox("What would you like to set the timer to?", "Delay Input", "Enter delay in milliseconds here.", 500, 700))
                Call SendMessageHook(strGameMessage, lngMessageDelay)
                intMsgBoxResult = MsgBox("Would you like to send another message?", vbYesNo + vbQuestion, "Message Sender")
                If intMsgBoxResult = vbNo Then
                    bMainLoop = False
                Else
                    bMainLoop = True
                End If
            End If
        End If
    Loop
    Call CleanUp
End Sub

Public Sub Initialize()
    Dim iResult As Integer
    lpWnd = FindWindow("SWarClass", "Brood War")
    
    If (lpWnd <> 0) Then
        bGameActive = True
        GetWindowThreadProcessId lpWnd, lpId
        lpHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lpId)
    Else
        bGameActive = False
        iResult = MsgBox("Starcraft is not running! Please turn it on now, then hit Ok.", vbOKCancel + vbCritical, "Error!")
        If (iResult = vbOK) Then
            Call Initialize
        Else
            End
        End If
    End If
End Sub

Public Sub CleanUp()
    If (bGameActive = False) Then
        Exit Sub
    Else
        CloseHandle lpHandle
        bGameActive = False
    End If
End Sub

Public Sub SendMessageHook(szMessage As String, lDelay As Long)
    If (bGameActive = False) Then
        Exit Sub
    End If
    Dim Delay As Long
    
    Delay = ((GetTickCount()) + lDelay)

    szMessage = szMessage & Chr$(0)

    WriteProcessMemory lpHandle, &H659180, Delay, 4, 0&
    WriteProcessMemory lpHandle, &H658D1C, szMessage, Len(szMessage), 0&
End Sub

Public Function InGame() As Boolean
    If (bGameActive = False) Then
        Exit Function
    End If
    Dim Buffer As Byte

    ReadProcessMemory lpHandle, &H645E54, Buffer, 1, 0&
    
    If (Buffer <> 1) Then
        InGame = False
    Else
        InGame = True
    End If
End Function

Paste that into a module exactly as it is. Remove all the forms from your project and everything else in there besides this module. Now go up to the menu and goto "Project". Scroll down to "<Your Project's Name> Properties". Now, under "Startup Object" to the right make sure you have "Sub Main" selected and hit ok.

This should fix all the problems you may have.

**gamepin126** · 06-20-2005 08:09 AM

I suggest picking up a better language. http://www.haskell.org/ :D It's a new programming language, funny thing is. It's a fully functional one.

**Dyndrilliac** · 06-20-2005 08:47 AM

Visual Basic is perfectly fine. It's not exactly hindered, it's just much more GUI and RAD oriented than say a powerful low-level language like C++.

**l)ragon** · 06-20-2005 12:03 PM

resulter = ReadProcessMemory(ProcessHandle, ByVal Address&, tmpByte, 1, 0&)

**LockesRabb** · 06-20-2005 08:46 PM

Originally Posted by l)ragon

resulter = ReadProcessMemory(ProcessHandle, ByVal Address&, tmpByte, 1, 0&)

What difference does that make?

**Blaze** · 06-20-2005 08:55 PM

ByRef or blank means that you are referencing a variable, byval means it creates the variable, and you insert the value.

Thread: Identifying whether user is in an active game

LinkBack

Thread Tools

Thread Information

Users Browsing this Thread

Similar Threads

Tecmo Sues Game Hackers Under DMCA

Lobby Ops Address.......

D2 Rollbacking

is there any way to place COP's throughout the whole game

Posting Rules