Дамп памяти чужого процесса

[veniside]

> а затем SizeOf возвращает размер этого массива в памяти.

это делает Length(), а SizeOf возвращает размер переменной (в данном случае указателя = 4 байта).
Точнее, размер массива в памяти = Length(A) * SizeOf(A[0]);

[Человек_Борща]

Так что-то я совсем затупил..
Мой код:

procedure TForm1.Button1Click(Sender: TObject);
var
  hProcess: Cardinal;
  MBI: TMemoryBasicInformation;
  FS: TFileStream;
  Buff: PByte; //Приёмник
  BaseAddr,
  RecivedBytes: Cardinal;
begin
  Memo1.lines.Clear;
  //Открываю процесс
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_READ, False, GetCurrentProcessId);
  try
    //Читаю с 0 адреса
   BaseAddr:=0;
   RecivedBytes:=0;
   //Если процесс открыт
    if hProcess <> 0 then
    begin
      //Создаём класс записи нашего дампа
      fs := TFileStream.Create(ExtractFilePath(ParamStr(0)) + 'SelfDump.pmd', fmCreate or fmOpenWrite);
      try
        //Читаем страницы памяти
        while VirtualQueryEx(hProcess, @(BaseAddr), MBI, SizeOf(MBI)) <> 0 do
        begin
          //Если страница доступна
          if (MBI.State = MEM_COMMIT) then
          begin
            try
              //выделяем память для буфера равный размеру региона
              GetMem(Buff, MBI.RegionSize);
              //Читаем
              if ReadProcessMemory(hProcess, @MBI.BaseAddress, @Buff, MBI.RegionSize, RecivedBytes) then
              begin
                //Записываем буфера размером прочитанных байт
                FS.Write(Buff, RecivedBytes);
              end
              else
              begin
                Memo1.Lines.Add(Format('[%d] ReadProcMem: %s ', [GetLastError, SysErrorMessage(GetLastError)]));
                Exit;
              end;
            finally
              FreeMem(Buff);
            end;
          end;
          //Увеличиваем базовый адрес на размер региона
          BaseAddr:=BaseAddr+MBI.RegionSize;
        end;
      finally
        FreeAndNil(fs);
      end;
    end
    else
    begin
      Memo1.Lines.Add(Format('[%d] hProcess: %s ', [GetLastError, SysErrorMessage(GetLastError)]));
      Exit;
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

Возвращяет ошибку:
[998] ReadProcMem: Неверная попытка доступа к адресу памяти

Ткните носом, что не так?

[GunSmoker]

Buff - уже и так указатель.

@Buff - указатель на указатель.

У тебя эта же ошибка ещё в первом варианте была.

[Человек_Борща]

ага, переделал:

              if ReadProcessMemory(hProcess, @MBI.BaseAddress, Pointer(Buff), MBI.RegionSize, RecivedBytes) then
              begin

зафигачило файлик на 1 гб. В чем проблема?

[GunSmoker]

А в чём проблема?

[Человек_Борща]

Ну как это в чем?
"дамп памяти процесса" для меня значит, сброс данных на диск, которые занял процесс в ОЗУ.

аже с таким кодом:

procedure TForm1.Button1Click(Sender: TObject);
const
  GB4 = 1073741824; //азмер в байтах
var
  hProcess: Cardinal;
  MBI: TMemoryBasicInformation;
  FS: TFileStream;
  Buff: PByte; //Приёмник
  BaseAddr,
  RecivedBytes: Cardinal;
begin
  Memo1.lines.Clear;
  //Открываю процесс
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_READ, False, GetCurrentProcessId);
  try
    //Читаю с 0 адреса
   BaseAddr:=0;
   RecivedBytes:=0;
   //Если процесс открыт
    if hProcess <> 0 then
    begin
      //Создаём класс записи нашего дампа
      fs := TFileStream.Create(ExtractFilePath(ParamStr(0)) + 'SelfDump.pmd', fmCreate or fmOpenWrite);
      try
        //Читаем страницы памяти
        while VirtualQueryEx(hProcess, @(BaseAddr), MBI, SizeOf(MBI)) <> 0 do
        begin
          //Если страница достукпна и не защищена
          if (MBI.State = MEM_COMMIT) then
          begin
            try
              //выделяем память для буфера равный размеру региона
              GetMem(Buff, MBI.RegionSize);
              //Читаем
              if ReadProcessMemory(hProcess, @MBI.BaseAddress, Pointer(Buff), MBI.RegionSize, RecivedBytes) then
              begin
                //Записываем буфера размером прочитанных байт
                FS.Write(Buff, RecivedBytes);
              end
              else
              begin
                Memo1.Lines.Add(Format('[%d] ReadProcMem: %s ', [GetLastError, SysErrorMessage(GetLastError)]));
                Exit;
              end;
            finally
              FreeMem(Buff);
            end;
          end;
          //Увеличиваем базовый адрес на размер региона
          BaseAddr:=BaseAddr+MBI.RegionSize;
          If BaseAddr = GB4 then
          begin
            Exit;
          end;
        end;
      finally
        FreeAndNil(fs);
      end;
    end
    else
    begin
      Memo1.Lines.Add(Format('[%d] hProcess: %s ', [GetLastError, SysErrorMessage(GetLastError)]));
      Exit;
    end;
  finally
    CloseHandle(hProcess);
  end;
end;

создаётся файл размером 1 гб.

процсс врятли занимает 1 гб ОЗУ, и я не думаю что это правда.
т.к. получается что алгоритм делает дамп всей занятой ОЗУ. А нужно делать дамп только той ОЗУ которая занята нужным мне процессом.

[Crystallon]

А у меня создал файлик в 10гб, и он еще столько же 100500 раз походу создал бы еслиб я процесс не завершил :D

[Crystallon]

Я в тупике...
Пытаюсь найти в памяти процесса нужный мне флаг('http'), поиск идет(кстати крайне медленно...) некоторое время и потом обрывается с ошибкой, причем каждый раз адрес где обрывается поиск совершенно разный.

function SearchFlag(prc: string) : integer;
var
  hProcess, hVirtualQuerty,temp: Cardinal;
  hOpen: THandle;
  SysInfo: _SYSTEM_INFO;
  MemBInfo: _MEMORY_BASIC_INFORMATION;
  RecvBuff: array of Byte;
  RecvBuffResult: DWORD;
  RecvBuff2: array of Byte;
  FS: TFileStream;
  none:Cardinal;
  Data1: DWORD;
  bAddres1:DWORD;
  bAddresP1: Pointer;
  wBuff: byte;
begin
  GetSystemInfo(SysInfo);
  try
    hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, myPID);
    if hProcess <> 0 then
    begin
      hVirtualQuerty := VirtualQueryEx(hProcess, @SysInfo, MemBInfo, SizeOf(MemBInfo));
      if hVirtualQuerty <> 0 then
      begin
      SetLength(RecvBuff,SysInfo.dwPageSize);
      bAddres1:=DWORD(@MemBInfo.BaseAddress^);
      bAddresP1:=@bAddres1;
      StringToBytes(StringToHex(Form1.Edit1.Text));
      str_log:=str_log+'HEX: '+StringToHex(Form1.Edit1.Text)+#13#10;


      while (RecvBuff[1]<>a[1]) or (RecvBuff[2]<>a[2]) or (RecvBuff[3]<>a[3]) or (RecvBuff[4]<>a[4]) do begin
        if ReadProcessMemory(hProcess, bAddresP1, @RecvBuff, SizeOf(RecvBuff),none) then
        begin
          bAddres1:=bAddres1+1;
        end
        else
        begin
          ShowMessage('ERR#' + IntToStr(GetLastError)+' Message:'+SysErrorMessage(GetLastError));
          ShowMessage(IntToStr(bAddres1));
          Exit;
        end;
      end;
          ShowMessage('1');
          ShowMessage(IntToStr(bAddres1));
          fs := TFileStream.Create(ExtractFilePath(ParamStr(0)) + 'SelfDump'+IntToStr(p1)+'.dmp', fmCreate or fmOpenReadWrite);
            try
            FS.WriteBuffer(RecvBuff,SizeOf(RecvBuff));
            finally
              FreeAndNil(fs);
            end;
      end
      else
      begin
        ShowMessage('#' + IntToStr(GetLastError)+' Message:'+SysErrorMessage(GetLastError));
        Exit;
      end;
    end
    else
    begin
      ShowMessage('#' + IntToStr(GetLastError)+' Message:'+SysErrorMessage(GetLastError));
      Exit;
    end;

  finally
    CloseHandle(hProcess);
  end;
end;

Вот еще функции которыми перевожу текст в string hex а дальше в byte(на всякий случай, может нужны):

function StringToHex(Data: string): string;
var 
  i, i2: Integer;
  s: string;
begin
  i2 := 1;
  for i := 1 to Length(Data) do
  begin
    Inc(i2);
    if i2 = 2 then
    begin
      i2 := 1;
    end;
    s := s + IntToHex(Ord(Data[i]), 2);
  end;
  Result := s;
end;

function StringToBytes(StrTmp:string): integer;
var
  i,j: Integer;
begin
  SetLength(a, Length(StrTmp) div 2);
  j := 1;
  for i := 0 to High(a) do begin
    a[i] := StrToInt( '$' + Copy(StrTmp, j, 2) );
    j := j + 2;
  end;
end;

P.S. Прошу прощения за "творческий хаос" в коде :D

[mss]

я правильно трактую ваш текст в код?

Неправильно.

Не совсем понял эту часть:
Цитата:
Инкрементируешь

Ты первый раз слышишь про термин "инкремент" ?
Прискорбно.

[mss]

Я в тупике

А вот не надо бездумно драть чей-то бездумный код.
Голова на плечах для чего растет ?)