Бывалый
Профиль
Группа: Участник
Сообщений: 234
Регистрация: 2.10.2010
Репутация: нет
Всего: нет
|
Это код диспетчера памяти.Но его нужно сделать на С++.Помогите народ переделать. Или может есть какая-нибудь утилитка чтобы конвертировать код. | Код |
unit Unit0;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApI, Grids, ExtCtrls, Math;
type
TFrmMain = class(TForm)
Button1: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
lbl4: TLabel;
lbl5: TLabel;
label123: TLabel;
lbl6: TLabel;
Label12: TLabel;
btnRefresh: TButton;
Label11: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
lbl7: TLabel;
lbl8: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
lbl9: TLabel;
lbl10: TLabel;
Label16: TLabel;
Label23: TLabel;
lbl11: TLabel;
sg0: TStringGrid;
GroupBox2: TGroupBox;
Label17: TLabel;
Label22: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
Label27: TLabel;
lbl_1: TLabel;
lbl_2: TLabel;
lbl_3: TLabel;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
btnReserv: TButton;
btnAlloc: TButton;
btnReturn: TButton;
btnFree: TButton;
btnExec: TButton;
GroupBox5: TGroupBox;
Button8: TButton;
Button6: TButton;
ledSize: TLabeledEdit;
ledAdr: TLabeledEdit;
dlgOpen: TOpenDialog;
ledWCount: TLabeledEdit;
ledESize: TLabeledEdit;
ledECount: TLabeledEdit;
GroupBox6: TGroupBox;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
lblR1: TLabel;
lblR2: TLabel;
lblR3: TLabel;
Label40: TLabel;
Label32: TLabel;
Label41: TLabel;
lblR4: TLabel;
lblR5: TLabel;
Label28: TLabel;
ledHAdr: TLabeledEdit;
Label36: TLabel;
Label37: TLabel;
lblr6: TLabel;
procedure Button1Click(Sender: TObject);
function Align(S: string): string;
// Function step(x,n:integer):integer;
function HexToInt64(hex: string): cardinal;
procedure SysInfo;
procedure FormCreate(Sender: TObject);
procedure sgClick(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure btnExecClick(Sender: TObject);
procedure btnReservClick(Sender: TObject);
procedure btnReturnClick(Sender: TObject);
procedure btnAllocClick(Sender: TObject);
procedure btnFreeClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
// procedure CreateArrayOfProcInfo();
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
mbi,_mbi: array of TMemoryBasicInformation;
fl : array of byte;
first: boolean = true;
si: TSystemInfo;
// a: array of set of byte;
implementation
{$R *.dfm}
procedure TFrmMain.FormCreate(Sender: TObject);
var i: byte;
begin
application.HintPause:=0;
sg0.Cells[1,0]:='Адрес';// sg.Cells[2,0]:='';
sg0.Cells[2,0]:='Имя модуля';
sg0.Cells[3,0]:='Размер';
sg0.Cells[4,0]:='Тип';
SetLength(mbi,2000);
SetLength(_mbi,2000);
SysInfo;
btnRefreshClick(Self);
end;
///////////////////////////////////////////////////////////////////
procedure TFrmMain.Button1Click(Sender: TObject);
begin
ShellAbout(0,'1234','5678',0);
end;
function TFrmMain.Align(S: string): string;
begin
result:=s;
while length(result)<>11 do
result:=' '+result;
end;
procedure TFrmMain.SysInfo;
//var
//si: TSystemInfo;
begin
GetSystemInfo(si);
lbl1.Caption:=IntToStr(si.dwPageSize);
lbl2.Caption:=IntToHex(Integer(si.lpMinimumApplicationAddress),8);
lbl3.Caption:=IntToHex(Integer(si.lpMaximumApplicationAddress),8);
lbl4.Caption:=IntToStr(si.dwAllocationGranularity);
lbl5.Caption:=IntToStr(si.dwPageSize);
// lbl6.Caption:='Model '+IntToStr(si.wProcessorRevision shr 8)+' Stepping '+IntToStr(si.wProcessorRevision and $00FF);
end;
procedure TFrmMain.sgClick(Sender: TObject);
var
gr: TGridRect;
begin
gr.Left:=100; gr.Top:=100; gr.Right:=100; gr.Bottom:=100;
// sg.Selection:=gr;
end;
procedure TFrmMain.btnRefreshClick(Sender: TObject);
var
ms : TMemoryStatus;
// mbi : TMemoryBasicInformation;
adr, PrevAdr: cardinal;
buf : array [0..255] of char;
FreeSize,ReservSize,CommitSize: Cardinal;
_type: string;
i,j : integer;//k, m
mbS: TMemoryBasicInformation;
l1,l2,l3,l4,l5,l6 : integer;
begin
ms.dwLength:=sizeof(TMemoryStatus);
GlobalMemoryStatus(ms);
lbl5.Caption:=IntTostr((ms.dwTotalPhys) div 1024)+' Кб';
lbl6.Caption:=IntTostr((ms.dwAvailPhys) div 1024)+' Кб';
lbl7.Caption:=IntTostr((ms.dwTotalPageFile) div 1024)+' Кб';
lbl8.Caption:=IntTostr((ms.dwAvailPageFile) div 1024)+' Кб';
lbl9.Caption:=IntTostr((ms.dwTotalVirtual) div 1024)+' Кб';//+IntTostr((ms.dwTotalVirtual) mod 1024);
lbl10.Caption:=IntTostr((ms.dwAvailVirtual) div 1024)+' Кб';
lbl11.Caption:=IntTostr(ms.dwMemoryLoad)+'%';
lblr1.Hint:=lblr1.Caption; lblr4.Hint:=lblr4.Caption;
lblr2.Hint:=lblr2.Caption; lblr5.Hint:=lblr5.Caption;
lblr3.Hint:=lblr3.Caption; lblr6.Hint:=lblr6.Caption;
l1:=0; l2:=0; l3:=0;
l4:=0; l5:=0; l6:=0;
{ lblr1.Caption:='0'; lblr4.Caption:='0';
lblr2.Caption:='0'; lblr5.Caption:='0';
lblr3.Caption:='0'; lblr6.Caption:='0';}
adr:=0; PrevAdr:=0;
{ for i:=1 to sg0.RowCount do
sg0.Cells[1,i]:='';}
sg0.RowCount:=2;
i:=0; j:=0;
while VirtualQuery(pointer(adr),mbi[i], sizeof(TMemoryBasicInformation))=sizeof(TMemoryBasicInformation) do begin
// mbi[i]:=mbs;
adr:=adr+mbi[i].RegionSize;
if mbi[i].State=MEM_RESERVE then begin
inc(ReservSize,mbi[i].RegionSize);
inc(l2);//lblr2.Caption:=IntToStr(StrToInt(lblr2.Caption)+1);
end
else
if mbi[i].State=MEM_COMMIT then begin
inc(CommitSize,mbi[i].RegionSize);
inc(l3);//lblr3.Caption:=IntToStr(StrToInt(lblr3.Caption)+1);
end
else
if (mbi[i].State=MEM_FREE) then begin
inc(FreeSize,mbi[i].RegionSize);
inc(l1);//lblr1.Caption:=IntToStr(StrToInt(lblr1.Caption)+1);
end;
if adr < Cardinal(si.lpMaximumApplicationAddress) then inc(l4)//;lblr4.Caption:=IntToStr(StrToInt(lblr4.Caption)+1)
else inc(l5);//lblr5.Caption:=IntToStr(StrToInt(lblr5.Caption)+1);
inc(i);
{ end
else begin
inc(FreeSize,mbi[i].RegionSize);
lblr1.Caption:=IntToStr(StrToInt(lblr1.Caption)+1);
if adr<Integer(si.lpMaximumApplicationAddress) then lblr4.Caption:=IntToStr(StrToInt(lblr4.Caption)+1)
else lblr5.Caption:=IntToStr(StrToInt(lblr5.Caption)+1);
end;}
end;
for j:=1 to i do begin
if mbi[j-1].State=MEM_RESERVE then _type:='Reserve'
else
if mbi[j-1].State=MEM_COMMIT then _type:='Commit'
else
if mbi[j-1].State=MEM_FREE then _type:='free';
sg0.RowCount:=sg0.RowCount+1;
sg0.Cells[0,j]:=IntToStr(j);
sg0.Cells[1,j]:=IntToHex(cardinal(mbi[j-1].BaseAddress),8);
sg0.Cells[3,j]:=IntToHex(mbi[j-1].RegionSize,8);//размер
sg0.Cells[4,j]:=_type;
GetModuleFileName(Cardinal(mbi[j-1].BaseAddress),buf,sizeof(buf));
if length(string(buf))>0 then
inc(l6);//lblr6.Caption:=IntToStr(StrToInt(lblr6.Caption)+1);
sg0.Cells[2,j]:=string(buf);
end;
// sg0.Cells[3,i]:=IntToHex(Adr-PrevAdr,8);//размер
// sg0.Cells[3,0]:='Размер';
///LARGEADDRESSAWARE
lblr1.Caption:=IntToStr(l1); lblr2.Caption:=IntToStr(l2);
lblr3.Caption:=IntToStr(l3); lblr4.Caption:=IntToStr(l4);
lblr5.Caption:=IntToStr(l5); lblr6.Caption:=IntToStr(l6);
sg0.Rows[i+1].Clear;
lbl_1.Hint:=lbl_1.Caption;
lbl_2.Hint:=lbl_2.Caption;
lbl_3.Hint:=lbl_3.Caption;
lbl_1.Caption:=IntToStr(FreeSize div 1024)+' Кб';
lbl_2.Caption:=IntToStr(ReservSize div 1024)+' Кб';
lbl_3.Caption:=IntToStr(CommitSize div 1024)+' Кб';
end;
procedure TFrmMain.btnExecClick(Sender: TObject);
Var
lpStartupInfo : TStartupInfo;
lpProcInfo: TprocessInformation;
begin
If dlgOpen.Execute then begin
FillChar(lpStartupInfo, Sizeof(lpStartupInfo),#0);
lpStartupInfo.cb :=sizeof (lpStartupInfo);
lpStartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
lpStartupInfo.wShowWindow:=SW_SHOWNORMAL;
if not CreateProcess (pchar(dlgOpen.FileName), nil, nil, nil, false,
NORMAL_PRIORITY_CLASS, nil, nil, lpStartupInfo, lpProcInfo)
then ShowMessage ('Ошибка '+inttostr(GetLastError))
else begin
// WaitForSingleObject (lpProcInfo.hProcess,100);
CloseHandle (lpProcInfo.hProcess);
end;
end;
end;
///////////////////////////////////////////////////////////////////
procedure TFrmMain.btnReservClick(Sender: TObject);
var
adr: cardinal;
// p:pointer;
begin
if ledSize.Text='' then begin showmessage('Введите размер'); exit end;
if ledAdr.Text='' then adr:=0
else adr:=HexToInt64(ledAdr.Text);
// lbl_3.Caption:=IntTostr(adr);
adr:=Cardinal(VirtualAlloc(Pointer(adr),StrToInt64(ledSize.Text)*1024,
MEM_RESERVE,PAGE_READONLY));
if adr=0 then ShowMessage('Невозможно зарезервировать память')
else ledAdr.Text:=IntToHex(adr,8);
end;
procedure TFrmMain.btnAllocClick(Sender: TObject);
var
adr: dword;
begin
if ledSize.Text='' then begin showmessage('Введите размер'); exit end;
if ledAdr.Text='' then adr:=0
else adr:=HexToInt64(ledAdr.Text);
adr:= cardinal(VirtualAlloc(Pointer(adr),StrToInt64(ledSize.Text)*1024,
MEM_COMMIT,PAGE_READONLY));
if adr=0 then ShowMessage('Невозможно спроецировать память')
else ledAdr.Text:=IntToHex(adr,8);
end;
procedure TFrmMain.btnReturnClick(Sender: TObject);
var
adr,size: dword;
begin
if ledSize.Text<>'' then size:=StrToInt64(ledSize.Text)*1024
else size:=0;
if ledAdr.Text='' then adr:=0
else adr:=HexToInt64(ledAdr.Text);
if VirtualFree(Pointer(adr),size,
MEM_RELEASE)=false then ShowMessage('Невозможно вернуть память');
end;
procedure TFrmMain.btnFreeClick(Sender: TObject);
var
adr,size: dword;
begin
if ledSize.Text<>'' then size:=StrToInt64(ledSize.Text)*1024
else size:=0;
if ledAdr.Text='' then adr:=0
else adr:=HexToInt64(ledAdr.Text);
if VirtualFree(Pointer(adr),size,//StrToInt64(ledSize.Text)*1024
MEM_DECOMMIT)=false then ShowMessage('Невозможно освободить память');
end;
///////////////////////////////////////////////////////////////////
function TFrmMAin.HexToInt64(hex: string): cardinal;
const
zmax=15;
znak:array[0..zmax]of char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var
i,j,l: integer;
res : cardinal;
Function step(x,n:Cardinal): Cardinal; {^}
var i,p: cardinal;
begin
if x=0 then p:=0
else begin
p:=1; for i:=1 to n do p:=p*x;
end;
step:=p;
end;
begin
// res:=step(10,2);
res:=0; l:=length(hex); //перевод из b в 10
for i:=l downto 1 do
for j:=0 to 15 do
if hex[i]=znak[j] then res:=res+(j*step(16,l-i));
HexToInt64:=res;
end;
///////////////////////////////////////////////////////////////////////////
procedure TFrmMain.Button6Click(Sender: TObject);
var
hh: THandle;
adr:cardinal;
begin
if ledWCount.Text='' then begin ShowMessage('Введите количество'); exit; end;
// if (ledECount.Text='')or(ledESize.Text='') then exit;
hh:=GetProcessHeap();
//HEAP_ZERO_MEMORY
adr:=cardinal(HeapAlloc(hh,8,StrToInt(ledWCount.Text)*2));
if adr=0 then ShowMessage('1')
else ledHAdr.Text:=IntToHex(adr,8);
end;
procedure TFrmMain.Button8Click(Sender: TObject);
var
hh: THAndle;
size: cardinal;
adr:cardinal;
begin
if (ledECount.Text='') then begin ShowMessage('Введите количество'); exit; end;
if (ledESize.Text='') then begin ShowMessage('Введите размер'); exit; end;
size:=StrToInt(ledECount.Text)*strtoint(ledESize.Text);
hh:=HeapCreate(0,size,0);
adr:=cardinal(HeapAlloc(hh,8,size));
if adr=0 then ShowMessage('1')
else ledHAdr.Text:=IntToHex(adr,8);
end;
{
В Windows 2000, запущенной с ключом /3GB приложению отдаётся в
распоряжение 3 Гб адресного пространства вместо двух - ядро
загружается с минимальным набором ресурсов и тем самым предоставляет
адресное пространство от 80000000 до BFFFFFFF любому приложению,
способному его использовать.
}
////////////////////////////////////////////////////////////
{procedure TFrmMain.CreateArrayOfProcInfo();
//найти все процессы
var
PE: TProcessEntry32;
n : word;
begin
n:=0;
SH:=CreateToolHelp32SnapShot(Th32cs_SnapAll, 0);
pe.dwSize:=sizeof(PE);//без этого она до определённого момента работала!?
Process32First(SH, PE);
repeat
SetLength(pNew,n+1);
pNew[n].pe:=PE;
pNew[n].new:=true;
inc(n);
until not Process32Next(SH, PE);
CloseHandle(SH);
end;
/////////////////////////////////////////////////////////////////////
}
end.
|
|
из Pascal на С++, помогите преобразовать код 
Загрузка ...
