Delphi控件源码

开发平台：
Delphi

MMFFile.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMFFile;
{$I COMPILER.INC}
interface
uses
    Windows,
    SysUtils,
    Controls,
    Classes,
    MMSystem,
    MMObj,
    MMUtils,
    MMString,
    MMSearch;
type
    EMMFastFileError = class(Exception);
    PFileEntry = ^TFileEntry;
    TFileEntry = packed record
       Name   : String[12];
       Size   : Longint;
       Offset : Longint;
       Deleted: Boolean;
    end;
    PFileEntryArray = ^TFileEntryArray;
    TFileEntryArray = array[0..0] of TFileEntry;
    PFileHandle = ^TFileHandle;
    TFileHandle = packed record
       inUse: Boolean;
       Pos  : Longint;
       Size : Longint;
       pfe  : PFileEntry;
    end;
    PFileHandleArray = ^TFileHandleArray;
    TFileHandleArray = array[0..0] of TFileHandle;
    {-- TMMFastFile -----------------------------------------------------}
    TMMFastFile = class(TMMNonVisualComponent)
    private
       FFileName       : TFileName;
       FMaxFiles       : integer;
       FMaxHandles     : integer;
       FHFile          : THandle;
       FHFileMapping   : THandle;
       FPFileEntries   : PFileEntryArray;
       FPFileEntryCount: PLongint;
       FPFileHandles   : PFileHandleArray;
       FPBase          : PChar;
       FNumDeleted     : integer;
       FOnChange       : TNotifyEvent;
       FOnHandlesLost  : TNotifyEvent;
       procedure CreateFastFile(FileName: TFileName; nMaxFiles: integer);
       procedure UpdateFastFile(Size: integer);
       function  IsFastFile(FileName: TFileName): Boolean;
       procedure SetFileName(aValue: TFileName);
       procedure SetMaxFiles(aValue: integer);
       procedure SetMaxHandles(aValue: integer);
       function  GetCount: integer;
       function  GetFileEntries(index: integer): TFileEntry;
       function  GetFiles(index: integer): string;
       function  GetFilesByName(Name: string): string;
    protected
       procedure Change; dynamic;
       procedure HandlesLost; dynamic;
       procedure Loaded; override;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;
       procedure Init;
       procedure Done;
       procedure Pack;
       function  AddFile(const Name: TFileName): TFileName;
       procedure RemoveFile(const Name: TFileName);
       procedure RenameFile(const OldName, NewName: TFileName);
       procedure ExtractFile(const Name, Path: TFileName);
       function  FileExists(const Name: TFileName): Boolean;
       function  FileSize(const Name: TFileName): integer;
       function  FileOpen(const Name: TFileName): PFileHandle;
       procedure FileClose(pfh: PFileHandle);
       function  FileLock(pfh: PFileHandle; pos, size: integer): Pointer;
       procedure FileUnlock(pfh: PFileHandle; pos, size: integer);
       function  FileRead(pfh: PFileHandle; Buffer: PChar; size: integer): integer;
       function  FileSeek(pfh: PFileHandle; pos, origin: integer): integer;
       property  Count: integer read GetCount;
       property  FileEntries[index: integer]: TFileEntry read GetFileEntries;
       property  Files[index: integer]: string read GetFiles; default;
       property  FilesByName[Name: string]: string read GetFilesByName;
    published
       property OnChange: TNotifyEvent read FOnChange write FOnChange;
       property OnHandlesLost: TNotifyEvent read FOnHandlesLost write FOnHandlesLost;
       property FileName: TFileName read FFileName write SetFileName;
       property MaxFiles: integer read FMaxFiles write SetMaxFiles default 50;
       property MaxHandles: integer read FMaxHandles write SetMaxHandles default 10;
    end;
implementation
const
    BLOCK_SIZE : integer = 16*1024;
    KENNUNG    : array[0..8] of Char = 'FASTFILE'+#0;
{========================================================================}
{ Compare: bsearch comparison routine                                    }
{========================================================================}
function Compare(p1, p2: PFileEntry): integer;
begin
   if p2.Deleted then Result := -1
   else Result := CompareText(p1.Name,p2.Name);
end;
{-- TMMFastFile ---------------------------------------------------------}
constructor TMMFastFile.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FOnChange       := nil;
   FOnHandlesLost  := nil;
   FFileName       := '';
   FMaxFiles       := 50;
   FMaxHandles     := 10;
   FHFile          := 0;
   FHFileMapping   := 0;
   FPFileEntries   := nil;
   FPFileEntryCount:= nil;
   FPFileHandles   := nil;
   FPBase          := nil;
   FNumDeleted     := 0;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMFastFile ---------------------------------------------------------}
destructor TMMFastFile.Destroy;
begin
   Done;
   inherited Destroy;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.Loaded;
begin
   inherited;
   if not (csDesigning in ComponentState) then
   begin
      if (FFileName <> '') then Init;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.Change;
begin
   if not (csDesigning in ComponentState) then
      if assigned(FOnChange) then FOnChange(Self);
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.HandlesLost;
begin
   if not (csDesigning in ComponentState) and
      not (csLoading in ComponentState) and
      not (csDestroying in ComponentState) then
      if assigned(FOnHandlesLost) then FOnHandlesLost(Self);
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.SetMaxFiles(aValue: integer);
begin
   if (aValue <> FMaxFiles) then
   begin
      if (FFileName <> '') then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFMAXFILESERROR));
      FMaxFiles := Max(aValue,2);
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.SetMaxHandles(aValue: integer);
begin
   if (aValue <> FMaxHandles) then
   begin
      if (FPFileHandles <> nil) then
      begin
         ReAllocMem(FPFileHandles, aValue*SizeOf(TFileHandle));
         if aValue > FMaxHandles then
            FillChar(FPFileHandles^[FMaxHandles+1],(aValue-FMaxHandles)*sizeOf(TFileHandle), 0)
         else HandlesLost;
      end;
      FMaxHandles := aValue;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.IsFastFile(FileName: TFileName): Boolean;
var
   hIn: THandle;
   Ken: array[0..255] of Char;
begin
   Result := False;
   if (FileName <> '') and SysUtils.FileExists(FileName) then
   begin
      FillChar(Ken,sizeOf(Ken),0);
      hIn := SysUtils.FileOpen(FileName, fmOpenRead or fmShareDenyNone);
      try
         if hIn > 0 then
            if SysUtils.FileRead(hIn, Ken, sizeOf(KENNUNG)-1) = sizeOf(KENNUNG)-1 then
               if StrComp(Ken, KENNUNG) = 0 then Result := True;
      finally
         SysUtils.FileClose(hIn);
      end;
   end;
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.SetFileName(aValue: TFileName);
begin
   if (aValue <> FFileName) then
   begin
      aValue := ExpandUNCFileName(aValue);
      if SysUtils.FileExists(aValue) then
         if not IsFastFile(aValue) then
            raise EMMFastFileError.Create(LoadResStr(IDS_FFNOFASTFILE));
      Done;
      if not SysUtils.FileExists(aValue) then
         CreateFastFile(aValue, FMaxFiles);
      FFileName := aValue;
      if (FFileName <> '') then Init;
      if (csDesigning in ComponentState) then Done;
   end;
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.GetCount: integer;
begin
   if FPFileEntryCount <> nil then Result := FPFileEntryCount^ - FNumDeleted
   else Result := 0;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.GetFileEntries(index: integer): TFileEntry;
var
   i,j: integer;
   fe: TFileEntry;
begin
   if (FPFileEntries = nil) then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
   if (index < Count) then
   begin
      j := 0;
      for i := 0 to FPFileEntryCount^-1 do
      begin
         fe := FPFileEntries[i];
         if not fe.Deleted then
         begin
            if (j = index) then
            begin
               Result := fe;
               exit;
            end;
            inc(j);
         end;
      end;
   end;
   FillChar(Result, sizeOf(Result), 0);
   raise EMMFastFileError.Create(LoadResStr(IDS_FFBADINDEX));
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.GetFiles(index: integer): string;
var
   i,j: integer;
   fe : TFileEntry;
begin
   if (FPFileEntries = nil) then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
   if (index < Count) then
   begin
      j := 0;
      for i := 0 to FPFileEntryCount^-1 do
      begin
         fe := FPFileEntries[i];
         if not fe.Deleted then
         begin
            if (j = index) then
            begin
               Result := fe.Name;
               exit;
            end;
            inc(j);
         end;
      end;
   end;
   Result := '';
   raise EMMFastFileError.Create(LoadResStr(IDS_FFBADINDEX));
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.GetFilesByName(Name: string): string;
var
   fe: TFileEntry;
   pfe: PFileEntry;
begin
   if (FPFileEntries = nil) then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
   if (Name <> '') then
   begin
      fe.Name := PChar(Name);
      pfe := lfind(@fe, FPFileEntries, FPFileEntryCount^, sizeof(TFileEntry), @Compare);
      if (pfe <> nil) then
      begin
         Result := pfe.Name;
      end;
   end
   else
   begin
      Result := '';
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.CreateFastFile(FileName: TFileName; nMaxFiles: integer);
var
   hOut: integer;
   pfe: PFileEntryArray;
   Tmp: Longint;
begin
   if FileName = '' then exit;
   hOut := FileCreate(FileName);
   if (hOut < 0) then
      raise EMMFastFileError.CreateFmt(LoadResStr(IDS_FFCREATEERROR),['FastFile']);
   try
      inc(nMaxFiles); // make place for one entry more
      pfe := nil;
      pfe := GlobalAllocMem(nMaxFiles * sizeOf(TFileEntry));
      FillChar(pfe^, nMaxFiles * sizeOf(TFileEntry), 0);
      FileName := ExpandUNCFileName(FileName);
      if FileWrite(hOut, KENNUNG, sizeOf(KENNUNG)-1) <> sizeOf(KENNUNG)-1 then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR));
      // write the number of max directory entries
      Tmp := nMaxFiles-1;
      if FileWrite(hOut, Tmp, sizeOf(Tmp)) <> sizeOf(Tmp) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR));
      // write the number of current directory entries (0)
      Tmp := 0;
      if FileWrite(hOut, Tmp, sizeOf(Tmp)) <> sizeOf(Tmp) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR));
     {$IFDEF TRIAL}
     {$DEFINE _HACK1}
     {$I MMHACK.INC}
     {$ENDIF}
      // set the offset for the first entry
      pfe[0].Offset := (sizeOf(KENNUNG)-1+2*sizeOf(Longint)) + nMaxFiles * sizeOF(TFileEntry);
      if FileWrite(hOut, pfe^, nMaxFiles * sizeOf(TFileEntry)) <> nMaxFiles * sizeOf(TFileEntry) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR));
   finally
      SysUtils.FileClose(hOut);
      GlobalFreeMem(Pointer(pfe));
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.Init;
begin
   if (FFileName = '') or not SysUtils.FileExists(FFileName) then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
   // make sure any old FastFile is closed
   Done;
   try
      // get a file handle array
      ReAllocMem(FPFileHandles, FMaxHandles*SizeOf(TFileHandle));
      if (FPFileHandles = nil) then OutOfMemoryError;
      FillChar(FPFileHandles^, FMaxHandles * sizeOf(TFileHandle), 0);
      // create a memory mapped file for the master file
      FHFile := CreateFile(PChar(FFileName), GENERIC_READ or GENERIC_WRITE,
                           FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
                           OPEN_EXISTING, FILE_FLAG_RANDOM_ACCESS, 0);
      if (FHFile = 0) or (FHFile = HFILE_ERROR) then
      begin
         FHFile := 0;
         raise EMMFastFileError.Create('CreateFile failed with Error Code: '+IntToStr(GetLastError));
      end;
      FHFileMapping := CreateFileMapping(FHFile,nil,PAGE_READWRITE,0,0,nil);
      if (FHFileMapping = 0) then
         raise EMMFastFileError.Create('CreateFileMapping failed with Error Code: '+IntToStr(GetLastError));
      FPBase := MapViewOfFile(FHFileMapping, FILE_MAP_WRITE, 0, 0, 0);
      if (FPBase = nil) then
         raise EMMFastFileError.Create('MapViewOfFile failed with Error Code: '+IntToStr(GetLastError));
      // get initial data from the memory mapped file
      FMaxFiles := PLongint(FPBase+sizeOf(KENNUNG)-1)^;
      FPFileEntryCount := PLongint(FPBase + sizeOf(KENNUNG)-1 + sizeOf(Longint));
      FPFileEntries := PFileEntryArray(FPBase + sizeOf(KENNUNG)-1 + 2*sizeOf(Longint));
   except
      Done;
      raise;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.UpdateFastFile(Size: integer);
begin
   try
      if (FHFileMapping <> 0) then
      begin
         if (FPBase <> nil) then
         begin
            UnmapViewOfFile(FPBase);
            FPBase := nil;
         end;
         CloseHandle(FHFileMapping);
         FHFileMapping := 0;
      end;
      if (FHFile <> 0) then
      FHFileMapping := CreateFileMapping(FHFile,nil,PAGE_READWRITE,0,Size,nil);
      if (FHFileMapping = 0) then
         raise EMMFastFileError.Create('CreateFileMapping failed with Error Code: '+IntToStr(GetLastError));
      FPBase := MapViewOfFile(FHFileMapping, FILE_MAP_WRITE, 0, 0, 0);
      if (FPBase = nil) then
         raise EMMFastFileError.Create('MapViewOfFile failed with Error Code: '+IntToStr(GetLastError));
      // get initial data from the memory mapped file
      FMaxFiles := PLongint(FPBase+sizeOf(KENNUNG)-1)^;
      FPFileEntryCount := PLongint(FPBase + sizeOf(KENNUNG)-1 + sizeOf(Longint));
      FPFileEntries := PFileEntryArray(FPBase + sizeOf(KENNUNG)-1 + 2*sizeOf(Longint));
      {$IFDEF TRIAL}
      {$DEFINE _HACK2}
      {$I MMHACK.INC}
      {$ENDIF}
      HandlesLost;
   except
      Done;
      raise;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.Done;
begin
   Pack;
   if (FHFileMapping <> 0) then
   begin
      if (FPBase <> nil) then UnmapViewOfFile(FPBase);
      CloseHandle(FHFileMapping);
      FHFileMapping := 0;
   end;
   if (FHFile <> 0) then
   begin
      CloseHandle(FHFile);
      FHFile := 0;
   end;
   if (FPFileHandles <> nil) then
   begin
      ReAllocmem(FPFileHandles,0);
      FPFileHandles := nil;
   end;
   FPBase := nil;
   FPFileEntryCount := nil;
   FPFileEntries := nil;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.AddFile(const Name: TFileName): TFileName;
var
   hIn      : THandle;
   Bytes,pos: integer;
   Buffer   : PChar;
   NewName  : String;
begin
   Result := '';
    if (FPFileEntries = nil) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
   hIn  := 0;
   Buffer := nil;
   try
      // is place for more entry's ?
      if (FPFileEntryCount^ >= FMaxFiles) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFDIRFULL));
      // get a short filename for the new file
      NewName := GetShortFileName(Name);
      if (NewName = '') then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
      // is the file already in directory or deleted ?
      if FileExists(NewName) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFDUPLICATEFILENAME));
      // open the new file
      hIn := SysUtils.FileOpen(Name, fmOpenRead);
      if (hIn < 0) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFOPENERROR));
      Buffer := GlobalAllocMem(BLOCK_SIZE);
      // adjust the size for the MemMapFile
      UpdateFastFile(FPFileEntries[FPFileEntryCount^].Offset+ GetFileSize(Name));
      pos := FPFileEntries[FPFileEntryCount^].Offset;
      while True do
      begin
         Bytes := SysUtils.FileRead(hIn, Buffer^, BLOCK_SIZE);
         if (Bytes = 0) then break;
         if (Bytes < 0) then
            raise EMMFastFileError.Create(LoadResStr(IDS_FFREADERROR));
         try
            move(Buffer^, (FPBase + pos)^, Bytes);
            inc(pos, Bytes);
         except
            raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR));
         end;
         if (Bytes < BLOCK_SIZE) then break;
      end;
      FPFileEntries[FPFileEntryCount^].Name := NewName;
      FPFileEntries[FPFileEntryCount^].Deleted := False;
      FPFileEntries[FPFileEntryCount^].Size := pos - FPFileEntries[FPFileEntryCount^].Offset;
      // inc the directory entry counter
      inc(FPFileEntryCount^);
      // save current file position for the next entry
      FPFileEntries[FPFileEntryCount^].Offset := pos;
      Result := NewName;
      Change;
   finally
      SysUtils.FileClose(hIn);
      GlobalFreeMem(Pointer(Buffer));
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.RemoveFile(const Name: TFileName);
var
   fe : TFileEntry;
   pfe: PFileEntry;
   i  : integer;
begin
    if (FPFileEntries = nil) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
    if (Name = '') then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
    fe.Name := Name;
    pfe := lfind(@fe, FPFileEntries, FPFileEntryCount^, sizeof(TFileEntry), @Compare);
    if (pfe <> nil) then
    begin
       for i := 0 to FMaxHandles-1 do
       begin
          if (FPFileHandles[i].pfe <> nil) and
             (FPFileHandles[i].pfe.Name = pfe.Name) then
          begin
             FPFileHandles[i].inUse := False;
             break;
          end;
       end;
       pfe.Deleted := True;
       inc(FNumDeleted);
       Change;
    end
    else raise EMMFastFileError.CreateFmt(LoadResStr(IDS_FFNOTFOUND),[Name]);
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.RenameFile(const OldName, NewName: TFileName);
var
   fe : TFileEntry;
   pfe: PFileEntry;
begin
    if (FPFileEntries = nil) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
    if (Name = '') or (NewName = '') then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
    if FileExists(NewName) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFDUPLICATEFILENAME));
    fe.Name := OldName;
    pfe := lfind(@fe, FPFileEntries, FPFileEntryCount^, sizeof(TFileEntry), @Compare);
    if (pfe <> nil) then
    begin
       pfe.Name := NewName;
       Change;
    end
    else raise EMMFastFileError.CreateFmt(LoadResStr(IDS_FFNOTFOUND),[OldName]);
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.ExtractFile(const Name, Path: TFileName);
var
   hOut   : THandle;
   pfh    : PFileHandle;
   Buffer : PChar;
   Bytes  : integer;
   NewFile: TFileName;
begin
    if (FPFileEntries = nil) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
    if not FileExists(Name) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
    if (Path = '') then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFBADPATH));
    Buffer := nil;
    hOut := 0;
    pfh := FileOpen(Name);
    try
       NewFile := ExpandUNCFileName(Path);
       if ExtractFileName(NewFile) = '' then
          NewFile := ExtractFilePath(NewFile) + Name;
       hOut := SysUtils.FileCreate(NewFile);
       if (hOut < 0) then
          raise EMMFastFileError.CreateFmt(LoadResStr(IDS_FFCREATEERROR),[NewFile]);
       Buffer := GlobalAllocMem(BLOCK_SIZE);
       // copy the data in the file to the new file
       while True do
       begin
          Bytes := FileRead(pfh, Buffer, BLOCK_SIZE);
          if (Bytes = 0) then break;
          if (Bytes < 0) then
             raise EMMFastFileError.Create(LoadResStr(IDS_FFREADERROR)+' "'+Name+'"');
          if SysUtils.FileWrite(hOut, Buffer^, Bytes) <> Bytes then
            raise EMMFastFileError.Create(LoadResStr(IDS_FFWRITEERROR)+' "'+NewFile+'"');
          if (Bytes < BLOCK_SIZE) then break;
      end;
    finally
       FileClose(pfh);
       SysUtils.FileClose(hOut);
       GlobalFreeMem(Pointer(Buffer));
    end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.Pack;
var
   i: integer;
   TempFile: String;
   hFile: THandle;
   hFileMapping: THandle;
   pBase: PChar;
   feSrc: TFileEntry;
   pfe: PFileEntryArray;
   pfeCnt: PLongint;
   NewSize: Longint;
   pos: Longint;
begin
   if (FPFileEntries <> nil) and (FNumDeleted > 0) then
   begin
      SetLength(TempFile, MAX_PATH);
      GetTempFileName(PChar(ExtractFilePath(FFileName)),'FAST'#0,0,PChar(TempFile));
      CreateFastFile(TempFile,FMaxFiles);
      try
         if not SysUtils.FileExists(TempFile) then
            raise EMMFastFileError.Create(LoadResStr(IDS_FFTEMPERROR));
         NewSize := (sizeOf(KENNUNG)-1)+2*sizeOf(Longint)+FMaxFiles*sizeOf(TFileEntry);
         for i := 0 to Count-1 do inc(NewSize, FileEntries[i].Size);
         // create a memory mapped file for the temp file
         hFile := CreateFile(PChar(TempFile), GENERIC_READ or GENERIC_WRITE,
                           FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
                           OPEN_EXISTING, FILE_FLAG_RANDOM_ACCESS, 0);
         if (hFile = 0) or (hFile = HFILE_ERROR) then
         begin
            hFile := 0;
            raise EMMFastFileError.Create('CreateFile failed with Error Code: '+IntToStr(GetLastError));
         end;
         hFileMapping := CreateFileMapping(hFile,nil,PAGE_READWRITE,0,NewSize,nil);
         if (hFileMapping = 0) then
         raise EMMFastFileError.Create('CreateFileMapping failed with Error Code: '+IntToStr(GetLastError));
         pBase := MapViewOfFile(hFileMapping, FILE_MAP_WRITE, 0, 0, 0);
         if (pBase = nil) then
            raise EMMFastFileError.Create('MapViewOfFile failed with Error Code: '+IntToStr(GetLastError));
         // get initial data from the memory mapped file
         pfeCnt := PLongint(pBase + sizeOf(KENNUNG)-1 + sizeOf(Longint));
         pfe := PFileEntryArray(pBase + sizeOf(KENNUNG)-1 + 2*sizeOf(Longint));
         pos := pfe[0].Offset;
         for i := 0 to Count-1 do
         begin
            try
               feSrc := FileEntries[i];
               pfe[i].Name := feSrc.Name;
               pfe[i].Offset := pos;
               pfe[i].Size := feSrc.Size;
               pfe[i].Deleted := False;
               move((FPBase + feSrc.Offset)^, (pBase + pos)^, feSrc.Size);
               inc(pos, feSrc.Size);
               inc(pfeCnt^);
            except
               raise EMMFastFileError.Create(LoadResStr(IDS_FFPACKERROR));
            end;
         end;
         // save current file position for the next entry
         pfe[pfeCnt^].Offset := pos;
         HandlesLost;
      finally
         if (hFileMapping <> 0) then
         begin
            if (pBase <> nil) then UnmapViewOfFile(pBase);
            CloseHandle(hFileMapping);
         end;
         if (hFile <> 0) then CloseHandle(hFile);
      end;
      FNumDeleted := 0;
      // now delete the old FastFile
      Done;
      SysUtils.DeleteFile(FFileName);
      SysUtils.RenameFile(TempFile,FFileName);
      Init;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileExists(const Name: TFileName): Boolean;
var
   fe: TFileEntry;
   pfe: PFileEntry;
begin
   Result := False;
   if (FPFileEntries = nil) then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
   if (Name <> '') then
   begin
      fe.Name := Name;
      pfe := lfind(@fe, FPFileEntries, FPFileEntryCount^, sizeof(TFileEntry), @Compare);
      Result := (pfe <> nil);
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileSize(const Name: TFileName): integer;
var
   pfh: PFileHandle;
begin
   Result := 0;
   if FileExists(Name) then
   begin
      pfh := FileOpen(Name);
      Result := pfh.Size;
      FileClose(pfh);
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileOpen(const Name: TFileName): PFileHandle;
var
   fe: TFileEntry;
   pfe: PFileEntry;
   i: Longint;
begin
    Result := nil;
    if (FPFileEntries = nil) then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOTINIT));
    if (Name = '') then
       raise EMMFastFileError.Create(LoadResStr(IDS_FFBADFILENAME));
    fe.Name := Name;
    pfe := lfind(@fe, FPFileEntries, FPFileEntryCount^, sizeof(TFileEntry), @Compare);
    if (pfe <> nil) then
    begin
       for i := 0 to FMaxHandles-1 do
       begin
          if not FPFileHandles[i].inUse then
          begin
             FPFileHandles[i].inUse := True;
             FPFileHandles[i].Pos := pfe.Offset;
             FPFileHandles[i].Size := pfe.Size;
             FPFileHandles[i].pfe := pfe;
             Result := @FPFileHandles[i];
             exit;
          end;
       end;
       raise EMMFastFileError.Create(LoadResStr(IDS_FFNOHANDLES));
    end
    else raise EMMFastFileError.CreateFmt(LoadResStr(IDS_FFNOTFOUND),[Name]);
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.FileClose(pfh: PFileHandle);
begin
   if (pfh <> nil) and (pfh.inUse = True) or pfh.pfe.Deleted then
   begin
      pfh.inUse := False;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileLock(pfh: PFileHandle; pos, size: integer): Pointer;
begin
   Result := nil;
   if (pfh = nil) or (pfh.inUse <> True) or pfh.pfe.Deleted then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADHANDLE));
   if (Size > 0) then
   begin
      if (pos+size) > PFileEntry(PChar(pfh.pfe)+sizeOf(pfh.pfe^)).Offset then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFFILEEND));
      Result := FPBase + pfh.pfe.offset + pos;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
procedure TMMFastFile.FileUnlock(pfh: PFileHandle; pos, size: integer);
begin
   if (pfh = nil) or (pfh.inUse <> True) or pfh.pfe.Deleted then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADHANDLE));
   if (size > 0) then
      if (pos+size) > PFileEntry(PChar(pfh.pfe)+sizeOf(pfh.pfe^)).Offset then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFFILEEND));
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileRead(pfh: PFileHandle; Buffer: PChar; size: integer): integer;
begin
   Result := 0;
   if (pfh = nil) or (pfh.inUse <> True) or pfh.pfe.Deleted then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADHANDLE));
   size := Min(size,PFileEntry(PChar(pfh.pfe)+sizeOf(pfh.pfe^)).Offset - pfh.pos);
   if (size > 0) then
   begin
      move((FPBase + pfh.pos)^, Buffer^, size);
      inc(pfh.pos,size);
      Result := size;
   end;
end;
{-- TMMFastFile ---------------------------------------------------------}
function TMMFastFile.FileSeek(pfh: PFileHandle; pos, origin: integer): integer;
var
   pfe: PFileEntry;
begin
   Result := -1;
   if (pfh = nil) or (pfh.inUse <> True) or pfh.pfe.Deleted then
      raise EMMFastFileError.Create(LoadResStr(IDS_FFBADHANDLE));
   pfe := pfh.pfe;
   if (origin = SEEK_SET) then
   begin
      if (pos < 0) or (pos >= pfh.size) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFBADOFFSET));
      inc(pos,pfe.offset);
   end
   else if (origin = SEEK_END) then
   begin
      if (pos < 0) or (pos >= pfh.size) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFBADOFFSET));
      pos := PFileEntry(PChar(pfe)+sizeOf(pfe^)).offset - pos;
   end
   else if (origin = SEEK_CUR) then
   begin
      pos := pfh.pos + pos;
      if (pos < pfe.offset) or (pos >= PFileEntry(PChar(pfe)+sizeOf(pfe^)).offset) then
         raise EMMFastFileError.Create(LoadResStr(IDS_FFBADOFFSET));
   end
   else raise EMMFastFileError.Create(LoadResStr(IDS_FFBADORIGIN));
   pfh.pos := pos;
   Result := pos - pfe.offset;
end;
end.

						