vs_core.pas

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

function TDir.OpenDirEntry(DirLink: longword): TDir;
begin
  Result := TDir.CreateOpen(FFileSystem, DirLink);
end;

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

{ TFileSystem =================================================================}

constructor TFileSystem.CreateEmpty(Stream: TStream; AReadOnly: boolean = false;
  ACompress: boolean = false; AMaxSize: longword = 16384);
var
  i: integer;
begin
  inherited Create;
  FStream := Stream;
  FMode := fmCreate or fmOpenRead or fmOpenWrite;

  FDirs := TStringList.Create;
  FFiles := TStringList.Create;
  {$IFDEF KS_COMPILER6_UP}
  FFiles.CaseSensitive := false;
  FDirs.CaseSensitive := false;
  {$ENDIF}

  { Fill empty storage }
  Sign := VFSSignature;
  FATSize := AMaxSize;
  FATPos := FATOffset;
  SetLength(FAT, FATSize);
  for i := 0 to FATSize - 1 do
    FAT[i] := EmptyBlock;
  RootLink := 0;
  FAT[RootLink] := EndBlock;
  FillChar(Reserved, SizeOf(Reserved), 0);
  ReadOnly := AReadOnly;
  Compress := ACompress;

  { Save to Stream}
  WriteBuf(Stream, @Sign, SizeOf(Sign));
  WriteLongword(Stream, FATSize);
  WriteLongword(Stream, FATPos);
  WriteLongword(Stream, RootLink);
  WriteLongword(Stream, Longword(ReadOnly));
  WriteLongword(Stream, Longword(Compress));
  WriteBuf(Stream, @Reserved[1], SizeOf(Reserved));
  for i := 0 to FATSize - 1 do
    WriteLongword(Stream, FAT[i]);

  { Create Root }
  FRoot := TDir.CreateEmpty(Self, 0, 0);
  RootLink := FRoot.FEntry.Files[deSelf].Link;
  { Save Root }
  FRoot.SaveDir;
end;

constructor TFileSystem.CreateOpen(Stream: TStream; const Mode: Word);
var
  i: integer;
begin
  inherited Create;
  FStream := Stream;
  FMode := Mode;

  FDirs := TStringList.Create;
  FFiles := TStringList.Create;
  {$IFDEF KS_COMPILER6_UP}
  FFiles.CaseSensitive := false;
  FDirs.CaseSensitive := false;
  {$ENDIF}

  { Load empty Stream}
  ReadBuf(Stream, @Sign, SizeOf(Sign));
  if Sign = VFSSignature then
  begin
    FATSize := ReadLongword(Stream);
    FATPos := ReadLongword(Stream);
    RootLink := ReadLongword(Stream);
    ReadOnly := LongBool(ReadLongword(Stream));
    Compress := LongBool(ReadLongword(Stream));
    ReadBuf(Stream, @Reserved[1], SizeOf(Reserved));
    SetLength(FAT, FATSize);
    for i := 0 to FATSize - 1 do
      FAT[i] := ReadLongword(Stream);
    { Open Root }
    FRoot := TDir.CreateOpen(Self, RootLink);
  end
  else
  begin
    Log('Unsupported file system ')
  end;

  if ReadOnly then
    FMode := fmOpenRead;
end;

procedure TFileSystem.SetReadOnly(Value: boolean);
var
  Save: boolean;
begin
  Save := ReadOnly;
  try
    ReadOnly := Value;
    FStream.Position := ReadOnlyOffset;
    WriteLongword(FStream, Longword(ReadOnly));
  except
    ReadOnly := Save;
  end;
end;

destructor TFileSystem.Destroy;
begin
  FRoot.Free;
  inherited
end;

function TFileSystem.FATOffset: longword;
begin
  Result := Length(Sign) + SizeOf(FATSize) + SizeOf(FATPos) + SizeOf(RootLink) + SizeOf(ReadOnly) + SizeOf(Compress) + SizeOf(Reserved);
end;

function TFileSystem.ReadOnlyOffset: longword;
begin
  Result := Length(Sign) + SizeOf(FATSize) + SizeOf(FATPos) + SizeOf(RootLink);
end;

function TFileSystem.DataOffset: longword;
begin
  Result := SizeOf(Sign) + SizeOf(FATSize) + SizeOf(FATPos) + SizeOf(RootLink) + SizeOf(ReadOnly) + SizeOf(Compress) + SizeOf(Reserved) + FATSize * SizeOf(FAT[0]);
end;

procedure TFileSystem.SaveFAT(const Index, Value: longword);
begin
  FAT[Index] := Value;
  FStream.Position := FATOffset + (Index * SizeOf(FAT[Index]));
  WriteLongword(FStream, Value);
end;

function TFileSystem.FindNextLink(const ALink: longword): longword;
var
  i: integer;
begin
  Result := BadBlock;
  if ALink = EmptyBlock then
  begin
    { Find first empty link }
    for i := 0 to High(FAT) do
      if FAT[i] = EmptyBlock then
      begin
        Result := i;
        Exit;
      end;
  end
  else
  begin
    { Fint first empty from current }
    for i := ALink to High(FAT) do
      if FAT[i] = EmptyBlock then
      begin
        Result := i;
        Exit;
      end;
    { find from start }
    for i := 0 to ALink do
      if FAT[i] = EmptyBlock then
      begin
        Result := i;
        Exit;
      end;
  end;
end;

function TFileSystem.SaveData(Link: longword; const Buf: PByteArray; const Pos, Size: longword): longword;
var
  CurLinkNum, CurLink: longword;
  CurPos, CurSize: longword;
  Stride: longword;
  i: integer;
  ZeroBlock: PByteArray;
begin
  if Link = EmptyBlock then
  begin
    { Return new link, if we start write data first time }
    Result := FindNextLink(Link);
    SaveFAT(Result, EndBlock);
  end
  else
    Result := Link;

  CurLink := Result;
  { Link search }
  CurLinkNum := 1;
  while CurLinkNum * BlockSize <= Pos do
  begin
    { Find next block }
    if FAT[CurLink] = EmptyBlock then
    begin
      { Return new link, if we start write data first time }
      SaveFAT(CurLink, FindNextLink(CurLink));
      CurLink := FAT[CurLink];
      SaveFAT(CurLink, EndBlock);
    end
    else
      if FAT[CurLink] = EndBlock then
      begin
        SaveFAT(CurLink, FindNextLink(CurLink));
        CurLink := FAT[CurLink];
        SaveFAT(CurLink, EndBlock);
      end
      else
      begin
        CurLink := FAT[CurLink];
      end;
    Inc(CurLinkNum);
  end;
  { Write buffer }
  CurPos := Pos;
  CurSize := Size;
  while CurSize > 0 do
  begin
    { Write one block }
    Stride := (CurPos mod BlockSize);
    { write current block }
    FStream.Position := DataOffset + (CurLink * BlockSize) + Stride;
    if BlockSize - Stride < CurSize then
    begin
      FStream.Write(Buf[CurPos - Pos], BlockSize - Stride);
    end
    else
    begin
      { finish }
      FStream.Write(Buf[CurPos - Pos], CurSize);
      { write 0 if is a last block }
      if FStream.Position = FStream.Size then
      begin
        GetMem(ZeroBlock, BlockSize - CurSize);
        FillChar(ZeroBlock^, BlockSize - CurSize, Byte(' '));
        FStream.Write(ZeroBlock[0], BlockSize - CurSize);
        FreeMem(ZeroBlock, BlockSize - CurSize);
      end;
      Break;
    end;

    CurSize := CurSize - (BlockSize - Stride);
    CurPos := CurPos + (BlockSize - Stride);

    { Find next block }
    if FAT[CurLink] = EmptyBlock then
    begin
      { Return new link, if we start write data first time }
      SaveFAT(CurLink, FindNextLink(CurLink));
      CurLink := FAT[CurLink];
      SaveFAT(CurLink, EndBlock);
    end
    else
      if FAT[CurLink] = EndBlock then
      begin
        SaveFAT(CurLink, FindNextLink(CurLink));
        CurLink := FAT[CurLink];
        SaveFAT(CurLink, EndBlock);
      end
      else
      begin
        CurLink := FAT[CurLink];
      end;
  end;
end;

function TFileSystem.LoadData(Link: longword; const Buf: PByteArray; const Pos, Size: longword): longword;
var
  CurLinkNum, CurLink: longword;
  CurPos, CurSize: longword;
  Stride: longword;
  i: integer;
  S: longword;
begin
  Result := 0;
  if Link = EmptyBlock then Exit;

  CurLink := Link;
  { Link search }
  CurLinkNum := 1;
  while CurLinkNum * BlockSize <= Pos do
  begin
    CurLink := FAT[CurLink];
    Inc(CurLinkNum);
  end;
  { Read buffer }
  CurPos := Pos;
  CurSize := Size;
  while CurSize > 0 do
  begin
    { Write one block }
    Stride := (CurPos mod BlockSize);
    { write current block }
    FStream.Position := DataOffset + (CurLink * BlockSize) + Stride;
    if BlockSize - Stride < CurSize then
    begin
      FStream.Read(Buf[CurPos - Pos], BlockSize - Stride);
    end
    else
    begin
      { finish }
      S := FStream.Read(Buf[CurPos - Pos], CurSize);
      if S <> CurSize then
      begin
        Log('Read error');
        Result := S;
        Exit;
      end;
      CurSize := 0;
      Break;
    end;

    CurSize := CurSize - (BlockSize - Stride);
    CurPos := CurPos + (BlockSize - Stride);

    { Break }
    if FAT[CurLink] = EndBlock then
    begin
      Break;
    end;
    if FAT[CurLink] = EmptyBlock then
    begin
      Break;
    end;
    { Find next block }
    CurLink := FAT[CurLink];
  end;
  Result := Size - CurSize;
end;

procedure TFileSystem.EraseData(Link: longword);
var
  CurLink: integer;
begin
  CurLink := Link;
  if FAT[CurLink] = EmptyBlock then Exit;

  while (FAT[CurLink] <> EndBlock) do
  begin
    CurLink := FAT[CurLink];
    SaveFAT(CurLink, EmptyBlock);
  end;
end;

{ Low level directory }

function TFileSystem.GetDir(CurDir: TDir; Path, CurPath: string): TDir;
var
  SubDir: TDir;
  CurDirName: string;
  i: integer;
begin
  Result := nil;
  if Path = '' then
  begin
    Result := FRoot;
    Exit;
  end;
  if FDirs.IndexOf(Path) >= 0 then
  begin
    Result := TDir(FDirs.Objects[FDirs.IndexOf(Path)]);
    Exit;
  end;

  CurDirName := GetFirstDir(CurPath);
  for i := 0 to CurDir.FEntry.Count - 1 do
  begin
    if CompareText(CurDir.FEntry.Files[i].Name, CurDirName) = 0 then
    begin
      if CurDir.FEntry.Files[i].Attr and faDirectory = faDirectory then
      begin
        if CurPath = '' then
        begin
          { End search }
          Result := CurDir.OpenDirEntry(CurDir.FEntry.Files[i].Link);
          FDirs.AddObject(Path, Result);
          Break;
        end
        else
        begin
          { Next level }
          SubDir := CurDir.OpenDirEntry(CurDir.FEntry.Files[i].Link);
          Result := GetDir(SubDir, Path, CurPath);
          SubDir.Free;
        end;
      end;
    end;
  end;
end;

{ High-level routines =========================================================}

procedure TFileSystem.CreateDir(const ADirName: string);
var
  ParentDir, Dir: TDir;
  DirName, ParentDirName: string;
begin
  if fmCreate and FMode = 0 then
  begin
//    Log('Can''t create on read-only store');
    Exit;
  end;