[Помогите!] ReadProcessMemory и Visual Basic

[sedrik1992]

Доброго времени суток!

Решил я вспомнить ВБ, и понял, что на делфи мне уже легче)
Пытался написать элементарную программку, которая бы считывала какое-либо значение по заданному адресу.

Прокопался несколько часов, так и ничего не добился, выдает все время ноль((

Цитата: Option Explicit 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.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, _ lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Private Const PROCESS_ALL_ACCESS = 2035711 __________________________________________________ _________ Private Sub Command1_Click() Dim hwnd, NoB As Long Dim out As Long Dim procId As Long Dim procHandle As Long hwnd = FindWindow(vbNullString, "Perfect World") GetWindowThreadProcessId hwnd, procId procHandle = OpenProcess(PROCESS_ALL_ACCESS, False, procId) Call ReadProcessMemory(procHandle, &HC38B6C, ByVal VarPtr(out), 4, NoB) Print out CloseHandle procHandle End Sub

[ToRcH2565]

Эмм, а чем делфи не устроил?)

[sedrik1992]

Да делфи устроил, бота уже доделываю, а вот стало интересно на счет бэйсика и тут такое))
не читает значение и всё...

[bestbeer]

1)

Цитата: Private Const PROCESS_ALL_ACCESS = 2035711

замени на Public Const PROCESS_ALL_ACCESS = &H1F0FF

2) vb6- труп, vb.net лучше.

Цитата: Сообщение от ToRcH2565 Эмм, а чем делфи не устроил?)

Не всеж на дельфиях и плюсах писать

[sedrik1992]

Свершилось! ) Всё-таки смог прочитать текущее значение здоровья:

Цитата: Private Const PROCESS_VM_READ = &H10 Private Const PROCESS_VM_WRITE = &H20 Private Const PROCESS_VM_OPERATION = &H8 Private Const PROCESS_VM = PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE 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 Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long __________________________________________________ _______ Private Sub command1_Click() Dim hWnd As Long, PId As Long, hProcess As Long, buf As Long hWnd = FindWindow(vbNullString, "Perfect World") Call GetWindowThreadProcessId(hWnd, PId) hProcess = OpenProcess(PROCESS_VM, 0&, PId) Call ReadProcessMemory(hProcess, &HC38B6C, VarPtr(buf), 4, 0&) buf = buf + &H1C Call ReadProcessMemory(hProcess, buf, VarPtr(buf), 4, 0&) buf = buf + &H34 Call ReadProcessMemory(hProcess, buf, VarPtr(buf), 4, 0&) buf = buf + &H4A8 Call ReadProcessMemory(hProcess, buf, VarPtr(buf), 4, 0&) MsgBox buf Call CloseHandle(hProcess) End Sub

Давняя идея просто была, поиздеваться над другом и показать ему "Бота в Excell", написанного на VBA.
перевести код бота просто, единственная заморочка была с чтением из памяти.

[ToRcH2565]

//Офтоп) Чу мелочится? напишите бота на JS и запускайте в браузере

[Panki-online]

Доброго времени суток! Именно с этого поста начал экспериментировать с разработкой ПО для ПВ. До этого API-функциями не пользовался. В обще данная прога что будучи сделана в Экселе, что в Визуал Студио 2008 в "Семёрке" не желает работать. Функция OpenProcess выдаёт 5 - ACCESS DENIED. Пробовал отключать UAC - функция ReadProcessMemory выдаёт ошибки, то 5 (доступ запрещён), то 6 (попытка чтения-записи в защищённую область). Пробовал запускать в ХР - всё прекрасно работает, правда комп с ХР тормозной очень. Как заставить работать прогу на "Семёрке"?

[Ginrey]

Panki-online о великий запуск от имени администратора, попробуйте использовать его ))

[Panki-online]

от ошибки чтения-записи в защищённую область меня это не спасает

[bestbeer]

У меня не было проблем с чтением/записью памяти в VS 2013 Express . В компиляторе попробуй поставить AnyCPU и галочку "предпочтительно для 32-разрядн" , если такого нету - нужно качать новую студию.

[Ginrey]

Цитата: от ошибки чтения-записи в защищённую область меня это не спасает

в пв нет такой области памяти которую вы бы не могли прочитать, только лишь та, которой не существует. проверьте открывается ли вообще процесс или нет

[Panki-online]

А что, функции типа OpenProcessToken и прочую лабуду с правами доступа никто не использовал, и у всех всё получилось? Чёрт побери, Холмс, но как? Ещё неделя пролетела безрезультатно. Сейчас вот пробую получить привилегию SE_DEBUG_NAME, но функция OpenProcessToken, даже будучи применена к собственному процессу программы возвращает 0 в качестве результата и 0 же в качестве токена. И опять непонятно почему это. GetLastError заявляет об ошибке 998 (Invalid access to memory location.). Может кто знает, в чём дело?

[bestbeer]

Цитата: Сообщение от bestbeer У меня не было проблем с чтением/записью памяти в VS 2013 Express . В компиляторе попробуй поставить AnyCPU и галочку "предпочтительно для 32-разрядн" , если такого нету - нужно качать новую студию.

Нужно качать новую студию

[Panki-online]

Если есть у кого Студия 13, проверьте пожалуйста этот код на нёй:

Цитата: Public Class Form1 Dim hWnd As Integer ' параметры Perfect World Dim idProc As Integer Dim hProc As Integer Dim MyhWnd As Integer ' параметры текущей проги Dim MyidProc As Integer Dim MyhProc As Integer Const PROCESS_ALL_ACCESS = &H1F0FFF '2035711 Private Const PROCESS_VM_READ = &H10 Private Const PROCESS_VM_WRITE = &H20 Private Const PROCESS_VM_OPERATION = &H8 Private Const PROCESS_VM = &H1F0FFF 'PROCESS_VM_OPERATION or PROCESS_VM_READ Or PROCESS_VM_WRITE Private Sub cmdStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdStart.Click Dim hToken As Integer ' Handle to your process token. Dim lPrivilege As Integer ' Privilege to enable/disable Dim iPrivilegeflag As Boolean ' Flag whether to enable/disable ' the privilege of concern. Dim lResult As Integer ' Result call of various APIs. Dim hProcess As Integer 'MyhWnd = FindWindow(vbNullString, "Form1") 'GetWindowThreadProcessId(MyhWnd, MyidProc) 'MyhProc = OpenProcess(PROCESS_ALL_ACCESS, False, MyidProc) 'hProcess = MyhProc 'GetCurrentProcess hProcess = GetCurrentProcess hWnd = FindWindow(vbNullString, "Perfect World") txtHandle.Text = hWnd.ToString GetWindowThreadProcessId(hWnd, idProc) txtIdProc.Text = idProc.ToString lResult = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or _ TOKEN_QUERY, hToken) If (lResult = 0) Then MsgBox("Не могу получить токен процесса. Ошибка №" & _ GetLastError) '& Err.LastDllError) 'CloseHandle(hToken) Exit Sub End If lResult = SetPrivilege(hToken, SE_DEBUG_NAME, True) If (lResult = False) Then MsgBox("Ошибка: не могу получить привилегию SE_DEBUG_NAME") CloseHandle(hToken) Exit Sub End If hProc = OpenProcess(PROCESS_ALL_ACCESS, False, idProc) If hProc = 0 Then MsgBox(GetLastError()) CloseHandle(hToken) Exit Sub End If MsgBox("hProc=" & hProc) CloseHandle(hToken) CloseHandle(hProcess) 'MsgBox(hProc) 'CloseHandle(hProc) 'Timer1.Enabled = True End Sub Private Function SetPrivilege(ByVal hToken As Integer, ByVal Privilege As String, _ ByVal bSetFlag As Boolean) As Boolean Dim TP As TOKEN_PRIVILEGES ' Used in getting the current ' token privileges Dim TPPrevious As TOKEN_PRIVILEGES ' Used in setting the new ' token privileges Dim Luid As Luid ' Stores the Local Unique ' Identifier - refer to MSDN Dim cbPrevious As Integer ' Previous size of the ' TOKEN_PRIVILEGES structure Dim lResult As Integer ' Result of various API calls ' Grab the size of the TOKEN_PRIVILEGES structure, ' used in making the API calls. cbPrevious = Len(TP) ' Grab the LUID for the request privilege. lResult = LookupPrivilegeValue("", Privilege, Luid) ' If LoopupPrivilegeValue fails, the return result will be zero. ' Test to make sure that the call succeeded. If (lResult = 0) Then SetPrivilege = False End If ' Set up basic information for a call. ' You want to retrieve the current privileges ' of the token under concern before you can modify them. TP.PrivilegeCount = 1 TP.Privileges(0).pLuid = Luid TP.Privileges(0).Attributes = 0 SetPrivilege = lResult ' You need to acquire the current privileges first lResult = AdjustTokenPrivileges(hToken, -1, TP, Len(TP), _ TPPrevious, cbPrevious) ' If AdjustTokenPrivileges fails, the return result is zero, ' test for success. If (lResult = 0) Then SetPrivilege = False End If ' Now you can set the token privilege information ' to what the user is requesting. TPPrevious.PrivilegeCount = 1 TPPrevious.Privileges(0).pLuid = Luid ' either enable or disable the privilege, ' depending on what the user wants. Select Case bSetFlag Case True : TPPrevious.Privileges(0).Attributes = _ TPPrevious.Privileges(0).Attributes Or _ (SE_PRIVILEGE_ENABLED) Case False : TPPrevious.Privileges(0).Attributes = _ TPPrevious.Privileges(0).Attributes Xor _ (SE_PRIVILEGE_ENABLED And _ TPPrevious.Privileges(0).Attributes) End Select ' Call adjust the token privilege information. lResult = AdjustTokenPrivileges(hToken, -1, TPPrevious, _ cbPrevious, TP, cbPrevious) ' Determine your final result of this function. If (lResult = 0) Then ' You were not able to set the privilege on this token. SetPrivilege = False Else ' You managed to modify the token privilege SetPrivilege = True End If End Function End Class

Содержание модуля:

Цитата: Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer Public Declare Function CloseWindow Lib "user32" (ByVal hwnd As Integer) As Integer Public Declare Function OpenIcon Lib "user32" (ByVal hwnd As Integer) As Integer Public Declare Auto Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As IntPtr, ByRef lpdwProcessId As IntPtr) As Integer 'IntPtr Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd, ByVal Msg, ByVal wParam, ByVal lParam) Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwProcessId As Integer) As Integer Public Declare Function CloseHandle Lib "kernel32" (ByVal Hproc As Integer) Public Declare Sub ReadProcessMemory Lib "kernel32" (ByVal THandle As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As Integer, ByVal nSize As Integer, ByVal lpNumberOfBytesReadas As Integer) Public Declare Function GetLastError Lib "kernel32" () As Integer ' Constants used for various API calls. Refer to MSDN for detailed ' information about what these constants mean. Public Const TOKEN_ADJUST_PRIVILEGES = &H20 Public Const TOKEN_QUERY = &H8 Public Const ANYSIZE_ARRAY = 1 Public Const PROCESS_ALL_ACCESS = &H1F0FFF Public Const SE_DEBUG_NAME = "SeDebugPrivilege" Public Const SE_PRIVILEGE_ENABLED = &H2 ' Structures used with various API calls. ' Refer to MSDN for detailed information ' about what these structures are, and how they are used. Structure LARGE_INTEGER Public lowpart As Integer Public highpart As Integer End Structure Structure Luid Public lowpart As Integer Public highpart As Integer End Structure Structure LUID_AND_ATTRIBUTES Public pLuid As Luid Public Attributes As Integer End Structure Structure TOKEN_PRIVILEGES Public PrivilegeCount As Integer Public Privileges() As LUID_AND_ATTRIBUTES End Structure Declare Function GetCurrentProcess Lib "kernel32" () As Integer Declare Function OpenProcessToken Lib "advapi32.dll" _ (ByVal ProcessHandle As Integer, ByVal DesiredAccess As Integer, _ ByVal TokenHandle As Integer) As Integer Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _ "LookupPrivilegeValueA" (ByVal lpSystemName As String, _ ByVal lpName As String, ByVal lpLuid As Luid) As Integer Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _ (ByVal TokenHandle As Integer, ByVal DisableAllPrivileges As Long, _ ByVal NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _ ByVal PreviousState As TOKEN_PRIVILEGES, ByVal ReturnLength As Long) As Long

Ато пока я со своим инетом скачаю 13ю студию, наступят следующие выходные.

[bestbeer]

А вы уверены что код рабочий?
Я вот получаю список процессов без всяких токенов.
Простой пример:

 Public Class Form1

    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As UInteger, ByVal bInheritHandle As UInteger, ByVal dwProcessId As UInteger) As Integer
    Public Declare Function ReadProcessMemory Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As UInteger, ByVal lpBaseAddress As UInteger, ByRef lpBuffer As UInteger, ByVal nSize As UInteger, ByRef lpNumberOfBytesWritten As UInteger) As UInteger

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim i As Integer
        Dim procs As Process() = Process.GetProcesses() 'массив процессов

        For i = 0 To procs.Count - 1

            Dim MainWindowTitle As String = procs(i).MainWindowTitle 'MainWindowTitle

            If MainWindowTitle = "Perfect World" Then

                Dim Process_Id As UInteger = procs(i).MainWindowHandle
                Dim hProcess As UInteger = OpenProcess(&H1F0FF, 0, procs(i).Id) 'all access
                'ну а дальше читаем нужные значения

                Dim BA As UInteger

                ReadProcessMemory(hProcess, &HC9DFAC, BA, 4, 0) 'читаем базовый адрес
                Me.Text = BA
                Beep()
            End If

        Next
    End Sub

End Class

Для еще большего удобства можно сеять окна пв по имени персонажа, написать класс для читания памяти во всех ее вариациях(uInteger, String, Byte...)

Если этот код не будет у тебя работать то выход для тебя только 1н. Идти к другу/знакомому и качать образ у него .