virtualfilesystem/uvfsZipArchive.pas

unit uvfsZipArchive;

interface

uses
  SysUtils, Classes, uvfsManager, KAZip, syncobjs;

type

  { TvfsZipArchive }

  TvfsZipArchive = class(TvfsProvider)
  private
    FZipActionCS: TCriticalSection;
    FZipper: TKAZip;
    procedure Flush(Handle: TvfsStreamHandleWrite; Data: Pointer; DataSize: integer);
    function PrepareFilename(const aFilename: String): String;
  public
    constructor Create(const FileSpec:string; const ExtendedData: string=''); override;
    destructor Destroy; override;
    class function StorageName: string; override;
    function StorageGetFileSpec: string; override;
    function GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): Boolean; override;
    function Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean; override;
    function Rename(const OldName, NewName: string): boolean; override;
    function Delete(const aName: String): boolean; override;
    procedure DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean); override;

    function ZipFilename: string;
  end;

implementation

{ TvfsZipArchive }

constructor TvfsZipArchive.Create(const FileSpec: string; const ExtendedData: string);
var
  path: String;
  dir: String;
begin
  inherited;
  FZipActionCS := TCriticalSection.Create;
  FZipper:= TKAZip.Create(nil);
  path := vfsSystemPathDelim(FileSpec);
  if not FileExists(path) then begin
    dir := ExtractFilePath(path);
    if (dir <> '') then
    	ForceDirectories(dir);
    FZipper.CreateZip(path);
  end;
  FZipper.Open(path);
  FZipper.CompressionType:= ctNone;
end;

destructor TvfsZipArchive.Destroy;
begin
  if Assigned(FZipper) then begin
    FZipActionCS.Acquire;
    try
      FreeAndNil(FZipper);
    finally
      FZipActionCS.Release;
    end;
  end;
  FreeAndNil(FZipActionCS);
  inherited;
end;

class function TvfsZipArchive.StorageName: string;
begin
  Result:= 'zip';
end;

function TvfsZipArchive.StorageGetFileSpec: string;
begin
  Result:= Self.ZipFileName;
end;

procedure TvfsZipArchive.DirectoryIndex(AddFunction: TvfsDirectoryAddFunc; List: TvfsDirectoryList; Path: string; Subdirs: boolean);
var
  i: integer;
  a: TvfsDirectoryEntry;
  e: TKAZipEntriesEntry;
  fp: string;
  dirOk: boolean;
begin
  FZipActionCS.Acquire;
  try
    for i:= 0 to FZipper.Entries.Count-1 do begin
      e:= FZipper.Entries.Items[i];
      fp:= FZipper.GetFilePath(e.FileName);
      if Subdirs then
        dirOk:= 0=AnsiCompareStr(Path, Copy(fp, 1, Length(Path)))
      else
        dirOk:= 0=AnsiCompareFileName(Path, fp);
      if dirOk then begin
        a:= TvfsDirectoryEntry.Create;
        a.FileInfo.Size:= e.SizeUncompressed;
        a.FileInfo.Attributes:= e.Attributes;
        a.FileInfo.ModDate:= e.Date;
        AddFunction(fp+FZipper.GetFileName(e.FileName), a, List);
      end;
    end;
  finally
    FZipActionCS.Release;
  end;
end;

function TvfsZipArchive.GetFileInfo(const FileName: string; out FileInfo: TvfsFileInfo): Boolean;
var
  i:integer;
begin
  FZipActionCS.Acquire;
  try
    i:= FZipper.Entries.IndexOf(PrepareFilename(vfsSystemPathDelim(FileName)));
    Result:= i>=0;
    if Result then begin
      FileInfo.Size:= FZipper.Entries.Items[i].SizeUncompressed;
      FileInfo.Attributes:= FZipper.Entries.Items[i].Attributes;
      FileInfo.ModDate:= FZipper.Entries.Items[i].Date;
    end;
  finally
    FZipActionCS.Release;
  end;
end;

function TvfsZipArchive.Open(const FileName: string; const OpenMode: TvfsFileOpenMode; out Stream: IStreamHandle): boolean;
var
  ms: TMemoryStream;
  eid: Integer;
begin
  ms:= nil;
  Stream:= nil;
  Result:= false;
  try
    FZipActionCS.Acquire;
    try
      eid:= FZipper.Entries.IndexOf(PrepareFilename(vfsSystemPathDelim(FileName)));

      if (eid>=0) and (OpenMode<>omCreateAlways) then begin
        ms:= TMemoryStream.Create;
        FZipper.Entries.Items[eid].ExtractToStream(ms);
      end;
    finally
      FZipActionCS.Release;
    end;

    case OpenMode of
      omReadOnly: if Assigned(ms) then begin
        ms.Position:= 0;
        Stream:= TvfsStreamHandleRead.Create(ms);
      end;
      omReadWrite: if Assigned(ms) then begin
        ms.Position:= ms.Size;
        Stream:= TvfsStreamHandleWrite.Create(ms, @Self.Flush, PChar(FileName), 1+strlen(PChar(FileName)));
      end;
      omReadWriteCreate: begin
        if not Assigned(ms) then
          ms:= TMemoryStream.Create;
        ms.Position:= ms.Size;
        Stream:= TvfsStreamHandleWrite.Create(ms, @Self.Flush, PChar(FileName), 1+strlen(PChar(FileName)));
      end;
      omCreateAlways: begin
        ms:= TMemoryStream.Create;
        Stream:= TvfsStreamHandleWrite.Create(ms, @Self.Flush, PChar(FileName), 1+strlen(PChar(FileName)));
      end;
    end;
    Result:= Assigned(Stream);
    if not Result then
      FreeAndNil(ms);
  except
    FreeAndNil(ms);
    raise;
  end;
end;

function TvfsZipArchive.Rename(const OldName, NewName: string): boolean;
begin
  FZipActionCS.Acquire;
  try
    if FZipper.Entries.IndexOf(OldName)>=0 then
      FZipper.Rename(OldName, NewName)
    else
      FZipper.RenameFolder(OldName, NewName);
  finally
    FZipActionCS.Release;
  end;
  Result:= true;
end;

function TvfsZipArchive.Delete(const aName: String): boolean;
begin
  //TODO: delete file from zip
  Result:= false;
  raise Exception.Create('not yet implemented');
end;

procedure TvfsZipArchive.Flush(Handle: TvfsStreamHandleWrite; Data: Pointer; DataSize: integer);
var s:string;
begin
  s:= StrPas(Data);
  Handle.GetStream.Position:= 0;
  FZipActionCS.Acquire;
  try
    FZipper.AddStream(s, Handle.GetStream);
  finally
    FZipActionCS.Release;
  end;
end;

function TvfsZipArchive.PrepareFilename(const aFilename: String): String;
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Delimiter       := PathDelim;
    sl.StrictDelimiter := true;
    sl.DelimitedText   := aFilename;
    i := 0;
    while (i < sl.Count) do begin
      if (sl[i] = '..') and (i > 0) then begin
        sl.Delete(i);
        dec(i);
        sl.Delete(i);
      end else
        inc(i);
    end;
    result := sl.DelimitedText;
  finally
    FreeAndNil(sl);
  end;
end;

function TvfsZipArchive.ZipFilename: string;
begin
  Result:= FZipper.FileName;
end;

initialization
  vfsManager.RegisterProvider(TvfsZipArchive);
end.