mmffile.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  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;