memmap.pas

Delphi7高级应用开发随书源码

unit MemMap;

interface

uses Windows,SysUtils,Classes;

type
    EMMFError = class(Exception);
    TMemMapFile = class
    private
        FFileName : string;
        FSize : Longint;
        FFileSize : Longint;
        FFileMode : Integer;
        FFileHandle : Integer;
        FMapHandle : Integer;
        FData : PByte;
        FMapNow : Boolean;

        procedure AllocFileHandle;
        procedure AllocFileMapping;
        procedure AllocFileView;
        function GetSize: Longint;
    public
        constructor Create(FileName : String; FileMode : Integer;Size : Integer; MapNow : Boolean); virtual;
        destructor Destroy; override;
        procedure FreeMapping;
        property Data : pByte read FData;
        property Size : Longint read GetSize;
        property FileName : String read FFileName;
        property FileHandle : Integer read FFileHandle;
        property MapHandle : Integer read FMapHandle;
    end;

implementation
      constructor TMemMapFile.Create(FileName : String; FileMode : Integer; Size : Integer; MapNow : Boolean);
      begin
         FMapNow := MapNow;
         FFileName := FileName;
         FFileMode := FileMode;

         AllocFileHandle;

         FFileSize := GetFileSize (FFileHandle,nil);
         FSize := Size;

          try
              AllocFileMapping;
          except
              on EMMFError do
              begin
                 CloseHandle(FFileHandle);
                  FFileHandle := 0;
                  raise;
              end;
          end;
          if FMapNow then
             AllocFileView;
      end;

      destructor TMemMapFile.Destroy;
      begin
          if FFileHandle <> 0 then
              CloseHandle(FFileHandle);
          if FMapHandle <> 0 then
              CloseHandle(FMapHandle);
          FreeMapping;
          inherited Destroy;
      end;

      procedure TMemMapFile.FreeMapping;
      begin
          if FData <> nil then
          begin
              UnmapViewOfFile(FData);
              FData := nil;
          end;
      end;

      function TmemMapFile.GetSize : Longint;
      begin
          if FSize <> 0 then
              Result := FSize
          else
              Result := FFileSize;
      end;

      procedure TmemMapFile.AllocFileHandle;
      begin
          if FFileMode = fmCreate then
              FFileHandle := FileCreate(FFileName)
          else
              FFileHandle := FileOpen(FFileName,FFileMode);
          if FFileHandle < 0 then
              raise EMMFError.Create('打开或者创建文件失败！');
      end;

      procedure TMemMapFile.AllocFileMapping;
      var
          ProtAttr : DWORD;
      begin
          if FFileMode = fmOpenRead then
              ProtAttr := Page_ReadOnly
          else
              ProtAttr := Page_ReadWrite;
          FMapHandle := CreateFileMapping(FFileHandle,nil,ProtAttr,0,FSize,nil);
          if FMapHandle = 0 then
              raise EMMFError.Create('创建影射文件出错!');
      end;

      procedure TMemMapFile.AllocFileView;
      var
          Access : Longint;
      begin
          if FFileMode = fmOpenRead then
              Access := File_Map_Read
          else
              Access := File_Map_All_Access;
          FData := MapViewOfFile(FMapHandle,Access,0,0,FSize);
          if FData = nil then
              raise EMMFError.Create('影射文件失败!');
      end;

end.