[VB6] modMemory.bas w/ Debug Privileges (for SC/BW v1.15+) + KEY Grabber Tutorial

[Logos]

The problem with original modMemory.bas was it simply wouldn't work with the latest SC/BW patch. My enhanced version does. Here's the code:

'//=======================================================
'//                    Compiler Options
'//=======================================================
Option Explicit
'//=======================================================
'//                   Author Information
'//=======================================================
'//Author:      NAATYE
'//Date:        3/13/2002
'//Enhanced by: Logos
'//Date:        10/24/2007
'//Description: It should work with SC & BW v1.15+ now
'//Thanks to:   hure (for his working DebugPrivilege module)
'//=======================================================
'//                        Notes
'//=======================================================
'//Undocumented Visual Basic Functions
'//VarPtr() - Finds the address any type but string
'//StrPtr() - Find the address of a string
'//ObjPtr() - Find the address for a object
'//Remember the &H in front of a number converts it from hex
'//=======================================================
'//                   Private Constants
'//=======================================================
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const ANYSIZE_ARRAY = 1
Private Const SE_DEBUG_NAME = "SeDebugPrivilege"
Private Const SE_PRIVILEGE_ENABLED = &H2
'//=======================================================
'//                 Public API Functions
'//=======================================================
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
'//=======================================================
'//                    Private Types
'//=======================================================
Private Type LUID
   lowpart As Long
   highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
   pLuid As LUID
   Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
'//=======================================================
'//                 Private API Functions
'//=======================================================
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, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteString Lib "kernel32" Alias "WriteProcessMemory" (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 WriteValue Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, BufferLength As Any, PreviousState As Any, ReturnLength As Any) As Long

'//=======================================================
'//                   Support Functions
'//=======================================================
Public Function getProcessHandle(pid As Long) As Long
   EnableDebugPrivilege (True)
   getProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid)
   EnableDebugPrivilege (False)
End Function
Public Function EnableDebugPrivilege(bOnOff As Boolean) As Boolean
   Dim tp As TOKEN_PRIVILEGES
   Dim tpPrev As TOKEN_PRIVILEGES
   Dim lid As LUID
   Dim tpSize As Long
   Dim lRet As Long
   Dim hCurProc As Long
   Dim hToken As Long
   
   
   tpSize = Len(tp)
   
   hCurProc = GetCurrentProcess()
   
   lRet = OpenProcessToken(hCurProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
   lRet = LookupPrivilegeValue("", SE_DEBUG_NAME, lid)
   
   tp.PrivilegeCount = 1
   tp.Privileges(0).pLuid = lid
   tp.Privileges(0).Attributes = 0
   
   '//Get Attributes
   lRet = AdjustTokenPrivileges(hToken, 0, tp, tpSize, tpPrev, tpSize)

   tpPrev.PrivilegeCount = 1
   tpPrev.Privileges(0).pLuid = lid
   
   If bOnOff = True Then
      tpPrev.Privileges(0).Attributes = tpPrev.Privileges(0).Attributes Or (SE_PRIVILEGE_ENABLED)
   Else
      tpPrev.Privileges(0).Attributes = tpPrev.Privileges(0).Attributes Xor _
                                         (SE_PRIVILEGE_ENABLED And tpPrev.Privileges(0).Attributes)
   End If

   '//Set Attributes
   lRet = AdjustTokenPrivileges(hToken, 0, tpPrev, tpSize, ByVal CLng(0), ByVal CLng(0))
   
   CloseHandle (hToken)
   EnableDebugPrivilege = CBool(lRet)
End Function
'//=======================================================
'//                    Peek Functions
'//=======================================================
Public Function PeekString(hWnd As Long, Address As Long, Length As Long, Optional TrimString As Boolean = True) As String '//A string is usually terminated by a double null or &h0 therefore if trim string is enabled it will stop looping if a double null is found
Dim pHandle As Long, ByteValue As Byte, I As Long
   
   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       For I = 0 To Length - 1 Step 1
           ReadProcessMemory pHandle, Address + I, ByteValue, 1&, 0&
           
           If (ByteValue = 0) And (TrimString = True) Then
             Exit For
           End If
               
           PeekString = PeekString & Chr$(ByteValue)
       Next
   End If

   CloseHandle pHandle

End Function
Public Function PeekLong(hWnd As Long, Address As Long) As Long
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       ReadProcessMemory pHandle, Address, PeekLong, 4&, 0&
   End If

   CloseHandle pHandle

End Function
Public Function PeekInteger(hWnd As Long, Address As Long) As Integer
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       ReadProcessMemory pHandle, Address, PeekInteger, 2&, 0&
   End If

   CloseHandle pHandle

End Function
Public Function PeekBytes(hWnd As Long, Address As Long, Length As Long) As Byte()
Dim pHandle As Long, Bytes() As Byte, I As Long
   
   ReDim Bytes(Length - 1)
   
   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       For I = 0 To Length - 1 Step 1
           ReadProcessMemory pHandle, Address + I, Bytes(I), 1&, 0&
       Next
   End If

   CloseHandle pHandle

End Function
Public Function PeekByte(hWnd As Long, Address As Long) As Byte
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       ReadProcessMemory pHandle, Address, PeekByte, 1&, 0&
   End If
   
   CloseHandle pHandle

End Function
'//=======================================================
'//                    Poke Functions
'//=======================================================
Public Function PokeString(hWnd As Long, Address As Long, Value As String)
Dim X() As Byte, Z As Long
   ReDim X(Len(Value) - 1)
   
   For Z = 0 To UBound(X)
       X(Z) = Asc(Mid(Value, Z + 1, 1))
   Next Z
   
   PokeString = PokeBytes(hWnd, Address, X())
End Function
Public Function PokeLong(hWnd As Long, Address As Long, Value As Long)
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)

   If (pHandle <> 0) And (Address <> 0) Then
       PokeLong = WriteValue(pHandle, Address, Value, 4&, 0&)
   End If
   
   CloseHandle pHandle

End Function
Public Function PokeInteger(hWnd As Long, Address As Long, Value As Integer)
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)
   
   If (pHandle <> 0) And (Address <> 0) Then
       PokeInteger = WriteValue(pHandle, Address, Value, 2&, 0&)
   End If
   
   CloseHandle pHandle

End Function
Public Function PokeBytes(ByVal hWnd As Long, ByVal Address As Long, ByRef Value() As Byte)
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)

   If (pHandle <> 0) And (Address <> 0) Then
       PokeBytes = WriteProcessMemory(pHandle, Address, Value(0), CLng(UBound(Value) + 1), 0&)
   End If

   CloseHandle pHandle
   
End Function
Public Function PokeByte(ByVal hWnd As Long, ByVal Address As Long, ByRef Value As Byte)
Dim pHandle As Long

   GetWindowThreadProcessId hWnd, pHandle
   pHandle = getProcessHandle(pHandle)

   If (pHandle <> 0) And (Address <> 0) Then
       PokeByte = WriteProcessMemory(pHandle, Address, Value, 1&, 0&)
   End If

   CloseHandle pHandle
   
End Function

Now for the CD KEY-NUMBER grabber tutorial for 1.15.1. This is for when you're at the battle.net login screen in StarCraft or Brood War. (Don't login, just alt+tab from there.)

    Dim hWnd As Long
    Dim nAddress As Long
    Dim sKey As String
    
    'Get the window handle of Brood War
    hWnd = FindWindow("SWarClass", "Brood War")
    
    'If we didn't get any valid (>0) hWnd, try StarCraft's (original's) hwnd instead
    If hWnd = 0 Then hWnd = FindWindow("SWarClass", "Starcraft")
    
    'If we still don't have it, we're out of luck...
    If hWnd = 0 Then MsgBox "Error: StarCraft not found!", vbCritical: Exit Sub
    
    'The value at offset 12FD10 is a pointer to the first character of your CD KEY-NUMBER
    'PeekLong fetches the value at the specified offset for us
    nAddress = PeekLong(hWnd, &H12FD10)
    
    'The CD KEY-NUMBER is 13 characters long, so let's _
    fetch a 13 characters long string from wherever nAdress is pointing to
    sKey = PeekString(hWnd, nAddress, 13, True)
    
    'Done! Now sKey contains our key.

    'For looks turn XXXXXXXXXXXXX into XXXX-XXXXX-XXXX
    sKey = Mid(sKey, 1, 4) & "-" & Mid(sKey, 5, 5) & "-" & Mid(sKey, 10)

It's really that easy. Good luck!

[Perma]

Cool beans. +rep

[LCSBSSRHXXX]

The old modMemory.bas worked fine, you just needed to get debug privileges.

[Logos]

Thanks Perma!

The old modMemory.bas worked fine, you just needed to get debug privileges.

Um, that's sorta what it does. So you won't have to. (Better with one less module or the extra crap in this module instead of somewhere else.) Check thread titles.

[VB6] modMemory.bas w/ Debug Privileges (for SC/BW v1.15+) + KEY Grabber Tutorial (w/ = with)

As always, if you don't don't like it - don't use it. It may be of help to someone though. (I know I prefer the code of my new Key Grabber based on this module compared to my original version I compiled and posted in my sig linky.)

[SubZero]

Nice contribution...

Perhaps you should post up how you found the address to grab the cd key from, since it's a tutorial and stuff

[Logos]

Nice contribution...

Perhaps you should post up how you found the address to grab the cd key from, since it's a tutorial and stuff

Well, actually it was available on the forums. But let's say there was a new patch, this is what we would do: Since it's needed for battle.net play anyway, battle.net login screen is a good place to start. (Of course I tried searching at the main menu first, but I could not find the key there. So let's just skip that step altogether.)

At the Battle.net login screen, alt+tab and simply search for your cd-key as text using your favorite memory searcher (I use ArtMoney). xxxx-xxxxx-xxxx doesn't result in anything (it shouldn't anyways). So we try without the hyphens/dashes (as they're not unique to our key anyway). Now we come up with the offset of our key. Unfortunately, the next time we run StarCraft and go to the battle.net login screen, our key will be stored someplace else. So we need to find a pointer that points to the cd-key (and hope the pointer is static). We search for our key again.

This time, upon finding it (in my case it was found starting at the offset 01D10088), we try to find a pointer pointing to the offset of the first character of our key. To do this, we either use ArtMoney's "Search the pointer to this address" feature or simply search for a 4-Byte Integer with the hex value 01D10088 (the offset of the first character of our key).

This results in 0012FD10 and 0012FDF0. Upon running StarCraft and Brood War multiple times and testing both addresses as pointers they both seem to do the job (they seem to be static pointers pointing at the first offset of our cd-key). You would have to debug the game in order to learn the actual difference between these pointers, but as they both work just settle for either (I used 0012FD10 as I came across it on these very forums).

StarCraft is really that simple. The tutorial was actually meant to be a tutorial on how to use the module to create a key grabber. Not on finding offsets. But if it's of interest, why not? ;)

[bLueStar]

awesome work Bro