vs_core.pas

KSDev.VirtualSream.v1.01.rar 虚拟文件系统,

{==============================================================================

  Virtual Stream
  Copyright (C) 2004-2006 by Eugene Kryukov
  All rights reserved

  See License.txt for licence information

  $Id: vs_core.pas,v 1.1.1.1 2006/09/26 09:49:37 eugene Exp $

===============================================================================}

unit vs_core;

{$I vs_define.inc}

interface

uses
  SysUtils, Classes, vs_masks, vs_resource;

type
  TSign = array[0..6] of char;
  
const
  VFSSignature: TSign = 'VFILEST';

  EmptyBlock: longword   = $FFFFFFFC;
  EndBlock: longword     = $FFFFFFFE;
  BadBlock: longword     = $FFFFFFFA;

  BlockSize = 4096;

  DirDivider     = '\/';

  EraseSymbol    = #254;

  deSelf         = 0;
  deParent       = 1;

type

  TFileSystem = class;

  TFAT = array of longword;

  TFileEntry = record
    Name: string;
    Size: longword;
    Attr: longword;
    Date: TDateTime;
    Link: longword;
    Res: array [0..15] of byte;
  end;

  TFileEntryArray = array of TFileEntry;

  TDir = class;

  TFile = class
  private
    FEntry: TFileEntry;
    FPosition: longword;
    FMode: Word;
    FDir: TDir;
    FIndex: longword;
  public
    constructor CreateEmpty(const AFileName: string; ADir: TDir; AMode: Word);
    constructor CreateOpen(const AFileName: string; ADir: TDir; AMode: Word);
    destructor Destroy; override;
    { access }
    function Size: longword;
    function Date: TDateTime;
  end;

  TDirEntry = record
    Count: longword;
    Files: TFileEntryArray;
  end;

  TDir = class
  private
    FEntry: TDirEntry;
    FFileSystem: TFileSystem;
  public
    constructor CreateEmpty(AFileSystem: TFileSystem; ParentLink, CurLink: longword);
    constructor CreateOpen(AFileSystem: TFileSystem; Link: longword);
    function GetSize: longword;
    procedure SaveDir;
    { add new }
    function AddEntry(AName: string; AAttr: longword; ALink: longword): boolean;
    { directory }
    function CreateDirEntry(Parent: longword): TDir;
    function OpenDirEntry(DirLink: longword): TDir;
    { check }
    function DirExists(AName: string): boolean;
  end;

  TFileSystem = class
  private
    { Header }
    Sign: TSign;
    FATSize: longword;
    FATPos: longword;
    FAT: TFAT;
    RootLink: longword; // link to cluster
    Reserved: array [1..1020] of byte;
    { Header end }
    ReadOnly: Longbool;
    Compress: Longbool;
    FRoot: TDir;
    FStream: TStream;
    { Files handle }
    FDirs: TStringList;
    FFiles: TStringList;
    FMode: Word;
    function FATOffset(): longword;
    function DataOffset(): longword;
    function ReadOnlyOffset(): longword;
    procedure SaveFAT(const Index, Value: longword);
  public
    constructor CreateEmpty(Stream: TStream; AReadOnly: boolean = false;
      ACompress: boolean = false; AMaxSize: longword = 16384);
    constructor CreateOpen(Stream: TStream; const Mode: Word);
    destructor Destroy;
    { low-level routines }
    function FindNextLink(const ALink: longword): longword;
    function LoadData(Link: longword; const Buf: PByteArray; const Pos, Size: longword): longword;
    function SaveData(Link: longword; const Buf: PByteArray; const Pos, Size: longword): longword;
    procedure EraseData(Link: longword);
    { low level directory }
    function GetDir(CurDir: TDir; Path, CurPath: string): TDir;
    { high level routines }
    procedure CreateDir(const ADirName: string);
    procedure ForceDir(ADirName: string);
    function CreateFile(const AFileName: string): TFile;
    function OpenFileRead(const AFileName: string): TFile;
    function OpenFileWrite(const AFileName: string): TFile;
    procedure CloseFile(AFile: TFile);
    procedure EraseFile(AFile: TFile);

    function FileExists(const AFileName: string): boolean;
    function DirectoryExists(const AFileName: string): boolean;

    function Write(const F: TFile; Buf: Pointer; const ASize: longword): longword;
    function Read(const F: TFile; Buf: Pointer; const ASize: longword): longword;

    procedure SetReadOnly(Value: boolean);

    function FindFirst(const Path: string; Attr: Integer;
      var F: TSearchRec): Integer;
    function FindNext(var F: TSearchRec): Integer;
    procedure FindClose(var F: TSearchRec);
    property Root: TDir read FRoot;
    property Compressed: Longbool read Compress;
    property IsReadOnly: Longbool read ReadOnly;
  end;

  TFileSystemStream = class(TStream)
  private
    FFileSystem: TFileSystem;
    FFileHandle: TFile;
  protected
    procedure SetSize(NewSize: Longint); override;
    {$IFDEF KS_COMPILER6_UP}
    procedure SetSize(const NewSize: Int64); override;
    {$ENDIF}
  public
    constructor Create(const AFileSystem: TFileSystem; const FileName: string; Mode: Word); overload;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    {$IFDEF KS_COMPILER6_UP}
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    {$ELSE}
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    {$ENDIF}
    property FileHandle: TFile read FFileHandle;
  end;

implementation {===============================================================}

procedure Log(AText: string);
begin
  { error log }
end;

function GetFirstDir(var Path: string): string;
var
  i: byte;
  CopyS: string;
begin
  Result := '';
  if Path = '' then Exit;
  if Pos(Path[1], DirDivider) > 0 then
    Delete(Path, 1, 1); // remove root

  CopyS := Path;
  for i := 1 to Length(CopyS) do
  begin
    Delete(Path, 1, 1);
    if Pos(CopyS[i], DirDivider) > 0 then Break;
    Result := Result + CopyS[i];
  end;
end;

function GetPath(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter(DirDivider, FileName);
  Result := Copy(FileName, 1, I);
end;

function GetName(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter(DirDivider, FileName);
  Result := Copy(FileName, I + 1, MaxInt);
end;

{ TFile }

constructor TFile.CreateEmpty(const AFileName: string; ADir: TDir; AMode: Word);
var
  CurLink: longword;
begin
  inherited Create;

  FDir := ADir;
  CurLink := FDir.FFileSystem.FindNextLink(EmptyBlock);
  FDir.FFileSystem.SaveFAT(CurLink, EndBlock);
  if FDir.AddEntry(AFileName, 0, CurLink) then
  begin
    FIndex := ADir.FEntry.Count - 1;
    FEntry := ADir.FEntry.Files[FIndex];
    FEntry.Date := Now;
    FEntry.Size := 0;
    FMode := AMode;
    FPosition := 0;

    FDir.FEntry.Files[FIndex] := FEntry;
    FDir.SaveDir;
  end
  else
  begin
    Log('can''t add new entry');
    FPosition := BadBlock;
  end;
end;

constructor TFile.CreateOpen(const AFileName: string; ADir: TDir; AMode: Word);
var
  i: integer;
begin
  inherited Create;
  FDir := ADir;
  for i := 0 to FDir.FEntry.Count - 1 do
    if CompareText(FDir.FEntry.Files[i].Name, AFileName) = 0 then
    begin
      FIndex := i;
      FEntry := ADir.FEntry.Files[FIndex];
      FMode := AMode;
      FPosition := 0;
      Exit;
    end;
//  Log('Can''t found file ' + AFileName);
  FPosition := BadBlock;
  FDir := nil;
end;

destructor TFile.Destroy;
begin
  if (FDir <> nil) and (FPosition <> BadBlock) then
  begin
    FDir.FEntry.Files[FIndex] := FEntry;
    FDir.SaveDir;
  end;
  inherited;
end;

function TFile.Size: longword;
begin
  Result := FEntry.Size;
end;

function TFile.Date: TDateTime;
begin
  Result := FEntry.Date;
end;

{ TDir ========================================================================}

constructor TDir.CreateEmpty(AFileSystem: TFileSystem; ParentLink, CurLink: longword);
begin
  inherited Create;
  FFileSystem := AFileSystem;

  FEntry.Count := 2;
  SetLength(FEntry.Files, FEntry.Count);
  with FEntry.Files[deSelf] do
  begin
    Name := '.';
    Size := 0;
    Date := Now;
    Attr := faDirectory;
    Link := CurLink;
  end;
  with FEntry.Files[deParent] do
  begin
    Name := '..';
    Size := 0;
    Date := Now;
    Attr := faDirectory;
    Link := ParentLink;
  end;
  SaveDir;
end;

constructor TDir.CreateOpen(AFileSystem: TFileSystem; Link: longword);
var
  i: integer;
  M: TMemoryStream;
  S: longword;
begin
  inherited Create;
  FFileSystem := AFileSystem;
  M := TMemoryStream.Create;

  FFileSystem.LoadData(Link, PByteArray(@S), 0, SizeOf(S));
  M.Size := S;
  FFileSystem.LoadData(Link, PByteArray(M.Memory), SizeOf(S), M.Size);
  M.Position := 0;

  FEntry.Count := ReadLongword(M);
  SetLength(FEntry.Files, FEntry.Count);
  for i := 0 to FEntry.Count - 1 do
    with FEntry do
    begin
      Files[i].Name := ReadString(M);
      Files[i].Size := ReadLongword(M);
      Files[i].Attr := ReadLongword(M);
      Files[i].Date := ReadDouble(M);
      Files[i].Link := ReadLongword(M);
      ReadBuf(M, @Files[i].Res, SizeOf(Files[i].Res));
    end;
  M.Free;
end;

function TDir.GetSize: longword;
begin
  Result := SizeOf(FEntry.Count) + (FEntry.Count * SizeOf(TFileEntry));
end;

procedure TDir.SaveDir;
var
  i: integer;
  M: TMemoryStream;
  S: longword;
begin
  M := TMemoryStream.Create;
  WriteLongword(M, FEntry.Count);
  for i := 0 to FEntry.Count - 1 do
    with FEntry do
    begin
      WriteString(M, Files[i].Name);
      WriteLongword(M, Files[i].Size);
      WriteLongword(M, Files[i].Attr);
      WriteDouble(M, Files[i].Date);
      WriteLongword(M, Files[i].Link);
      WriteBuf(M, @Files[i].Res, SizeOf(Files[i].Res));
    end;
  S := M.Size;
  FFileSystem.SaveData(FEntry.Files[deSelf].Link, PByteArray(@S), 0, SizeOf(S));
  FFileSystem.SaveData(FEntry.Files[deSelf].Link, PByteArray(M.Memory), SizeOf(S), M.Size);
  M.Free;
end;

function TDir.AddEntry(AName: string; AAttr, ALink: longword): boolean;
var
  i: integer;
begin
  Result := false;
  for i := 0 to FEntry.Count - 1 do
    if CompareText(FEntry.Files[i].Name, AName) = 0 then
    begin
      Log('Entry ' + AName + ' alredy exists');
      Result := false;
      Exit;
    end;

  Result := true;
  
  FEntry.Count := FEntry.Count + 1;
  SetLength(FEntry.Files, FEntry.Count);
  with FEntry.Files[FEntry.Count - 1] do
  begin
    Name := AName;
    Attr := AAttr;
    Link := ALink;
  end;
  SaveDir;
end;

{ directories }

function TDir.CreateDirEntry(Parent: longword): TDir;
var
  CurLink: longword;
begin
  CurLink := FFileSystem.FindNextLink(EmptyBlock);
  FFileSystem.SaveFAT(CurLink, EndBlock);

  Result := TDir.CreateEmpty(FFileSystem, Parent, CurLink);
end;