Форум: "WinAPI";
Текущий архив: 2005.08.07;
Скачать: [xml.tar.bz2];
ВнизКакой функцией можно получить параметры памяти процесса Найти похожие ветки
← →
Андрей Жук © (2005-06-09 17:55) [0]Базовый адресс, тип области, размер области, количество блоков в зарезервированной области, аттрибуты защиты памяти?
ИШ - в вашей программе такого нет.
← →
Суслик © (2005-06-09 17:58) [1]
> ИШ - в вашей программе такого нет.
зато в рихтере (win для профи, 4е издание) есть
← →
Андрей Жук © (2005-06-09 18:01) [2]Имя, сестра, имя!
Т.е. ссылку. Или функцию. Пожалуйста.
← →
Суслик © (2005-06-09 18:04) [3]главы 14 и 15 указанной книги.
книгу в сети ищи, или ИШ жди :)
← →
Суслик © (2005-06-09 18:04) [4]главы 14 и 15 указанной книги.
книгу в сети ищи, или ИШ жди :)
← →
Андрей Жук © (2005-06-09 18:05) [5]Toolhelp32Read
ProcessMemory
← →
alpet © (2005-06-09 18:24) [6]Вот функции что тебе нужны для построения карты АП процесса:
VirtualQueryEx, GetModuleFileName, ToolHelp32::{ Module32First, Module32Next }
← →
Игорь Шевченко © (2005-06-10 12:45) [7]
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, NtProcessInfo;
type
TMemoryMap = array[0..1023] of Byte;
TMemory = class
private
FEndAddress: DWORD;
FStartAddress: DWORD;
FMap: TMemoryMap;
FEntrySize: DWORD;
function GetMap(I: Integer): Byte;
procedure PutMap(I: Integer; const Value: Byte);
public
constructor Create (AEntrySize: DWORD);
class function MapEntryColor (const MapEntry : Byte) : TColor;
procedure RegionToMap(RegionStart, RegionSize: DWORD;
MemType: Byte);
property MapArray : TMemoryMap read FMap;
property Map[I : Integer] : Byte read GetMap write PutMap;
property StartAddress : DWORD read FStartAddress write FStartAddress;
property EndAddress : DWORD read FEndAddress write FEndAddress;
property EntrySize : DWORD read FEntrySize;
end;
TfMain = class(TForm)
PaintBoxWhole: TPaintBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
gbLegend: TGroupBox;
ShapeUnknown: TShape;
Label5: TLabel;
ShapeFree: TShape;
Label6: TLabel;
ShapeMixed: TShape;
Label7: TLabel;
ShapeSystem: TShape;
Label8: TLabel;
ShapePrivate: TShape;
ShapeMapped: TShape;
ShapeImage: TShape;
Label9: TLabel;
ShapeReserved: TShape;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
lbSelectedRange: TLabel;
lbLowestSelected: TLabel;
lbMiddleSelectedLow: TLabel;
lbMiddleSelectedHigh: TLabel;
lbHighestSelected: TLabel;
PaintBoxSelected: TPaintBox;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
View1: TMenuItem;
Refresh1: TMenuItem;
cbProcesses: TComboBox;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
lbSelectedPage: TLabel;
Label17: TLabel;
lbContents: TLabel;
procedure FormCreate(Sender: TObject);
procedure PaintBoxWholePaint(Sender: TObject);
procedure PaintBoxWholeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBoxSelectedPaint(Sender: TObject);
procedure Refresh1Click(Sender: TObject);
procedure cbProcessesChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PaintBoxSelectedMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
FForceSelectedMapPaint : Boolean;
FCurrentProcess : THandle;
FProcessesInfo : THSNtProcessInfoList;
FWholeMemory : TMemory;
FSelectedMemory : TMemory;
procedure RefreshProcesses;
procedure RefreshCurrentProcessMap;
procedure GetWholeMap (Process: THandle);
procedure GetSelectedMap (Process: THandle;
StartAddress, EndAddress: DWORD);
procedure GetMemoryMap (Process: THandle; Map : TMemory);
procedure DrawWholeMap;
procedure DrawSelectedMap;
procedure DrawMap (const Map : TMemoryMap; PaintBox : TPaintBox);
procedure DrawLegend;
procedure SelectWholeMapEntry (EntryIndex : Integer);
function GetModuleFileNameForAddress (Address: DWORD): string;
end;
var
fMain: TfMain;
implementation
uses
NtDll, HsNtDef, NtUtils, PsAPI
;
{$R *.dfm}
const
MaxUserAddress = $7FFF0000;
MemUnknown = 0;
MemFree = 1;
MemMixed = 2;
MemSystem = 3;
MemPrivate = 4;
MemMapped = 5;
MemImage = 6;
MemReserve = 7;
{ TfMain }
{
Каждый элемент Map описывает регион виртуального адресного пространства
процесса размером в 4 мегабайта (4096Кб=0x400000 байт).
}
procedure TfMain.GetWholeMap(Process: THandle);
var
I : Integer;
begin
for I:=0 to 511 do
FWholeMemory.Map[I] := MemUnknown;
for I:=512 to 1023 do
FWholeMemory.Map[I] := MemSystem;
GetMemoryMap(Process, FWholeMemory);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
FWholeMemory := TMemory.Create(4096*1024);
FSelectedMemory := TMemory.Create(4096);
RefreshProcesses;
FCurrentProcess := GetCurrentProcess;
DrawLegend;
RefreshCurrentProcessMap;
end;
procedure TfMain.DrawWholeMap;
begin
PaintBoxWhole.Invalidate;
end;
procedure TfMain.PaintBoxWholePaint(Sender: TObject);
begin
DrawMap(FWholeMemory.MapArray, Sender as TPaintBox);
end;
procedure TfMain.DrawMap(const Map: TMemoryMap; PaintBox: TPaintBox);
var
Column : Integer;
GridHeight: Integer;
GridWidth : Integer;
Row : Integer;
I : Integer;
BrushNew, BrushOld : HBRUSH;
begin
GridHeight := PaintBox.Height div 32;
GridWidth := PaintBox.Width div 32;
for I := 0 to 1023 do begin
Row := I div 32;
Column := I mod 32;
BrushNew := CreateSolidBrush(TMemory.MapEntryColor(Map[I]));
BrushOld := SelectObject(PaintBox.Canvas.Handle, BrushNew);
Rectangle(PaintBox.Canvas.Handle, GridWidth*Column, GridHeight*Row,
GridWidth*(Column+1), GridHeight*(Row+1));
SelectObject(PaintBox.Canvas.Handle, BrushOld);
DeleteObject(BrushNew);
end;
end;
procedure TfMain.DrawLegend;
begin
ShapeUnknown.Brush.Color := TMemory.MapEntryColor(MemUnknown);
ShapeFree.Brush.Color := TMemory.MapEntryColor(MemFree);
ShapeMixed.Brush.Color := TMemory.MapEntryColor(MemMixed);
ShapeSystem.Brush.Color := TMemory.MapEntryColor(MemSystem);
ShapePrivate.Brush.Color := TMemory.MapEntryColor(MemPrivate);
ShapeMapped.Brush.Color := TMemory.MapEntryColor(MemMapped);
ShapeImage.Brush.Color := TMemory.MapEntryColor(MemImage);
ShapeReserved.Brush.Color := TMemory.MapEntryColor(MemReserve);
end;
procedure TfMain.PaintBoxWholeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
EntryIndex, EntryX, EntryY : Integer;
GridHeight: Integer;
GridWidth : Integer;
PaintBox : TPaintBox;
begin
PaintBox := Sender as TPaintBox;
if Button = mbLeft then begin
GridHeight := PaintBox.Height div 32;
GridWidth := PaintBox.Width div 32;
EntryX := (X div GridWidth);
EntryY := (Y div GridHeight);
EntryIndex := EntryY * 32 + EntryX;
SelectWholeMapEntry(EntryIndex);
end;
end;
procedure TfMain.PaintBoxSelectedPaint(Sender: TObject);
begin
if not FForceSelectedMapPaint then
Exit;
DrawMap(FSelectedMemory.MapArray, Sender as TPaintBox);
end;
procedure TfMain.DrawSelectedMap;
begin
FForceSelectedMapPaint := true;
PaintBoxSelected.Invalidate;
end;
← →
Игорь Шевченко © (2005-06-10 12:46) [8]
{
Каждый элемент Map описывает регион виртуального адресного пространства
процесса размером в 4 килобайта=0x1000 байт).
}
procedure TfMain.GetSelectedMap(Process: THandle; StartAddress,
EndAddress: DWORD);
var
I : Integer;
begin
for I:=0 to 1023 do
FSelectedMemory.Map[I] := MemUnknown;
FSelectedMemory.StartAddress := StartAddress;
FSelectedMemory.EndAddress := EndAddress;
GetMemoryMap(Process, FSelectedMemory);
end;
procedure TfMain.Refresh1Click(Sender: TObject);
begin
RefreshCurrentProcessMap;
end;
procedure TfMain.RefreshCurrentProcessMap;
begin
GetWholeMap(FCurrentProcess);
DrawWholeMap;
SelectWholeMapEntry(0);
end;
procedure TfMain.RefreshProcesses;
var
Processes : Pointer;
rc : NTSTATUS;
Dummy : ULONG;
I : Integer;
begin
cbProcesses.Items.Clear;
FProcessesInfo.Free;
Processes := QueryListInformation(SystemProcessesAndThreadsInformation, rc,
Dummy);
if NT_SUCCESS(rc) then begin
FProcessesInfo := THSNtProcessInfoList.Create(Processes);
for I:=0 to Pred(FProcessesInfo.Count) do
if FProcessesInfo[I].Info.ProcessId <> 0 then begin
cbProcesses.Items.AddObject(FProcessesInfo[I].ProcessName,
FProcessesInfo[I]);
end;
end;
end;
procedure TfMain.cbProcessesChange(Sender: TObject);
begin
if FCurrentProcess <> GetCurrentProcess then
CloseHandle(FCurrentProcess);
if (cbProcesses.ItemIndex = -1) or
(THSNtProcessInfo(cbProcesses.Items.Objects[
cbProcesses.ItemIndex]).Info.ProcessId = GetCurrentProcessId) then
FCurrentProcess := GetCurrentProcess
else begin
FCurrentProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
false,
THSNtProcessInfo(cbProcesses.Items.Objects[
cbProcesses.ItemIndex]).Info.ProcessId);
if FCurrentProcess = 0 then begin
FCurrentProcess := GetCurrentProcess;
raise Exception.Create(SysErrorMessage(GetLastError));
end;
end;
RefreshCurrentProcessMap;
end;
procedure TfMain.SelectWholeMapEntry(EntryIndex: Integer);
var
StartAddress, EndAddress : DWORD;
I : Integer;
begin
StartAddress := DWORD(EntryIndex)*FWholeMemory.EntrySize;
EndAddress := DWORD((EntryIndex+1))*FWholeMemory.EntrySize-1;
lbSelectedRange.Caption := Format("Selected range: 0x%.8x-0x%.8x",
[StartAddress, EndAddress]);
if EntryIndex > 511 then begin
for I:=0 to 1023 do
FSelectedMemory.Map[I] := MemSystem;
FSelectedMemory.StartAddress := StartAddress;
FSelectedMemory.EndAddress := EndAddress;
end else
GetSelectedMap(FCurrentProcess, StartAddress, EndAddress);
lbLowestSelected.Caption := Format("0x%.8x", [StartAddress]);
lbMiddleSelectedLow.Caption := Format("0x%.8x", [StartAddress +
DWORD(FWholeMemory.EntrySize div 2 - 1)]);
lbMiddleSelectedHigh.Caption := Format("0x%.8x", [StartAddress +
DWORD(FWholeMemory.EntrySize div 2)]);
lbHighestSelected.Caption := Format("0x%.8x", [EndAddress]);
lbContents.Caption := "Unknown";
lbSelectedPage.Caption := "Nothing selected";
DrawSelectedMap;
end;
{ TMemory }
constructor TMemory.Create (AEntrySize: DWORD);
begin
FStartAddress := 0;
FEndAddress := MaxUserAddress;
FEntrySize := AEntrySize;
end;
function TMemory.GetMap(I: Integer): Byte;
begin
Result := FMap[I];
end;
class function TMemory.MapEntryColor(const MapEntry: Byte): TColor;
begin
Result := RGB(192,192,192);
case MapEntry of
MemFree:
Result := RGB(255, 255, 255);
MemMixed:
Result := RGB(255, 128, 128);
MemSystem:
Result := RGB(0, 0, 255);
MemImage:
Result := RGB(0, 255, 0);
MemMapped:
Result := RGB(255, 255, 0);
MemPrivate:
Result := RGB(255, 0, 0);
MemReserve:
Result := RGB(255, 128, 255);
end;
end;
procedure TMemory.PutMap(I: Integer; const Value: Byte);
begin
FMap[I] := Value;
end;
procedure TMemory.RegionToMap(RegionStart, RegionSize: DWORD;
MemType: Byte);
var
I : Integer;
StartEntryIndex, EndEntryIndex : Integer;
begin
StartEntryIndex := RegionStart div FEntrySize;
EndEntryIndex := (RegionStart + RegionSize - 1) div FEntrySize;
for I:=StartEntryIndex to EndEntryIndex do
if (FMap[I] <> MemUnknown) and (FMap[I] <> MemType) then
FMap[I] := MemMixed
else
FMap[I] := MemType;
end;
procedure TfMain.FormDestroy(Sender: TObject);
begin
FWholeMemory.Free;
FSelectedMemory.Free;
end;
procedure TfMain.GetMemoryMap(Process: THandle; Map: TMemory);
var
mbi : TMemoryBasicInformation;
Address : ULONG;
rc : Integer;
MemType : Byte;
MapAddress,MapSize : DWORD;
begin
Address := Map.StartAddress;
while (Address < Map.EndAddress) and (Address < MaxUserAddress) do begin
rc := VirtualQueryEx(Process, Pointer(Address), mbi, SizeOf(mbi));
if rc <> SizeOf(mbi) then
raise Exception.Create(SysErrorMessage(GetLastError));
MemType := MemUnknown;
case mbi.State of
MEM_FREE:
MemType := MemFree;
MEM_RESERVE:
MemType := MemReserve;
MEM_COMMIT:
case mbi.Type_9 of
MEM_IMAGE:
MemType := MemImage;
MEM_MAPPED:
MemType := MemMapped;
MEM_PRIVATE:
MemType := MemPrivate;
end;
end;
MapAddress := DWORD(mbi.BaseAddress);
MapSize := mbi.RegionSize;
if MapAddress < Address then begin
MapAddress := Address;
Dec(MapSize, Address - DWORD(mbi.BaseAddress));
end;
if MapAddress + MapSize > Map.EndAddress then
MapSize := Map.EndAddress - MapAddress + 1;
Map.RegionToMap(MapAddress - Map.StartAddress, MapSize, MemType);
if mbi.RegionSize = 0 then
mbi.RegionSize := 4096; { Чтобы не зацикливаться }
Address := DWORD(mbi.BaseAddress) + mbi.RegionSize;
end;
end;
procedure TfMain.PaintBoxSelectedMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
EntryIndex, EntryX, EntryY : Integer;
GridHeight: Integer;
GridWidth : Integer;
PaintBox : TPaintBox;
Address: DWORD;
begin
PaintBox := Sender as TPaintBox;
if Button = mbLeft then begin
GridHeight := PaintBox.Height div 32;
GridWidth := PaintBox.Width div 32;
EntryX := (X div GridWidth);
EntryY := (Y div GridHeight);
EntryIndex := EntryY * 32 + EntryX;
Address := DWORD(DWORD(EntryIndex) * FSelectedMemory.EntrySize) +
FSelectedMemory.StartAddress;
lbSelectedPage.Caption := Format("%.8x", [Address]);
if FSelectedMemory.Map[EntryIndex] = MemImage then
lbContents.Caption := GetModuleFileNameForAddress(Address)
else
lbContents.Caption := "Unknown";
end;
end;
← →
Игорь Шевченко © (2005-06-10 12:46) [9]
function TfMain.GetModuleFileNameForAddress(Address: DWORD): string;
var
ModuleName: array[0..1024] of char;
rc: DWORD;
mbi : TMemoryBasicInformation;
begin
rc := VirtualQueryEx(FCurrentProcess, Pointer(Address), mbi, SizeOf(mbi));
if rc <> SizeOf(mbi) then
raise Exception.Create(SysErrorMessage(GetLastError));
if FCurrentProcess = GetCurrentProcess then
rc := GetModuleFileName(THandle(mbi.AllocationBase), ModuleName,
SizeOf(ModuleName))
else
rc := GetModuleFileNameEx(FCurrentProcess, THandle(mbi.AllocationBase),
ModuleName, SizeOf(ModuleName));
if rc > 0 then
Result := ModuleName
else
Result := SysErrorMessage(GetLastError);
end;
end.
← →
Игорь Шевченко © (2005-06-10 12:47) [10]
object fMain: TfMain
Left = 113
Top = 94
Width = 678
Height = 477
Caption = "Virtual Query (Process virtual address space map)"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object PaintBoxWhole: TPaintBox
Left = 72
Top = 64
Width = 256
Height = 256
OnMouseDown = PaintBoxWholeMouseDown
OnPaint = PaintBoxWholePaint
end
object Label1: TLabel
Left = 8
Top = 64
Width = 59
Height = 13
Caption = "0x00000000"
end
object Label2: TLabel
Left = 8
Top = 308
Width = 59
Height = 13
Caption = "0xFFFFFFFF"
end
object Label3: TLabel
Left = 8
Top = 192
Width = 59
Height = 13
Caption = "0x80000000"
end
object Label4: TLabel
Left = 8
Top = 176
Width = 59
Height = 13
Caption = "0x7FFFFFFF"
end
object lbSelectedRange: TLabel
Left = 400
Top = 46
Width = 199
Height = 13
Caption = "Selected range: 0x00000000-0x00000000"
end
object lbLowestSelected: TLabel
Left = 336
Top = 64
Width = 59
Height = 13
Caption = "0x00000000"
end
object lbMiddleSelectedLow: TLabel
Left = 336
Top = 176
Width = 59
Height = 13
Caption = "0x7FFFFFFF"
end
object lbMiddleSelectedHigh: TLabel
Left = 336
Top = 192
Width = 59
Height = 13
Caption = "0x80000000"
end
object lbHighestSelected: TLabel
Left = 336
Top = 308
Width = 59
Height = 13
Caption = "0xFFFFFFFF"
end
object PaintBoxSelected: TPaintBox
Left = 400
Top = 64
Width = 256
Height = 256
OnMouseDown = PaintBoxSelectedMouseDown
OnPaint = PaintBoxSelectedPaint
end
object Label13: TLabel
Left = 8
Top = 8
Width = 38
Height = 13
Caption = "&Process"
FocusControl = cbProcesses
end
object Label14: TLabel
Left = 400
Top = 32
Width = 251
Height = 13
Caption = "Selected range details (each grid cell represents 4Kb)"
end
object Label15: TLabel
Left = 72
Top = 32
Width = 253
Height = 29
AutoSize = False
Caption =
"Whole process map (each grid cell represents 4Mb) Click on cell " +
"to see details"
WordWrap = True
end
object Label16: TLabel
Left = 400
Top = 328
Width = 112
Height = 13
Caption = "Selected page address:"
end
object lbSelectedPage: TLabel
Left = 520
Top = 328
Width = 80
Height = 13
Caption = "Nothing selected"
end
object Label17: TLabel
Left = 400
Top = 344
Width = 45
Height = 13
Caption = "Contents:"
end
object lbContents: TLabel
Left = 448
Top = 344
Width = 217
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = "Unknown"
end
object gbLegend: TGroupBox
Left = 4
Top = 351
Width = 345
Height = 65
Anchors = [akLeft, akBottom]
Caption = "Memory type legend"
TabOrder = 0
object ShapeUnknown: TShape
Left = 8
Top = 16
Width = 21
Height = 17
end
object Label5: TLabel
Left = 36
Top = 16
Width = 46
Height = 13
Caption = "Unknown"
end
object ShapeFree: TShape
Left = 8
Top = 36
Width = 21
Height = 17
end
object Label6: TLabel
Left = 36
Top = 36
Width = 21
Height = 13
Caption = "Free"
end
object ShapeMixed: TShape
Left = 96
Top = 16
Width = 21
Height = 17
end
object Label7: TLabel
Left = 124
Top = 16
Width = 28
Height = 13
Caption = "Mixed"
end
object ShapeSystem: TShape
Left = 96
Top = 36
Width = 21
Height = 17
end
object Label8: TLabel
Left = 124
Top = 36
Width = 34
Height = 13
Caption = "System"
end
object ShapePrivate: TShape
Left = 172
Top = 16
Width = 21
Height = 17
end
object ShapeMapped: TShape
Left = 172
Top = 36
Width = 21
Height = 17
end
object ShapeImage: TShape
Left = 260
Top = 16
Width = 21
Height = 17
end
object Label9: TLabel
Left = 288
Top = 16
Width = 29
Height = 13
Caption = "Image"
end
object ShapeReserved: TShape
Left = 260
Top = 36
Width = 21
Height = 17
end
object Label10: TLabel
Left = 288
Top = 36
Width = 40
Height = 13
Caption = "Reserve"
end
object Label11: TLabel
Left = 200
Top = 16
Width = 33
Height = 13
Caption = "Private"
end
object Label12: TLabel
Left = 200
Top = 36
Width = 39
Height = 13
Caption = "Mapped"
end
end
object cbProcesses: TComboBox
Left = 72
Top = 4
Width = 145
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 1
OnChange = cbProcessesChange
end
object MainMenu1: TMainMenu
Left = 296
Top = 56
object File1: TMenuItem
Caption = "&File"
object Exit1: TMenuItem
Caption = "E&xit"
end
end
object View1: TMenuItem
Caption = "&View"
object Refresh1: TMenuItem
Caption = "&Refresh"
ShortCut = 116
OnClick = Refresh1Click
end
end
end
end
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2005.08.07;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.033 c