Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Windows API / MS.NET Framework API (https://www.delphipraxis.net/20-library-windows-api-ms-net-framework-api/)
-   -   Delphi Kleines Beispiel zu Memory Mapped Files (MMF) (https://www.delphipraxis.net/2583-kleines-beispiel-zu-memory-mapped-files-mmf.html)

Luckie 30. Jan 2003 10:21


Kleines Beispiel zu Memory Mapped Files (MMF)
 
Delphi-Quellcode:
uses windows,sysutils;

type
  TcsMMFDemo = class(TObject)
  private
    FdwReadSize : DWORD;
    FdwPosition : DWORD;
    FszBuffer   : PChar;
    FdwFileSize : DWORD;
    procedure SetPosition(const Value: DWORD);
  public
    constructor Create(const p_sFilePath : string);
    destructor Destroy; override;
    function ReadMMF(const p_dwSize: DWORD;var p_dwBytesRead : DWORD) : string;
    property Position : DWORD read FdwPosition write SetPosition;
    property Size    : DWORD read FdwFileSize;
  end;

implementation

{ TcsMMFDemo } 

constructor TcsMMFDemo.Create(const p_sFilePath: string);

var
  aSA   : TSecurityAttributes;
  dwSize : DWORD;
  hFile : DWORD;
  hMMF  : DWORD;

begin
  inherited Create;
  aSA.nLength       := SizeOf(TSecurityAttributes);
  aSA.bInheritHandle := true;
  aSA.lpSecurityDescriptor := nil;
  hFile             := CreateFile(PChar(p_sFilePath),GENERIC_READ,FILE_SHARE_READ,@aSA,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  try
    if hFile = INVALID_HANDLE_VALUE then
    begin
      raise Exception.CreateFmt('Datei %s konnte nicht geöffnet werden',[p_sFilePath]);
    end;
    FdwFileSize := GetFileSize(hFile,nil);
    hMMF       := CreateFileMapping(hFile,@aSA,PAGE_READONLY or SEC_COMMIT,0,FdwFileSize,nil);
    if hMMF = 0 then
    begin
      raise Exception.Create('File Mapping fehlgeschlagen');
    end;
  finally
    CloseHandle(hFile);
  end;
  FdwPosition := 0;
  FszBuffer   := MapViewOfFile(hMMF,FILE_MAP_READ,0,0,FdwFileSize);
  try
    if FszBuffer = nil then
    begin
      raise Exception.Create('View Mapping fehlgeschlagen');
    end;
  finally
    CloseHandle(hMMF);
  end;
end;

destructor TcsMMFDemo.Destroy;
begin
  UnmapViewOfFile(FszBuffer);
  inherited Destroy;
end;

procedure TcsMMFDemo.SetPosition(const Value: DWORD);
begin
  if Value < FdwFileSize then
  begin
    FdwPosition := Value;
  end
  else
  begin
    FdwPosition := FdwFileSize-1;
  end;
end;

function TcsMMFDemo.ReadMMF(const p_dwSize: DWORD;var p_dwBytesRead : DWORD) : string;

begin
  Result := '';
  if p_dwSize = 0 then
  begin
    exit;
  end;
  FdwReadSize := p_dwSize;
  if (FdwPosition + FdwReadSize) > FdwFileSize then
  begin
    FdwReadSize := FdwFileSize - FdwPosition;
  end;
  p_dwBytesRead := FdwReadSize;
  Result       := StringOfChar(#00,FdwReadSize);
  StrLCopy(@Result[1],(FszBuffer+FdwPosition),FdwReadSize);
  FdwPosition  := FdwPosition + FdwReadSize;
end;

end.
Autor: Christian Seehase


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:23 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz