vs_core.pas

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

  ParentDirName := GetPath(ADirName);
  DirName := GetName(ADirName);

  { Check if exists }
  ParentDir := GetDir(FRoot, ADirName, ADirName);
  if ParentDir <> nil then
  begin
//    Log('Dir ' + ADirName + ' already exists');
    Exit;
  end;

  { Add }
  ParentDir := GetDir(FRoot, ParentDirName, ParentDirName);
  if ParentDir <> nil then
  begin
    Dir := ParentDir.CreateDirEntry(ParentDir.FEntry.Files[deSelf].Link);
    Dir.SaveDir;

    ParentDir.AddEntry(DirName, faDirectory, Dir.FEntry.Files[deSelf].Link);
  end;
end;

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

  Dir := GetFirstDir(ADirName);
  while Dir <> '' do
  begin
    CreateDir(Dir);
    Dir := GetFirstDir(ADirName);
  end;
end;

procedure TFileSystem.EraseFile(AFile: TFile);
begin
  if AFile <> nil then
  begin
    AFile.FEntry.Name[1] := EraseSymbol;
    CloseFile(AFile);
  end;
end;

function TFileSystem.CreateFile(const AFileName: string): TFile;
var
  Dir: TDir;
  Idx: integer;
begin
  Result := nil;
  Idx := FFiles.IndexOfName(AFileName);
  if Idx >= 0 then
  begin
    if TFile(FFiles.Objects[Idx]).FMode <> fmOpenRead then
    begin
      Log('Can''t create opened file');
      Result := nil;
      Exit;
    end;
  end;

  if fmCreate and FMode = 0 then
  begin
//    Log('Can''t create on read-only store');
    Exit;
  end;

  ForceDir(GetPath(AFileName));

  Dir := GetDir(FRoot, GetPath(AFileName), GetPath(AFileName));
  if Dir <> nil then
  begin
    { erase first }
    Result := OpenFileRead(AFileName);
    if Result <> nil then
    begin
      EraseFile(Result);
    end;
    { crate new }
    Result := TFile.CreateEmpty(GetName(AFileName), Dir, fmCreate);
    if (Result.FPosition <> BadBlock) then
      FFiles.AddObject(AFileName, Result)
    else
    begin
      Result.Free;
      Result := nil;
    end;
  end;
end;

function TFileSystem.FileExists(const AFileName: string): boolean;
var
  F: TFile;
  Idx: integer;
  Dir: TDir;
begin
  Result := false;
  Idx := FFiles.IndexOfName(AFileName);
  if Idx >= 0 then
  begin
    Result := true;
    Exit;
  end;

  Dir := GetDir(FRoot, GetPath(AFileName), GetPath(AFileName));
  if Dir <> nil then
  begin
    F := TFile.CreateOpen(GetName(AFileName), Dir, fmOpenRead);
    Result := (F.FPosition <> BadBlock) and (F.FEntry.Attr and faDirectory = 0);
    F.Free;
  end;
end;

function TFileSystem.DirectoryExists(const AFileName: string): boolean;
begin
  Result := GetDir(FRoot, AFileName, AFileName) <> nil;
end;

function TFileSystem.OpenFileRead(const AFileName: string): TFile;
var
  Idx: integer;
  Dir: TDir;
begin
  Result := nil;
  Idx := FFiles.IndexOfName(AFileName);
  if Idx >= 0 then
  begin
    if TFile(FFiles.Objects[Idx]).FMode <> fmOpenRead then
    begin
      Log('Can''t create opened file');
      Result := nil;
      Exit;
    end;
  end;

  Dir := GetDir(FRoot, GetPath(AFileName), GetPath(AFileName));
  if Dir <> nil then
  begin
    Result := TFile.CreateOpen(GetName(AFileName), Dir, fmOpenRead);
    if (Result.FPosition = BadBlock) or (Result.FEntry.Attr and faDirectory = faDirectory) then
    begin
      Result.Free;
      Result := nil;
    end
    else
      FFiles.AddObject(AFileName, Result);
  end;
end;

function TFileSystem.OpenFileWrite(const AFileName: string): TFile;
var
  Dir: TDir;
  Idx: integer;
begin
  Result := nil;
  if fmOpenWrite and FMode = 0 then
  begin
      Log('Can''t create opened file');
    Exit;
  end;
  Idx := FFiles.IndexOfName(AFileName);
  if Idx >= 0 then
  begin
    if TFile(FFiles.Objects[Idx]).FMode <> fmOpenRead then
    begin
//      Log('Can''t opwn for write on read-only store');
      Result := nil;
      Exit;
    end;
  end;

  Dir := GetDir(FRoot, GetPath(AFileName), GetPath(AFileName));
  if Dir <> nil then
  begin
    Result := TFile.CreateOpen(GetName(AFileName), Dir, fmOpenWrite);
    if (Result.FPosition = BadBlock) or (Result.FEntry.Attr and faDirectory = faDirectory) then
    begin
      Result.Free;
      Result := nil;
    end
    else
      FFiles.AddObject(AFileName, Result);
  end;
end;

procedure TFileSystem.CloseFile(AFile: TFile);
var
  Idx: integer;
begin
  Idx := FFiles.IndexOfObject(AFile);
  if Idx >= 0 then
  begin
    FFiles.Delete(Idx);
    AFile.Free;
  end;
end;


function TFileSystem.Write(const F: TFile; Buf: Pointer;
  const ASize: longword): longword;
var
  ResLink: longword;
begin
  Result := 0;
  if (fmOpenWrite and FMode = 0) and (fmCreate and FMode = 0) then
  begin
//    Log('Can''t write on read-only store');
    Exit;
  end;

  if F <> nil then
    with F do
    begin
      ResLink := SaveData(FEntry.Link, Buf, FPosition, ASize);
      if (ResLink <> BadBlock) and (ResLink <> EmptyBlock) then
      begin
        FPosition := FPosition + ASize;
        if FPosition > FEntry.Size then
          FEntry.Size := FPosition;
        Result := ASize;
      end;
    end;
end;

function TFileSystem.Read(const F: TFile; Buf: Pointer;
  const ASize: longword): longword;
begin
  Result := 0;
  if F <> nil then
    with F do
    begin
      if FPosition > FEntry.Size then
      begin
        Log('File ' + F.FEntry.Name + ' read error');
        Exit;
      end;
      Result := ASize;
      if FPosition + Result > FEntry.Size then
        Result := FEntry.Size - FPosition;
      Result := LoadData(FEntry.Link, Buf, FPosition, Result);
      FPosition := FPosition + Result;
    end;
end;


function TFileSystem.FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer;
var
  Dir: TDir;
  i: integer;
  Mask: string;
begin
  F.ExcludeAttr := 0;
  Dir := GetDir(FRoot, GetPath(Path), GetPath(Path));
  Mask := GetName(Path);
  if Dir <> nil then
  begin
    for i := 0 to Dir.FEntry.Count - 1 do
      if (Length(Dir.FEntry.Files[i].Name) > 1) and (Dir.FEntry.Files[i].Name[1] <> EraseSymbol) and (vs_matchesMask(Dir.FEntry.Files[i].Name, Mask)) then
      begin
        if F.ExcludeAttr = 0 then
        begin
          F.Time := DateTimeToFileDate(Dir.FEntry.Files[i].Date);
          F.Size := Dir.FEntry.Files[i].Size;
          F.Attr := Dir.FEntry.Files[i].Attr;
          F.Name := Dir.FEntry.Files[i].Name;

          F.ExcludeAttr := Integer(TList.Create);
          TList(F.ExcludeAttr).Add(Dir);
        end
        else
        begin
          TList(F.ExcludeAttr).Add(Pointer(i));
        end;
      end;
    Result := 0;
  end
  else
    Result := 1;
end;

function TFileSystem.FindNext(var F: TSearchRec): Integer;
var
  i: integer;
  Dir: TDir;
begin
  if (F.ExcludeAttr <> 0) and (TList(F.ExcludeAttr).Count > 1) then
  begin
    Dir := TList(F.ExcludeAttr)[0];
    with Dir.FEntry.Files[Integer(TList(F.ExcludeAttr)[1])] do
    begin
      F.Time := DateTimeToFileDate(Date);
      F.Size := Size;
      F.Attr := Attr;
      F.Name := Name;
    end;
    TList(F.ExcludeAttr).Delete(1);
    Result := 0;
  end
  else
    Result := 1;
end;

procedure TFileSystem.FindClose(var F: TSearchRec);
begin
  if F.ExcludeAttr <> 0 then
  begin
    TList(F.ExcludeAttr).Free;
    F.ExcludeAttr := 0;
  end;
end;

{ TFileSystemStream ===========================================================}

constructor TFileSystemStream.Create(const AFileSystem: TFileSystem; const FileName: string; Mode: Word);
begin
  inherited Create;
  FFileSystem := AFileSystem;

  if fmCreate and Mode = fmCreate then
  begin
    FFileHandle := FFileSystem.CreateFile(FileName);
  end
  else
    if fmOpenWrite and Mode = fmOpenWrite then
    begin
      FFileHandle := FFileSystem.OpenFileWrite(FileName);
    end
    else
    begin
      FFileHandle := FFileSystem.OpenFileRead(FileName);
    end;
end;

destructor TFileSystemStream.Destroy;
begin
  if FFileHandle <> nil then
  begin
    FFileSystem.CloseFile(FFileHandle);
  end;
  inherited;
end;

{$IFDEF KS_COMPILER6_UP}
procedure TFileSystemStream.SetSize(const NewSize: Int64);
begin
  { Do nothing }
end;
{$ENDIF}

procedure TFileSystemStream.SetSize(NewSize: Integer);
begin
  SetSize(Int64(NewSize));
end;

{$IFDEF KS_COMPILER6_UP}
function TFileSystemStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  case Origin of
    soBeginning:
      begin
        TFile(FFileHandle).FPosition := Offset;
      end;
    soCurrent:
      begin
        TFile(FFileHandle).FPosition := TFile(FFileHandle).FPosition + Offset;
      end;
    soEnd:
      begin
        TFile(FFileHandle).FPosition := TFile(FFileHandle).FEntry.Size - Offset;
      end;
  end;
  Result := TFile(FFileHandle).FPosition;
end;
{$ELSE}
function TFileSystemStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  case Origin of
    soFromBeginning:
      begin
        TFile(FFileHandle).FPosition := Offset;
      end;
    soFromCurrent:
      begin
        TFile(FFileHandle).FPosition := TFile(FFileHandle).FPosition + Offset;
      end;
    soFromEnd:
      begin
        TFile(FFileHandle).FPosition := TFile(FFileHandle).FEntry.Size - Offset;
      end;
  end;
  Result := TFile(FFileHandle).FPosition;
end;
{$ENDIF}

function TFileSystemStream.Read(var Buffer; Count: Integer): Longint;
begin
  if FFileHandle.FPosition + Count > FFileHandle.Size then
    Count := FFileHandle.Size - FFileHandle.FPosition;
  Result := FFileSystem.Read(FFileHandle, @Buffer, Count);
end;

function TFileSystemStream.Write(const Buffer; Count: Integer): Longint;
begin
  Result := FFileSystem.Write(FFileHandle, @Buffer, Count);
end;

end.