lvksafemem.pas

单独打包出来

  protected
    function Clone(const CopyContents: Boolean): ISafeMem; override;
    function GetPointer: Pointer; override;

  public
    constructor Create(const Amount: Integer);
    destructor Destroy; override;
  end;

  TDisposable = class(TInterfacedObject, IDisposable)
  private
    FData             : Pointer;
    FDisposeProcedure : TDisposeProcedure;
    FDisposeMethod    : TDisposeMethod;

  protected
    // IDisposable interface
    procedure Forget;
    procedure Dispose;

  public
    constructor Create(const Data: Pointer;
      const DisposeProcedure: TDisposeProcedure;
      const DisposeMethod: TDisposeMethod);
    destructor Destroy; override;
  end;

function AllocateSafeMem(const Amount: Integer;
  const UseTempFile: Boolean): ISafeMem;
begin
  if UseTempFile then
    Result := TTempFileSafeMem.Create(Amount)
  else
    Result := TSafeMem.Create(Amount);
end;

function NewDisposable(const Data: Pointer;
  const Dispose: TDisposeProcedure): IDisposable; overload;
begin
  Result := TDisposable.Create(Data, Dispose, nil);
end;

function NewDisposable(const Data: Pointer;
  const Dispose: TDisposeMethod): IDisposable; overload;
begin
  Result := TDisposable.Create(Data, nil, Dispose);
end;

{ TBaseSafeMem }

function TBaseSafeMem.Clone(const CopyContents: Boolean): ISafeMem;
begin
  Result := nil;
end;

constructor TBaseSafeMem.Create(const Stream: TStream);
begin
  inherited Create;

  Assert(Assigned(Stream));

  FStream := Stream;
end;

destructor TBaseSafeMem.Destroy;
begin
  FreeAndNil(FStream);

  inherited;
end;

procedure TBaseSafeMem.Fill(const b: Byte);
begin
  if GetSize > 0 then
    FillChar(GetPointer^, GetSize, b);
end;

function TBaseSafeMem.GetAsString: string;
begin
  SetLength(Result, GetSize);
  if GetSize > 0 then
    Move(GetPointer^, Result[1], GetSize);
end;

function TBaseSafeMem.GetPointer: Pointer;
begin
  Result := nil;
end;

function TBaseSafeMem.GetSize: Integer;
begin
  Result := FStream.Size;
end;

function TBaseSafeMem.GetStream: TStream;
begin
  Result := FStream;
end;

function TBaseSafeMem.Grab(const Stream: TStream;
  const AdjustSize: Boolean): Integer;
var
  Grabbed : Integer;
begin
  Assert(Assigned(Stream));

  if GetSize > 0 then
  begin
    Grabbed := Stream.Read(GetPointer^, GetSize);

    if AdjustSize then
      SetSize(Grabbed);

    Result := Grabbed;
  end else
    Result := 0;
end;

procedure TBaseSafeMem.Grow(const By: Integer);
begin
  SetSize(GetSize + By);
end;

procedure TBaseSafeMem.LoadFromFile(const FileName: string);
var
  FileStream  : TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    FStream.Size := 0;
    FStream.CopyFrom(FileStream, 0);
    FStream.Position := 0;
  finally
    FileStream.Free;
  end;
end;

procedure TBaseSafeMem.Release;
begin
  SetSize(0);
end;

procedure TBaseSafeMem.SaveToFile(const FileName: string);
var
  FileStream  : TFileStream;
begin
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    FileStream.CopyFrom(FStream, 0);
    FStream.Position := 0;
  finally
    FileStream.Free;
  end;
end;

procedure TBaseSafeMem.SetAsString(const NewValue: string);
begin
  SetSize(Length(NewValue));
  if NewValue <> '' then
    Move(NewValue[1], GetPointer^, Length(NewValue));
end;

procedure TBaseSafeMem.SetSize(const NewSize: Integer);
begin
  FStream.Size := NewSize;
end;

procedure TBaseSafeMem.Shrink(const By: Integer);
begin
  Grow(-By);
end;

procedure TBaseSafeMem.Zero;
begin
  Fill(0);
end;

{ TSafeMem }

function TSafeMem.Clone(const CopyContents: Boolean): ISafeMem;
begin
  Result := TSafeMem.Create(GetSize);
  if CopyContents and (GetSize > 0) then
    Move(GetPointer^, Result.Pointer^, GetSize);
end;

constructor TSafeMem.Create(const Amount: Integer);
var
  Stream  : TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  try
    Assert(Amount >= 0, 'Amount is negative: ' + IntToStr(Amount));
    Assert(Amount < 100*1024*1024, 'Amount is too large: ' + IntToStr(Amount));
    Stream.Size := Amount;
    inherited Create(Stream);
  except
    Stream.Free;
    raise;
  end;
end;

function TSafeMem.GetPointer: Pointer;
begin
  Result := TMemoryStream(GetStream).Memory;
end;

{ TSwapFileSafeMem }

function TTempFileSafeMem.Clone(const CopyContents: Boolean): ISafeMem;
begin
  Result := TTempFileSafeMem.Create(GetSize);
  if CopyContents and (GetSize > 0) then
    Move(GetPointer^, Result.Pointer^, GetSize);
end;

procedure TTempFileSafeMem.CloseMemoryMap;
begin
  if Assigned(FMemoryMap) and (FMemoryMap <> @FDummy) then
    if not UnmapViewOfFile(FMemoryMap) then
      RaiseLastWin32Error;
  FMemoryMap := @FDummy;

  if FMappingHandle <> INVALID_HANDLE_VALUE then
    if not CloseHandle(FMappingHandle) then
      RaiseLastWin32Error;
  FMappingHandle := INVALID_HANDLE_VALUE;

  FMemoryMapSize := 0;
end;

constructor TTempFileSafeMem.Create(const Amount: Integer);
var
  TempPath  : array[0..MAX_PATH] of Char;
  TempName  : array[0..MAX_PATH] of Char;
  Stream    : TFileStream;
begin
  if GetTempPath(SizeOf(TempPath), TempPath) = 0 then
    RaiseLastWin32Error;

  if GetTempFileName(TempPath, nil, 0, TempName) = 0 then
    RaiseLastWin32Error;

  FMappingHandle := INVALID_HANDLE_VALUE;
  FMemoryMap := @FDummy;
  FMemoryMapSize := 0;

  FFileName := TempName;
  Stream := TFileStream.Create(FFileName, fmCreate);
  try
    inherited Create(Stream);
    SetSize(Amount);
  except
    Stream.Free;
    raise;
  end;
end;

destructor TTempFileSafeMem.Destroy;
begin
  CloseMemoryMap;
  inherited;

  if not DeleteFile(FFileName) then
    RaiseLastWin32Error;
end;

function TTempFileSafeMem.GetPointer: Pointer;
begin
  if FMemoryMapSize <> GetSize then
  begin
    CloseMemoryMap;
    OpenMemoryMap;
  end;

  Result := FMemoryMap;
end;

procedure TTempFileSafeMem.OpenMemoryMap;
var
  SizeRec : Int64Rec;
begin
  Int64(SizeRec) := GetStream.Size;

  FMappingHandle := CreateFileMapping(TFileStream(GetStream).Handle, nil,
    PAGE_READWRITE, SizeRec.Hi, SizeRec.Lo, nil);
  if FMappingHandle = INVALID_HANDLE_VALUE then
    RaiseLastWin32Error;

  FMemoryMap := MapViewOfFile(FMappingHandle, FILE_MAP_WRITE, 0, 0, SizeRec.Lo);
  if not Assigned(FMemoryMap) then
    RaiseLastWin32Error;
end;

{ TDisposable }

constructor TDisposable.Create(const Data: Pointer;
  const DisposeProcedure: TDisposeProcedure;
  const DisposeMethod: TDisposeMethod);
begin
  inherited Create;

  FData := Data;
  FDisposeProcedure := DisposeProcedure;
  FDisposeMethod := DisposeMethod;
end;

destructor TDisposable.Destroy;
begin
  Dispose;

  inherited;
end;

procedure TDisposable.Dispose;
begin
  if Assigned(FDisposeMethod) then
    FDisposeMethod(Self, FData);
  if Assigned(FDisposeProcedure) then
    FDisposeProcedure(FData);

  Forget;
end;

procedure TDisposable.Forget;
begin
  FData := nil;
  FDisposeMethod := nil;
  FDisposeProcedure := nil;
end;

end.