unit uRawFilesystems;
{$INCLUDE 'jedi.inc'}

{$DEFINE SORTEDFILENAMELIST}
  // Support for sorting of the filename's, to facilitate faster filename-based
  // lookups. Sequential searches are performed otherwise.

{$DEFINE NOBUFFERINGSUPPORT}
  // If FILE_FLAG_NO_BUFFERING is used, there are specific requirements on the
  // file operations used.

{$DEFINE RAWFS_SEVENZIP}
  // Use 7-TSevenZipExtractStream to support raw filesystems

interface

{$IFDEF NOBUFFERINGSUPPORT}
  {$MESSAGE HINT 'TODO: Enforce proper alignment'}
  // To get a completely compatible solution, the Read and Seek functions
  // should be rewritten so that:
  // 1. File reads must start at sector boundary.
  //    -> Ignored. It seems 7-zip doesn't use non-aligned reads
  // 2. File reads' size must be a multiple of sector size.
  //    -> Handled, but it destroys the file position (file position will be
  //       different than the caller expects; as far as I can tell, 7-zip
  //       uses unaligned reads only at the end of a file, so it doesn't
  //       matter).
  // 3. Read buffer must be aligned on a sector boundary.
  //    -> Handled.
{$ENDIF}

uses
  Windows, SysUtils, Classes;

type
  IRawFilesystem = interface;

  TRawFilesystemDataReadEvent = procedure(Sender: IRawFilesystem; FileIndex: Cardinal; const Data; DataSize: Cardinal) of object;
  {$IFDEF DELPHI2009_UP}
  TRawFilesystemDataReadProc = reference to procedure(Sender: IRawFilesystem; FileIndex: Cardinal; const Data; DataSize: Cardinal);
  {$ENDIF}

  IRawFilesystem = interface(IUnknown)
    function GetActive: boolean;
    function Open(const FileName: string): boolean;
    function FindFileByName(const FileName: string; out Index: Cardinal; CaseSensitive: boolean = False; GenerateIndex: boolean = True): boolean;
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadEvent; UserData: Pointer = nil): boolean; overload;
    {$IFDEF DELPHI2009_UP}
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadProc; UserData: Pointer = nil): boolean; overload;
    {$ENDIF}
    function ReadFileData(Index: Cardinal; Stream: TStream): boolean; overload;
    procedure Close;
    property Active: boolean read GetActive;
  end;

  TRawFilesystemSupport = class
  public
    class function IsActive: boolean;
    class function Open(const FileName: string; out RawFilesystem: IRawFilesystem): boolean;
  end;

implementation

uses
  uCompatibility,
  {$IFDEF RAWFS_SEVENZIP} SevenZip, {$ENDIF}
  ActiveX;

type
  TRawFilesystem = class(TInterfacedObject, IRawFilesystem)
  protected
    function GetActive: boolean; virtual; abstract;
  public
    function Open(const FileName: string): boolean; virtual; abstract;
    function FindFileByName(const FileName: string; out Index: Cardinal; CaseSensitive: boolean = False; GenerateIndex: boolean = True): boolean; virtual; abstract;
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadEvent; UserData: Pointer = nil): boolean; overload; virtual; abstract;
    {$IFDEF DELPHI2009_UP}
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadProc; UserData: Pointer = nil): boolean; overload; virtual; abstract;
    {$ENDIF}
    function ReadFileData(Index: Cardinal; Stream: TStream): boolean; overload; virtual; abstract;
    procedure Close; virtual; abstract;
    property Active: boolean read GetActive;
  end;

  TRawFilesystemStreamFormat = (fsUnknown, fsNTFS, fsFAT);

  TRawFilesystemStream = class(TInterfacedObject)
  strict private
    fFileName: string;
    fHandle: THandle;
    fSectorSize: integer;
    fFilesystemSize: int64;
    fFilesystemFormat: TRawFilesystemStreamFormat;
    function GetActive: boolean;
    function GetSectorSize: integer;
    function GetFilesystemSize: int64;
  protected
    function GetAlignedMemory(Size, Alignment: Cardinal; out Raw, User: Pointer): boolean;
    function TestFileSystem(Buffer: Pointer; BufferSize: Cardinal; const Signature: AnsiString; SignatureOffset: Cardinal): boolean;
    procedure ReadDiskGeometry;
    property FileName: string read fFileName;
    property Handle: THandle read fHandle;
    property SectorSize: integer read GetSectorSize;
    property FilesystemSize: int64 read GetFilesystemSize;
    property FilesystemFormat: TRawFilesystemStreamFormat read fFilesystemFormat;
  public
    constructor Create;
    destructor Destroy; override;
    function Open(const FileName: string): boolean; virtual;
    procedure Close; virtual;
    property Active: boolean read GetActive;
  end;

{$IFDEF RAWFS_SEVENZIP}
type
  T7zRawFilesystemStream = class(TRawFilesystemStream, IInStream)
  private
    function GetSevenZipID: TGUID;
  public
    property SevenZipID: TGUID read GetSevenZipID;
  public
    function Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
    function Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT; stdcall;
  end;

type
  T7zRawFilesystem = class(TRawFilesystem)
  private
    fArchive: I7zInArchive;
    {$IFDEF SORTEDFILENAMELIST}
    fFileIndices: TStringList;
    {$ENDIF}
    fMoreDataEvent: TRawFilesystemDataReadEvent;
    {$IFDEF DELPHI2009_UP}
    fMoreDataProc: TRawFilesystemDataReadProc;
    {$ENDIF}
  protected
    function GetActive: boolean; override;
    property Archive: I7zInArchive read fArchive;
  public
    constructor Create;
    destructor Destroy; override;
    function Open(const FileName: string): boolean; override;
    function FindFileByName(const FileName: string; out Index: Cardinal; CaseSensitive: boolean = False; GenerateIndex: boolean = True): boolean; override;
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadEvent; UserData: Pointer = nil): boolean; override;
    {$IFDEF DELPHI2009_UP}
    function ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadProc; UserData: Pointer = nil): boolean; override;
    {$ENDIF}
    function ReadFileData(Index: Cardinal; Stream: TStream): boolean; override;
    procedure Close; override;
  end;

  T7zExtractStream = class(TInterfacedObject, ISequentialOutStream)
  private
    fRawFilesystem: IRawFilesystem;
    fFileIndex: Cardinal;
    fMoreDataEvent: TRawFilesystemDataReadEvent;
    {$IFDEF DELPHI2009_UP}
    fMoreDataProc: TRawFilesystemDataReadProc;
    {$ENDIF}
  public
    constructor Create(RawFilesystem: IRawFilesystem; FileIndex: Cardinal);
    function Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT; stdcall;
    property MoreDataEvent: TRawFilesystemDataReadEvent read fMoreDataEvent write fMoreDataEvent;
    {$IFDEF DELPHI2009_UP}
    property MoreDataProc: TRawFilesystemDataReadProc read fMoreDataProc write fMoreDataProc;
    {$ENDIF}
  end;

{ T7zRawFilesystem }

procedure T7zRawFilesystem.Close;
begin
  {$MESSAGE HINT 'Note: Close is extremely slow if run inside Delphi'}
  if Self.fArchive <> nil then
    Self.fArchive.Close;
  Self.fArchive := nil;
  {$IFDEF SORTEDFILENAMELIST}
  FreeAndNil(Self.fFileIndices);
  {$ENDIF}
end;

constructor T7zRawFilesystem.Create;
begin
  inherited Create;
  Self.fArchive := nil;
  {$IFDEF SORTEDFILENAMELIST}
  Self.fFileIndices := nil;
  {$ENDIF}
end;

destructor T7zRawFilesystem.Destroy;
begin
  Close;
  Self.fArchive := nil;
  {$IFDEF SORTEDFILENAMELIST}
  FreeAndNil(Self.fFileIndices);
  {$ENDIF}
  inherited;
end;

function T7zRawFilesystem.FindFileByName(const FileName: string; out Index: Cardinal; CaseSensitive, GenerateIndex: boolean): boolean;
var
  ItemIndex: Integer;
  CurrentFileName: string;
  MatchResult: integer;
begin
  Result := False;
  if not Self.Active then
    Exit;
  {$IFDEF SORTEDFILENAMELIST}
  if (Self.fFileIndices <> nil) and (Self.fFileIndices.CaseSensitive <> CaseSensitive) then
    FreeAndNil(Self.fFileIndices);
  if (Self.fFileIndices = nil) and GenerateIndex then
  begin
    Self.fFileIndices := TStringList.Create;
    Self.fFileIndices.CaseSensitive := CaseSensitive;
    Self.fFileIndices.Duplicates := dupIgnore;
    Self.fFileIndices.Sorted := False;
    for ItemIndex := 0 to Pred(Self.Archive.NumberOfItems) do
    begin
      Self.fFileIndices.AddObject(Self.Archive.ItemPath[ItemIndex], Pointer(ItemIndex));
    end;
    Self.fFileIndices.Sorted := True;
  end;
  if Self.fFileIndices <> nil then
  begin
    if Self.fFileIndices.Find(FileName, ItemIndex) then
    begin
      Index := NativeUInt(fFileIndices.Objects[ItemIndex]);
      Result := True;
    end;
  end
  else
  {$ENDIF}
  begin
    for ItemIndex := 0 to Pred(Self.Archive.NumberOfItems) do
    begin
      CurrentFileName := Self.Archive.ItemPath[ItemIndex];
      if CaseSensitive then
      begin
        MatchResult := AnsiCompareStr(FileName, CurrentFileName);
      end
      else
      begin
        MatchResult := AnsiCompareText(FileName, CurrentFileName);
      end;
      if MatchResult = 0 then begin
        Index := ItemIndex;
        Result := True;
        Break;
      end;
    end;
  end;
end;

function T7zRawFilesystem.GetActive: boolean;
begin
  Result := (Self.Archive <> nil);
end;

function T7zRawFilesystem.Open(const FileName: string): boolean;
var
  Stream: T7zRawFilesystemStream;
  Archive: I7zInArchive;
begin
  Result := False;
  Self.Close;
  Stream := T7zRawFilesystemStream.Create;
  try
    if not Stream.Open(FileName) then
      Exit;
    Archive := CreateInArchive(Stream.SevenZipID);
    Archive.OpenStream(Stream);
    Stream := nil;
    Self.fArchive := Archive;
    Result := True;
  finally
    FreeAndNil(Stream);
  end;
end;

function T7zRawFilesystem.ReadFileData(Index: Cardinal; Stream: TStream): boolean;
begin
  Result := False;
  if not Self.Active then
    Exit;
  if Index >= Self.Archive.NumberOfItems then
    Exit;
  Self.Archive.ExtractItem(Index, Stream, False);
  Result := True;
end;

function GetStreamCallback(sender: Pointer; index: Cardinal; var outStream: ISequentialOutStream): HRESULT; stdcall;
var
  RawFilesystem: T7zRawFilesystem;
  Stream: T7zExtractStream;
begin
  RawFilesystem := T7zRawFilesystem(sender);
  Stream := T7zExtractStream.Create(RawFilesystem, index);
  Stream.MoreDataEvent := RawFilesystem.fMoreDataEvent;
  Stream.MoreDataProc := RawFilesystem.fMoreDataProc;
  outStream := Stream;
  Result := S_OK;
end;

function T7zRawFilesystem.ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadEvent; UserData: Pointer): boolean;
begin
  Result := False;
  if not Self.Active then
    Exit;
  if Index >= Self.Archive.NumberOfItems then
    Exit;
  Self.fMoreDataEvent := OnMoreData;
  Self.fMoreDataProc := nil;
  try
    Self.Archive.ExtractItems(@Index, 1, False, Self, GetStreamCallback);
    Result := True;
  finally
    Self.fMoreDataEvent := nil;
    Self.fMoreDataProc := nil;
  end;
end;

{$IFDEF DELPHI2009_UP}
function T7zRawFilesystem.ReadFileData(Index: Cardinal; OnMoreData: TRawFilesystemDataReadProc; UserData: Pointer = nil): boolean;
begin
  Result := False;
  if not Self.Active then
    Exit;
  if Index >= Self.Archive.NumberOfItems then
    Exit;
  Self.fMoreDataEvent := nil;
  Self.fMoreDataProc := OnMoreData;
  try
    Self.Archive.ExtractItems(@Index, 1, False, Self, GetStreamCallback);
    Result := True;
  finally
    Self.fMoreDataEvent := nil;
    Self.fMoreDataProc := nil;
  end;
end;
{$ENDIF}

{ T7zRawFilesystemStream }

function T7zRawFilesystemStream.GetSevenZipID: TGUID;
begin
  case Self.FilesystemFormat of
    fsUnknown:
      Result := GUID_NULL;
    fsNTFS:
      Result := CLSID_CFormatNtfs;
    fsFAT:
      Result := CLSID_CFormatFat;
    else
      Result := GUID_NULL;
  end;
end;

function T7zRawFilesystemStream.Read(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT;
var
  BytesRead: DWORD;
  {$IFDEF NOBUFFERINGSUPPORT}
  ActualSize: integer;
  ActualData: Pointer;
  RawData: Pointer;
  {$ENDIF}
begin
  Result := E_FAIL;
  if not Self.Active then
  begin
    {$IFDEF DEBUG}
    Writeln(Format('T7zRawFilesystemStream.Read(0x%p, 0x%x) -> NOT ACTIVE', [data, size]));
    {$ENDIF}
    Exit;
  end;
  if size = 0 then
  begin
    if processedSize <> nil then
      processedSize^ := 0;
    Result := S_OK;
    Exit;
  end;
  {$IFDEF NOBUFFERINGSUPPORT}
  RawData := nil;
  try
    ActualSize := size;
    if (ActualSize mod Self.SectorSize) > 0 then
      ActualSize := ActualSize + Self.SectorSize - (ActualSize mod Self.SectorSize);
    if not GetAlignedMemory(ActualSize, Self.SectorSize, RawData, ActualData) then
      Exit;
    if not ReadFile(Self.Handle, ActualData^, ActualSize, BytesRead, nil) then
    begin
      {$IFDEF DEBUG}
      Writeln(Format('T7zRawFilesystemStream.Read(0x%p [0x%p], 0x%x [0x%x]) -> ERROR %d', [data, ActualData, size, ActualSize, GetLastError]));
      {$ENDIF}
      Exit;
    end;
    if BytesRead > size then
    begin
      BytesRead := size;
    end;
    Move(ActualData^, data^, BytesRead);
  finally
    if RawData <> nil then
      FreeMem(RawData);
    RawData := nil;
    ActualData := nil;
  end;
  {$ELSE}
  if not ReadFile(Self.Handle, data^, size, BytesRead, nil) then
    Exit;
  {$ENDIF}
  if processedSize <> nil then
    processedSize^ := BytesRead;
  Result := S_OK;
end;

function T7zRawFilesystemStream.Seek(offset: Int64; seekOrigin: Cardinal; newPosition: PInt64): HRESULT;
var
  Ofs: TULargeInteger;
begin
  Result := E_FAIL;
  if not Self.Active then
  begin
    {$IFDEF DEBUG}
    Writeln(Format('T7zRawFilesystemStream.Seek(0x%x, %d) -> NOT ACTIVE', [offset, seekOrigin]));
    {$ENDIF}
    Exit;
  end;
  if (seekOrigin = FILE_END) and (offset = 0) then
  begin
    if newPosition <> nil then
      newPosition^ := Self.FilesystemSize;
    Result := S_OK;
    Exit;
  end;
  Ofs.QuadPart := offset;
  Ofs.LowPart := SetFilePointer(Self.Handle, Ofs.LowPart, @Ofs.HighPart, seekOrigin);
  if GetLastError <> ERROR_SUCCESS then
  begin
    {$IFDEF DEBUG}
    Writeln(Format('T7zRawFilesystemStream.Seek(0x%x, %d) -> ERROR %d', [offset, seekOrigin, GetLastError]));
    {$ENDIF}
    Exit;
  end;
  if newPosition <> nil then
    newPosition^ := Ofs.QuadPart;
  Result := S_OK;
end;

{ T7zExtractStream }

constructor T7zExtractStream.Create(RawFilesystem: IRawFilesystem; FileIndex: Cardinal);
begin
  inherited Create;
  Self.fRawFilesystem := RawFilesystem;
  Self.fFileIndex := FileIndex;
end;

function T7zExtractStream.Write(data: Pointer; size: Cardinal; processedSize: PCardinal): HRESULT;
begin
  if (data = nil) or (size = 0) then
  begin
    size := 0;
  end
  else
  begin
    if Assigned(Self.fMoreDataEvent) then
    begin
      Self.fMoreDataEvent(Self.fRawFilesystem, Self.fFileIndex, data^, size);
    end;
    {$IFDEF DELPHI2009_UP}
    if Assigned(Self.fMoreDataProc) then
    begin
      Self.fMoreDataProc(Self.fRawFilesystem, Self.fFileIndex, data^, size);
    end;
    {$ENDIF}
  end;
  if processedSize <> nil then
    processedSize^ := size;
  Result := S_OK;
end;
{$ENDIF}

{ TRawFilesystemSupport }

class function TRawFilesystemSupport.IsActive: boolean;
begin
  Result := False
    {$IFDEF RAWFS_SEVENZIP}
    or SevenZip.IsLibraryActive
    {$ENDIF}
    ;
end;

class function TRawFilesystemSupport.Open(const FileName: string; out RawFilesystem: IRawFilesystem): boolean;
begin
  Result := False;
  RawFilesystem := nil;
  if IsActive then begin
    try
      {$IFDEF RAWFS_SEVENZIP}
      if (not Result) and SevenZip.IsLibraryActive then
      begin
        RawFilesystem := T7zRawFilesystem.Create;
        Result := RawFilesystem.Open(FileName);
      end;
      {$ENDIF}
    finally
      if not Result then
        RawFilesystem := nil;
    end;
  end;
end;

{ TRawFilesystemStream }

procedure TRawFilesystemStream.Close;
begin
  Self.fFileName := '';
  Self.fSectorSize := -1;
  Self.fFilesystemSize := -1;
  Self.fFilesystemFormat := fsUnknown;
  if Self.fHandle <> INVALID_HANDLE_VALUE then
  begin
    CloseHandle(Self.fHandle);
    Self.fHandle := INVALID_HANDLE_VALUE;
  end;
end;

constructor TRawFilesystemStream.Create;
begin
  inherited Create;
  Self.fHandle := INVALID_HANDLE_VALUE;
  Self.Close;
end;

destructor TRawFilesystemStream.Destroy;
begin
  Self.Close;
  inherited;
end;

function TRawFilesystemStream.GetActive: boolean;
begin
  Result := (Self.fHandle <> INVALID_HANDLE_VALUE);
end;

function TRawFilesystemStream.GetAlignedMemory(Size, Alignment: Cardinal; out Raw, User: Pointer): boolean;
begin
  Result := False;
  Raw := AllocMem(Size + Alignment);
  if Raw = nil then
    Exit;
  User := Pointer(NativeUInt(Raw) + (Alignment - (NativeUInt(Raw) mod Alignment)));
  Result := True;
end;

function TRawFilesystemStream.GetFilesystemSize: int64;
begin
  if not Self.Active then
  begin
    Result := 0;
    Exit;
  end;
  if Self.fFilesystemSize < 0 then
  begin
    Self.ReadDiskGeometry;
  end;
  Result := Self.fFilesystemSize;
end;

function TRawFilesystemStream.GetSectorSize: integer;
begin
  if not Self.Active then
  begin
    Result := 0;
    Exit;
  end;
  if Self.fSectorSize < 0 then
  begin
    Self.ReadDiskGeometry;
  end;
  Result := Self.fSectorSize;
end;

function TRawFilesystemStream.Open(const FileName: string): boolean;
const
  INITIAL_SECTORS_SIZE = 16384;
var
  {$IFDEF NOBUFFERINGSUPPORT}
  AllocatedSector: Pointer;
  Sector: PByteArray;
  {$ELSE}
  Sector: packed array[0..INITIAL_SECTORS_SIZE-1] of byte;
  {$ENDIF}
  BytesRead: DWORD;
begin
  Result := False;
  Self.Close;
  try
    Self.fHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, 0);
    if Self.fHandle = INVALID_HANDLE_VALUE then
      Exit;
    {$IFDEF NOBUFFERINGSUPPORT}
    if not GetAlignedMemory(INITIAL_SECTORS_SIZE, INITIAL_SECTORS_SIZE, AllocatedSector, Pointer(Sector)) then
      Exit;
    try
    {$ENDIF}
    // Read the first sector and try to identify the filesystem
    if not ReadFile(Self.fHandle, Sector[0], INITIAL_SECTORS_SIZE, BytesRead, nil) then
      Exit;
    if TestFileSystem(@Sector[0], BytesRead, 'MSDOS5.0', 3) then
      Self.fFilesystemFormat := fsFAT
    else if TestFileSystem(@Sector[0], BytesRead, 'NTFS    ', 3) then
      Self.fFilesystemFormat := fsNTFS
    else
      Exit;
    SetFilePointer(Self.fHandle, 0, nil, FILE_BEGIN);
    if GetLastError <> ERROR_SUCCESS then
      Exit;
    // Done, it's a known raw device stream
    Self.fFileName := FileName;
    Result := True;
    {$IFDEF NOBUFFERINGSUPPORT}
    finally
      FreeMem(AllocatedSector);
      AllocatedSector := nil;
      Sector := nil;
    end;
    {$ENDIF}
  finally
    if not Result then
      Self.Close;
  end;
end;

procedure TRawFilesystemStream.ReadDiskGeometry;
var
  SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters: DWORD;
begin
  if not Self.Active then
    Exit;
  if not GetDiskFreeSpace(PChar(Self.FileName + '\'), SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters) then
    Exit;
  Self.fSectorSize := BytesPerSector;
  Self.fFilesystemSize := Int64(BytesPerSector) * Int64(TotalNumberOfClusters) * Int64(SectorsPerCluster);
end;

function TRawFilesystemStream.TestFileSystem(Buffer: Pointer; BufferSize: Cardinal; const Signature: AnsiString; SignatureOffset: Cardinal): boolean;
var
  SignatureLen: Cardinal;
begin
  Result := False;
  SignatureLen := Length(Signature);
  if SignatureLen > 0 then
    if BufferSize >= (SignatureOffset + SignatureLen) then
      if (SignatureOffset + SignatureLen) > SignatureOffset then // Prevent overflows!
        if CompareMem(Pointer(NativeUInt(Buffer) + SignatureOffset), @Signature[1], SignatureLen) then
          Result := True;
end;

end.
