unit Observer;
{.$DEFINE LOG}

interface

uses
  Windows, SysUtils, InnoSetupFile, ModuleDef;

const
  VERSION_MAJOR = 0;
  VERSION_MINOR = 1;

const
  INNOUNP_MODULE_ID: TGUID = '{c69cfbd5-8d41-4c14-bd21-ff1810b18af1}';

function LoadSubModule(var Params: TModuleLoadParameters): boolean; stdcall;
procedure UnloadSubModule; stdcall;

implementation

{$IFDEF LOG}
const LOG_FILENAME = 'D:\tmp\innounp\innounp_observer.log';

procedure Log(const Msg: string); overload;
var
  T: TextFile;
begin
  try
    AssignFile(T, LOG_FILENAME);
    if FileExists(LOG_FILENAME) then
      Append(T)
    else
      Rewrite(T);
    try
      Writeln(T, Msg);
    finally
      CloseFile(T);
    end;
  except
    end;
end;

procedure Log(const Msg: string; const Params: array of const); overload;
begin
  try
    Log(Format(Msg, Params));
  except
    Log(Msg);
  end;
end;
{$ENDIF}

type
  TInnoSetupFileEx = class(TInnoSetupFile)
  private
    fCallbacks: TExtractProcessCallbacks;
  protected
    procedure ExtractorProgressProc(Bytes: int64); override;
  public
    procedure Clear; override;
    procedure SetCallbacks(const Callbacks: TExtractProcessCallbacks);
  end;

{ TInnoSetupFileEx }

procedure TInnoSetupFileEx.Clear;
begin
  inherited;
  FillChar(fCallbacks, Sizeof(fCallbacks), 0);
end;

procedure TInnoSetupFileEx.ExtractorProgressProc(Bytes: int64);
begin
  inherited;
  if Assigned(fCallbacks.FileProgress) then
  begin
    fCallbacks.FileProgress(fCallbacks.signalContext, Bytes);
  end;
end;

procedure TInnoSetupFileEx.SetCallbacks(const Callbacks: TExtractProcessCallbacks);
begin
  Move(Callbacks, fCallbacks, Sizeof(fCallbacks));
end;

{$IFNDEF UNICODE}
function StrPLCopy(Dest: PWideChar; const Source: string; MaxLen: Cardinal): PWideChar;
var
  n: integer;
  WS: WideString;
begin
  n := Length(Source);
  if n > MaxLen then
    n := MaxLen;
  WS := WideString(Source);
  FillChar(Dest^, (n+1)*Sizeof(WS[1]), 0);
  Move(WS[1], Dest^, n*Sizeof(WS[1]));
  Result := Dest;
end;
{$ENDIF}

function OpenStorage(Params: TStorageOpenParams; var Handle: THandle; var Info: TStorageGeneralInfo): TOpenStorageResult; stdcall;
var
  {
  p: ^Byte;
  s: string;
  i: integer;
  }
  Inno: TInnoSetupFileEx;
begin
  {$IFDEF LOG} Log('OpenStorage START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- StructSize: %u', [Params.StructSize]); {$ENDIF}
    if Params.StructSize <> Sizeof(Params) then
    begin
      {$IFDEF LOG} Log('OpenStorage ERROR: Unexpected StructSize, should be %d', [Sizeof(Params)]); {$ENDIF}
      Result := SOR_INVALID_FILE;
      Exit;
    end;
    {$IFDEF LOG} Log('- File: %s', [string(Params.FilePath)]); {$ENDIF}
    {$IFDEF LOG} Log('- Password: %s', [string(AnsiString(Params.Password))]); {$ENDIF}
    {$IFDEF LOG}
    {
      s := '';
      p := Params.Data;
      for i := 1 to Params.DataSize do begin
        s := s + Format(' %02.2x', [p^]);
        Inc(p);
      end;
      Log('- Data: %s', [s]);
    }
    {$ENDIF}
    Inno := TInnoSetupFileEx.Create;
    try
      Inno.InteractiveMode := False;
      Inno.QuietExtract := True;
      Inno.SetupFileName := string(Params.FilePath);
      Inno.Password := string(AnsiString(Params.Password));
      Inno.ExtractEmbedded := True;
      Inno.ExtractAllCopies := True;
      Inno.AttemptUnpackUnknown := True;
      Inno.Open;
      {$IFDEF LOG} Log('- Successfully opened: %s', [Inno.SetupFileName]); {$ENDIF}
      {$IFDEF LOG} Log('- %d (%d) files, %d encrypted', [Inno.FileCount, Inno.TotalFiles, Inno.TotalEncryptedFiles]); {$ENDIF}
      if (Inno.TotalEncryptedFiles > 0) and (Inno.Password = '') then begin
        {$IFDEF LOG} Log('- Archive is password-protected'); {$ENDIF}
        //Result := SOR_PASSWORD_REQUIRED;
      end;
      //else
      begin
        Handle := THandle(Inno);
        StrPLCopy(Info.Format, 'InnoSetup', High(Info.Format));
        StrPLCopy(Info.Compression, Inno.CompressionMethod, High(Info.Compression));
        StrPLCopy(Info.Comment, '', High(Info.Comment));
        FillChar(Info.Created, Sizeof(Info.Created), 0);
        {$IFDEF LOG} Log('- Filled in output data'); {$ENDIF}
        {$IFDEF LOG} Log('- Handle: 0x%x', [Handle]); {$ENDIF}
        Result := SOR_SUCCESS;
        Inno := nil;
      end;
    finally
      FreeAndNil(Inno);
    end;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('OpenStorage ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
      Result := SOR_INVALID_FILE;
    end;
  end;
  {$IFDEF LOG} finally Log('OpenStorage END'); Log('-> Result = %d', [Integer(Result)]); end; {$ENDIF}
end;

procedure CloseStorage(Handle: THandle); stdcall;
begin
  {$IFDEF LOG} Log('CloseStorage START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- Handle: 0x%x', [Handle]); {$ENDIF}
    TInnoSetupFileEx(Handle).Free;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('CloseStorage ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
    end;
  end;
  {$IFDEF LOG} finally Log('CloseStorage END'); end; {$ENDIF}
end;

function PrepareFiles(Handle: THandle): boolean; stdcall;
begin
  {$IFDEF LOG} Log('PrepareFiles START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- Handle: 0x%x', [Handle]); {$ENDIF}
    Result := True;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('PrepareFiles ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
      Result := False;
    end;
  end;
  {$IFDEF LOG} finally Log('PrepareFiles END'); Log('-> Result = %d', [Integer(Result)]); end; {$ENDIF}
end;

function GetItem(Handle: THandle; ItemIndex: integer; var Info: TStorageItemInfo): TGetItemResult; stdcall;
var
  Inno: TInnoSetupFileEx;
  FileInfo: TFileInfo;
  SystemTime: TSystemTime;
begin
  {$IFDEF LOG} Log('GetItem START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- Handle: 0x%x', [Handle]); {$ENDIF}
    {$IFDEF LOG} Log('- ItemIndex: %d', [ItemIndex]); {$ENDIF}
    Inno := TInnoSetupFileEx(Handle);
    if (ItemIndex < 0) or (ItemIndex >= Inno.ValidFileCount) then begin
      {$IFDEF LOG} Log('- No more files'); {$ENDIF}
      Result := GET_ITEM_NOMOREITEMS;
    end
    else begin
      FillChar(Info, Sizeof(Info), 0);
      FileInfo := Inno.ValidFiles[ItemIndex];
      {$IFDEF LOG} Log('- Found file entry'); {$ENDIF}
      Info.Size := FileInfo.Size;
      {$IFDEF LOG} Log('- Saved size: %d', [Info.Size]); {$ENDIF}
      Info.PackedSize := Info.Size;
      Info.Attributes := FileInfo.Attr;
      {$IFDEF LOG} Log('- Saved attributes: 0x%x', [Info.Attributes]); {$ENDIF}
      {$IFDEF LOG} Log('- Converting file date: %s', [DateTimeToStr(FileInfo.Date)]); {$ENDIF}
      DateTimeToSystemTime(FileInfo.Date, SystemTime);
      {$IFDEF LOG} Log('- Converted to SystemTime'); {$ENDIF}
      SystemTimeToFileTime(SystemTime, Info.CreationTime);
      {$IFDEF LOG} Log('- Converted to FileTime'); {$ENDIF}
      Info.ModificationTime := Info.CreationTime;
      Info.NumHardlinks := 1;
      {$IFDEF LOG} Log('- Saving filename: %s', [FileInfo.FileName]); {$ENDIF}
      StrPLCopy(Info.Path, FileInfo.FileName, High(Info.Path));
      {$IFDEF LOG} Log('- Saved filename: %s', [string(Info.Path)]); {$ENDIF}
      {$IFDEF LOG} Log('- Done'); {$ENDIF}
      Result := GET_ITEM_OK;
    end;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('GetItem ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
      Result := GET_ITEM_ERROR;
    end;
  end;
  {$IFDEF LOG} finally Log('GetItem END'); Log('-> Result = %d', [Integer(Result)]); end; {$ENDIF}
end;

function ExtractItem(Handle: THandle; Params: TExtractOperationParams): TExtractResult; stdcall;
var
  Inno: TInnoSetupFileEx;
  Password: string;
begin
  {$IFDEF LOG} Log('ExtractItem START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- Handle: 0x%x', [Handle]); {$ENDIF}
    {$IFDEF LOG} Log('- ItemIndex: %d', [Params.Item]); {$ENDIF}
    {$IFDEF LOG} Log('- Flags: 0x%x', [Params.Flags]); {$ENDIF}
    {$IFDEF LOG} Log('- Detination filename: %s', [string(Params.DestPath)]); {$ENDIF}
    Inno := TInnoSetupFileEx(Handle);
    Inno.SetCallbacks(Params.Callbacks);
    Password := {$IFDEF UNICODE} string {$ENDIF} (AnsiString(Params.Password));
    if Password <> '' then
      Inno.Password := Password;
        // Password is only sent once from Observer
    if (Params.ItemIndex < 0) or (Params.ItemIndex >= Inno.ValidFileCount) then begin
      {$IFDEF LOG} Log('- No more files'); {$ENDIF}
      Result := SER_ERROR_READ;
    end
    else if (fifEncrypted in Inno.Files[Params.ItemIndex].Flags) and (Inno.Password = '') then
    begin
      Result := SER_PASSWORD_REQUIRED;
    end
    else begin
      try
        {$IFDEF LOG} Log('- Trying to extract'); {$ENDIF}
        Inno.ExtractValidFile(string(Params.DestPath), [efAssumeYes], Params.ItemIndex);
        {$IFDEF LOG} Log('- Extraction successful'); {$ENDIF}
        Result := SER_SUCCESS;
      except
        on E: Exception do begin
          {$IFDEF LOG} Log('ExtractItem ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
          if Inno.AbortInitCode = aicWrongPassword then
            Result := SER_PASSWORD_REQUIRED
          else
            Result := SER_ERROR_WRITE;
        end;
      end;
    end;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('ExtractItem ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
      Result := SER_ERROR_SYSTEM;
    end;
  end;
  {$IFDEF LOG} finally Log('ExtractItem END'); Log('-> Result = %d', [Integer(Result)]); end; {$ENDIF}
end;

function LoadSubModule(var Params: TModuleLoadParameters): boolean; stdcall;
{$IFDEF LOG}
var
  P: PWideChar;
{$ENDIF}
begin
  {$IFDEF LOG} Log('LoadSubModule START'); try {$ENDIF}
  try
    {$IFDEF LOG} Log('- StructSize: %u', [Params.StructSize]); {$ENDIF}
    if Params.StructSize <> Sizeof(Params) then
    begin
      {$IFDEF LOG} Log('LoadSubModule ERROR: Unexpected StructSize, should be %d', [Sizeof(Params)]); {$ENDIF}
      Result := False;
      Exit;
    end;
    {$IFDEF LOG}
    P := Params.Settings;
    if P <> nil then
      while P^ <> #0 do begin
        {$IFDEF LOG} Log('- Settings: %s', [string(P)]); {$ENDIF}
        P := StrEnd(P);
        Inc(P);
      end;
    {$ENDIF}
    Params.ModuleID := INNOUNP_MODULE_ID;
    {$IFDEF LOG} Log('- ModuleID: {%s}', [GenerateUuid(Params.ModuleID)]); {$ENDIF}
    Params.ModuleVersion := MakeModuleVersion(VERSION_MAJOR, VERSION_MINOR);
    {$IFDEF LOG} Log('- ModuleVersion: 0x%x', [Params.ModuleVersion]); {$ENDIF}
    Params.ApiVersion := ACTUAL_API_VERSION;
    {$IFDEF LOG} Log('- ApiVersion: 0x%x', [Params.ApiVersion]); {$ENDIF}
    Params.ApiFuncs.OpenStorage := @OpenStorage;
    {$IFDEF LOG} Log('- OpenStorage: 0x%p', [@Params.ApiFuncs.OpenStorage]); {$ENDIF}
    Params.ApiFuncs.CloseStorage := @CloseStorage;
    {$IFDEF LOG} Log('- CloseStorage: 0x%p', [@Params.ApiFuncs.CloseStorage]); {$ENDIF}
    Params.ApiFuncs.PrepareFiles := @PrepareFiles;
    {$IFDEF LOG} Log('- PrepareFiles: 0x%p', [@Params.ApiFuncs.PrepareFiles]); {$ENDIF}
    Params.ApiFuncs.GetItem := @GetItem;
    {$IFDEF LOG} Log('- GetItem: 0x%p', [@Params.ApiFuncs.GetItem]); {$ENDIF}
    Params.ApiFuncs.ExtractItem := @ExtractItem;
    {$IFDEF LOG} Log('- ExtractItem: 0x%p', [@Params.ApiFuncs.ExtractItem]); {$ENDIF}
    Result := True;
  except
    on E: Exception do begin
      {$IFDEF LOG} Log('LoadSubModule ERROR %s: %s', [E.ClassName, E.Message]); {$ENDIF}
      Result := False;
    end;
  end;
  {$IFDEF LOG} finally Log('LoadSubModule END'); end; {$ENDIF}
end;

procedure UnloadSubModule; stdcall;
begin
  {$IFDEF LOG} Log('UnloadSubModule START'); try {$ENDIF}
  {$IFDEF LOG} finally Log('UnloadSubModule END'); end; {$ENDIF}
end;

initialization
  {$IFDEF LOG}
  if FileExists(LOG_FILENAME) then
    DeleteFile(LOG_FILENAME);
  {$ENDIF}

end.
