[ined]

Вот над чем сей час я работаю, просто так для себя.

Код:

unit MWrite;

interface

uses
windows;

type


TMWrite = class
  private
   Pb:PByte;
   Adres    : pointer ;
   EndAdres : pointer ;
   Index    : pointer ;
   MSize    : cardinal;
  public
   constructor Create(Size:cardinal=1); overload;
   procedure Free;
   procedure NullMem;
   procedure BlockWrite(P:pointer;Size:cardinal);
   procedure TransitionIndex(Position:cardinal=0); overload;
   procedure ChangeLengthMemory(NewSize:cardinal);
   function OutMem:pointer;
   Function SaveToFile(NameFile:string):boolean;
   Function SaveToFileAnIndex(NameFile:string):boolean;
   destructor Destroy;
end;



implementation

var BoolMem: boolean = false;

{$region 'CopiPtoPP'}
procedure CopiPtoPP(Source:pointer; Receiver:pointer; Size:cardinal);
begin
  asm
    pushad
    mov esi,Source
    mov edi,Receiver
    mov ecx,Size
    cld
rep movsb
    popad
  end;
end;
{$endregion}

{$region 'Pinc'}
procedure incP(var P:pointer; d:cardinal=1); overload;
begin
  asm
   pushad
   mov eax,p
   add eax,d
   mov p,eax
   popad
  end;
end;
{$endregion}

procedure MemNull(p:pointer;Size:cardinal);
begin
  asm
    pushad
    mov eax,0
    mov edi,p
    mov ecx,Size
    cld
rep movsb
    popad
  end;

end;

{ TMWrite }

procedure TMWrite.BlockWrite(P: pointer; Size: cardinal);
begin
 if ((cardinal(Index)+ Size) > cardinal(EndAdres)) then ChangeLengthMemory(MSize+Size-cardinal(EndAdres)-cardinal(Index));

 CopiPtoPP(P,Index,Size);
 incP(Index,Size);
 if (cardinal(Index) > cardinal(EndAdres)) then MessageBox(0,'Выход за пределы распределённой памяти'+#10+#13+#10+#13+
                                       'Exit out of limits of the distributed memory','Warning',MB_OK or MB_ICONERROR);

end;

procedure TMWrite.ChangeLengthMemory(NewSize: cardinal);
var p:pointer; TPos:cardinal;
begin
  if NewSize = 0 then begin MessageBox(0,'Длина не может быть - ''0'''+#10+#13+#10+#13+
                                   'The length can''t be - ''0''','Warning',MB_OK or MB_ICONERROR);
                            exit;
                      end;
  GetMem(p,NewSize);
  if NewSize > MSize then
          begin
            CopiPtoPP(Adres,p,MSize);
            TPos:=cardinal(Index)-cardinal(Adres);
            Index:=pointer(cardinal(p)+TPos);
            FreeMem(Adres,MSize);
            Adres:=p;
            MSize:=NewSize;

          end else
               begin
                 CopiPtoPP(Adres,p,NewSize);
                 FreeMem(Adres,MSize);
                 Adres:=p;
                 Index:=p;
                 MSize:=NewSize;
               end;
   EndAdres:=pointer(cardinal(Adres)+MSize-1)

end;

constructor TMWrite.Create(Size: cardinal);
begin
 inherited create;
 if Size = 0 then
      begin
         MessageBox(0,'Длинна не может быть - ''0'''+#10+#13+#10+#13+
                      'Be long can''t - ''0''','Warning',MB_OK or MB_ICONERROR);
         exit;
      end;
  if Assigned(Adres) then free;
  BoolMem:=true;
  GetMem(Adres,Size);
  MemNull(Adres,Size);
  Index:=Adres;
  MSize:=Size;
  EndAdres:=pointer(cardinal(Adres)+Size-1);
end;

destructor TMWrite.Destroy;
begin
Free;
 inherited Destroy;
end;

procedure TMWrite.Free;
begin
if not Assigned(Adres) then exit;
FreeMem(Adres,MSize);
Adres:=nil;
Index:=nil;
EndAdres:=nil;
MSize:=0;
BoolMem:=False;
end;

procedure TMWrite.NullMem;
begin
 MemNull(Adres,MSize);
 Index:=Adres;
end;

function TMWrite.OutMem: pointer;
begin
result:=Adres;
end;

function TMWrite.SaveToFile(NameFile: string): boolean;
var F:file;
begin
 AssignFile(f,NameFile);
 Rewrite(f,1);
 system.BlockWrite(f,Adres^,MSize);
 CloseFile(f);
 ///
end;

function TMWrite.SaveToFileAnIndex(NameFile: string): boolean;
var F:file;
begin
AssignFile(f,NameFile);
 Rewrite(f,1);
 system.BlockWrite(f,Adres^,cardinal(Index)-cardinal(Adres));
 CloseFile(f);
end;

procedure TMWrite.TransitionIndex(Position: cardinal);
begin
 if Position >= MSize then
      begin
         MessageBox(0,'Выход за пределы распределённой памяти'+#10+#13+#10+#13+
                      'Exit out of limits of the distributed memory','Warning',MB_OK or MB_ICONERROR);
         exit;
      end;
 Index:=pointer(cardinal(Adres)+Position);
end;

end.

Он ещё не доведён до ума, так сказать, черновик.