jusectionobjs.pas

《参透Delphi Kylix》通过131个事例

  FSize := Size;
  if Assigned(SecurityAttributes) then
  begin
    GetMem(FSecurityAttributes, SizeOf(TSecurityAttributes));
    FSecurityAttributes^ := SecurityAttributes^;
  end;
  FProtect := Protect;
  FIsCreator := not HasCreated(MapName);
  Result := DoCreateSection(MapName, Size, SecurityAttributes, Protect);
end;

destructor TJuSectionObject.Destroy;
begin
  if FMapped then Unmap();
  if Assigned(FSecurityAttributes) then FreeMem(FSecurityAttributes);
  CloseHandle(FHandle);
  FHandle := 0;
  inherited;
end;

class function TJuSectionObject.HasCreated(const MapName: string): Boolean;
var
  LHandle: THandle;
begin
  { No unnamed section object permitted }
  if MapName = '' then raise ESectionException.Create(SSectionUnnamedErr);
  { Try to open the section object }
  Result := True;
  LHandle := OpenSection(MapName);
  { No section object with the same name exists }
  if LHandle = 0 then Result := False else CloseHandle(LHandle);
end;

function TJuSectionObject.Map(ViewOffset: Int64; ViewSize: Cardinal; 
  ViewDesiredAccess: Cardinal; ViewBase: Pointer): Pointer;
var
  OffsetHigh, OffsetLow: Cardinal;
  LViewBase: Pointer;
begin
  Unmap();
  OffsetLow := Cardinal(ViewOffset);
  OffsetHigh := Cardinal(ViewOffset shr 32);
  { Specific mapped address must be rounded to multiple of 64KB. }
  LViewBase := Pointer(Cardinal(ViewBase) - Cardinal(ViewBase) mod FAllocationGranularity);
  { Map view }
  if Assigned(ViewBase) then
  begin
    { Try to map onto specific address first. }
    FData := MapViewOfFileEx(FHandle, ViewDesiredAccess, OffsetHigh, OffsetLow, ViewSize, LViewBase);
    FViewBaseSpecified := Assigned(FData);
    { Try to map onto default address. }
    if not Assigned(FData) then
      FData := MapViewOfFile(FHandle, ViewDesiredAccess, OffsetHigh, OffsetLow, ViewSize);
  end
  else
  begin
    FData := MapViewOfFile(FHandle, ViewDesiredAccess, OffsetHigh, OffsetLow, ViewSize);
    FViewBaseSpecified := False;
  end;
  if not Assigned(FData) then
  begin
    Destroy();
    raise ESectionException.Create(SMapViewErr);
  end;
  FMapped := True;
  FViewDesiredAccess := ViewDesiredAccess;
  FViewOffset := ViewOffset;
  FViewSize := FSize;
  FMapped := True;
  Result := FData;
end;

class function TJuSectionObject.OpenSection(const MapName: string;
  DesiredAccess: Cardinal; InheritHandle: Boolean): THandle;
begin
  Result := OpenFileMapping(DesiredAccess, InheritHandle, PChar(MapName));
end;

procedure TJuSectionObject.Unmap;
begin
  if FMapped then
  begin
    UnmapViewOfFile(FData);
    FData := nil;
    FMapped := False;
    FViewDesiredAccess := FILE_MAP_ALL_ACCESS;
    FViewOffset := 0;
    FViewSize := 0;
    FViewBaseSpecified := False;
  end;
end;

{ TJuMemMapping }

constructor TJuMemMapping.Create(CreateMapped: Boolean; const MapName: string;
  Size: Int64; SecurityAttributes: PSecurityAttributes; Protect: Cardinal;
  ViewDesiredAccess: Cardinal; ViewOffset: Int64; ViewSize: Cardinal; ViewBase: Pointer);
begin
  inherited Create();
  if CreateMapped then
  begin
    CreateSection(MapName, Size, SecurityAttributes, Protect);
    Map(ViewOffset, ViewSize, ViewDesiredAccess, ViewBase);
  end;
end;

function TJuMemMapping.DoCreateSection(const MapName: string; Size: Int64;
  SecurityAttributes: PSecurityAttributes; Protect: Cardinal): THandle;
var
  SizeHigh, SizeLow: Cardinal;
begin
  { Create or open section object }
  SizeLow := Cardinal(Size);
  SizeHigh := Cardinal(Size shr 32);
  FHandle := CreateFileMapping(Cardinal($FFFFFFFF), SecurityAttributes,
    Protect, SizeHigh, SizeLow, PChar(MapName));
  Result := FHandle;
  if FHandle = 0 then
  begin
    Destroy();
    raise ESectionException.Create(SSectionCreationErr);
  end;
end;

function TJuMemMapping.Map(ViewOffset: Int64; ViewSize: Cardinal;
  ViewDesiredAccess: Cardinal; ViewBase: Pointer): Pointer;
begin
  Result := inherited Map(ViewOffset, ViewSize, ViewDesiredAccess, ViewBase);
end;

function TJuMemMapping.Read: Pointer;
begin
  Result := FData;
end;

procedure TJuMemMapping.SetMapped(const Value: Boolean);
begin
  if FMapped <> Value then
  begin
    if Value then
      Map(FViewOffset, FViewSize, FViewDesiredAccess)
    else
      Unmap();
  end;
end;

procedure TJuMemMapping.Unmap;
begin
//  FillChar(FData^, FDataSize, 0);
  inherited;
  FDataSize := 0;
end;

procedure TJuMemMapping.Write(const Buffer: Pointer; BufferSize: Cardinal; StartPos: Cardinal);
begin
  if BufferSize + StartPos < FViewSize then
    Move(Buffer^, Pointer(Cardinal(FData) + StartPos)^, BufferSize)
  else
    Move(Buffer^, Pointer(Cardinal(FData) + StartPos)^, FViewSize - StartPos);
  FDataSize := Min(BufferSize + StartPos, FViewSize);
end;

{ TJuFileMapping }

constructor TJuFileMapping.Create(const FileName: string; CreateMapped: Boolean;
  MapName: string; Size: Int64; FileDesiredAccess, FileShareMode: Cardinal;
  FileSecurityAttributes: PSecurityAttributes;
  FileCreationDisposition, FileFlagsAndAttributes: Cardinal;
  FileTemplateHandle: THandle; SecurityAttributes: PSecurityAttributes;
  Protect, ViewDesiredAccess: Cardinal; ViewOffset: Int64; ViewSize: Cardinal;
  ViewBase: Pointer);
begin
  inherited Create();
  FFileHandle := CreateFile(FileName, FileDesiredAccess, FileShareMode,
    FileSecurityAttributes, FileCreationDisposition,
    FileFlagsAndAttributes, FileTemplateHandle);
  if CreateMapped then
  begin
    CreateSection(MapName, Size, SecurityAttributes, Protect);
    Map(ViewOffset, ViewSize, ViewDesiredAccess, ViewBase);
  end;
end;

function TJuFileMapping.CreateFile(const FileName: string;
  FileDesiredAccess, FileShareMode: Cardinal;
  FileSecurityAttributes: PSecurityAttributes; FileCreationDisposition,
  FileFlagsAndAttributes: Cardinal; FileTemplateHandle: THandle): THandle;
begin
  FFileHandle := Windows.CreateFile(PChar(FileName), FileDesiredAccess,
    FileShareMode, FileSecurityAttributes, FileCreationDisposition,
    FileFlagsAndAttributes, FileTemplateHandle);
  if FFileHandle = INVALID_HANDLE_VALUE then
    raise ESectionException.Create(Format(SFileCreationErr, [FileName]));
  FFileName := FileName;
  FFileDesiredAccess := FileDesiredAccess;
  FFileShareMode := FileShareMode;
  if Assigned(FileSecurityAttributes) then
  begin
    GetMem(FFileSecurityAttributes, SizeOf(TSecurityAttributes));
    FFileSecurityAttributes^ := FileSecurityAttributes^;
  end;
  FFileCreationDisposition := FFileCreationDisposition;
  FFileFlagsAndAttributes := FileFlagsAndAttributes;
  FFileTemplateHandle := FileTemplateHandle;
  Result := FFileHandle;
end;

destructor TJuFileMapping.Destroy;
begin
  if Assigned(FFileSecurityAttributes) then FreeMem(FFileSecurityAttributes);
  inherited;
  CloseHandle(FFileHandle);
  FFileHandle := 0;
end;

function TJuFileMapping.DoCreateSection(const MapName: string; Size: Int64;
  SecurityAttributes: PSecurityAttributes; Protect: Cardinal): THandle;
var
  SizeHigh, SizeLow: Cardinal;
begin
  { Create or open section object }
  SizeLow := Cardinal(Size);
  SizeHigh := Cardinal(Size shr 32);
  FHandle := CreateFileMapping(FFileHandle, SecurityAttributes,
    Protect, SizeHigh, SizeLow, PChar(MapName));
  Result := FHandle;
  if FHandle = 0 then
  begin
    Destroy();
    raise ESectionException.Create(SSectionCreationErr);
  end;
end;

procedure TJuFileMapping.Flush;
begin
  FlushViewOfFile(FData, FViewSize);
end;

function TJuFileMapping.Map(ViewOffset: Int64; ViewSize: Cardinal;
  ViewDesiredAccess: Cardinal; ViewBase: Pointer): Pointer;
begin
  Result := inherited Map(ViewOffset, ViewSize, ViewDesiredAccess, ViewBase);
end;

function TJuFileMapping.Read: Pointer;
begin
  Result := FData;
end;

procedure TJuFileMapping.SetMapped(const Value: Boolean);
begin
  if FMapped <> Value then
  begin
    if Value then
      Map(FViewOffset, FViewSize, FViewDesiredAccess)
    else
      Unmap();
  end;
end;

procedure TJuFileMapping.Write(const Buffer: Pointer; BufferSize,
  StartPos: Cardinal);
begin
  if BufferSize + StartPos < FViewSize then
    Move(Buffer^, Pointer(Cardinal(FData) + StartPos)^, BufferSize)
  else
    Move(Buffer^, Pointer(Cardinal(FData) + StartPos)^, FViewSize - StartPos);
end;

end.