unit MyTypes;

{.$DEFINE WIN64_DEBUG_INFO}

interface

uses Windows, SysUtils, Int64Em, MD5, SHA1, SHA256;

type
  TBinaryDataInternal = AnsiString;
  TBinaryData = type TBinaryDataInternal;
  TTextDataInternal = {$IFDEF UNICODE} UnicodeString {$ELSE} WideString {$ENDIF} ;
  TTextData = type TTextDataInternal;

////// in general extraction units these types are given their original
////// names as aliases, e.g. type TSetupHeader = TMySetupHeader
////// in verXXXX units this is not done to avoid conflicts
type
  TMySetupVersionData = packed record // same as in all IS versions
    WinVersion, NTVersion: Cardinal;
    NTServicePack: Word;
  end;

  TMySetupLdrOffsetTable = record // in-memory only
    ID: TBinaryData; //array[1..12] of Char;
    Version: LongWord;
    TotalSize, OffsetEXE: Int64;
    CompressedSizeEXE, UncompressedSizeEXE: Int64;
    CRCEXE: Int32;
    Offset0, Offset1: Int64;
    TableCRC: Int32;  { CRC of all prior fields in this record }
    TableCRCUsed: boolean;
  end;

  TSetupCompressMethod = (cmStored, cmZip, cmBzip, cmLZMA, cmLZMA2);
  TSetupSalt = array[0..7] of Byte;
  TSetupKDFSalt = array[0..15] of Byte;
  TSetupEncryptionKey = array[0..31] of Byte;
  TSetupEncryptionNonceRemainingRandom = array[0..2] of Int32;
  TSetupEncryptionNonce = record
    RandomXorStartOffset: Int64;
    RandomXorFirstSlice: Int32;
    RemainingRandom: TSetupEncryptionNonceRemainingRandom;
  end;
  TMySetupProcessorArchitecture = (paUnknown, paX86, paAMD64, paIA64);
  TMySetupProcessorArchitectures = set of TMySetupProcessorArchitecture;
  TMySetupUninstallLogMode = (lmAppend, lmNew, lmOverwrite);
  TMySetupDirExistsWarning = (ddAuto, ddNo, ddYes);
  TMySetupPrivileges = (prNone, prPowerUser, prAdmin, prLowest);
  TMySetupPrivilegesRequiredOverride = (proCommandLine, proDialog);
  TMySetupPrivilegesRequiredOverrides = set of TMySetupPrivilegesRequiredOverride;
  TMySetupShowLanguageDialog = (slYes, slNo, slAuto);
  TMySetupDisablePage = (dpAuto, dpNo, dpYes);
  TMySetupLanguageDetectionMethod = (ldUILanguage, ldLocale, ldNone);

  TFileHashType = (htAdler, htCRC32, htMD5, htSHA1, htSHA256);

  TSetupHash = record
    HashType: TFileHashType;
    case TFileHashType of
      htMD5:  (MD5: TMD5Digest);
      htSHA1: (SHA1: TSHA1Digest);
      htSHA256: (SHA256: TSHA256Digest); // not used
  end;

  TIs64Encryption = record
    PasswordTest: Integer;
    EncryptionKDFSalt: TSetupKDFSalt;
    EncryptionKDFIterations: Integer;
    EncryptionBaseNonce: TSetupEncryptionNonce;
  end;

  TMySetupEncryptionHeaderEncryptionUse = (euNone, euFiles, euFull);
  { Should not contain strings }
  TMySetupEncryptionHeader = packed record
    EncryptionUse: TMySetupEncryptionHeaderEncryptionUse;
    KDFSalt: TSetupKDFSalt;
    KDFIterations: Integer;
    BaseNonce: TSetupEncryptionNonce;
    PasswordTest: Integer;
  end;

  TMySetupHeaderOption = (shDisableStartupPrompt, shUninstallable, shCreateAppDir,
    shAllowNoIcons, shAlwaysRestart, shAlwaysUsePersonalGroup,
    shWindowVisible, shWindowShowCaption, shWindowResizable,
    shWindowStartMaximized, shEnableDirDoesntExistWarning,
    shPassword, shAllowRootDirectory, shDisableFinishedPage,
    shChangesAssociations, shUsePreviousAppDir,
    shBackColorHorizontal, shUsePreviousGroup, shUpdateUninstallLogAppName,
    shUsePreviousSetupType, shDisableReadyMemo, shAlwaysShowComponentsList,
    shFlatComponentsList, shShowComponentSizes, shUsePreviousTasks,
    shDisableReadyPage, shAlwaysShowDirOnReadyPage, shAlwaysShowGroupOnReadyPage,
    shAllowUNCPath, shUserInfoPage, shUsePreviousUserInfo,
    shUninstallRestartComputer, shRestartIfNeededByRun, shShowTasksTreeLines,
    shAllowCancelDuringInstall, shWizardImageStretch, shAppendDefaultDirName,
    shAppendDefaultGroupName, shEncryptionUsed, shChangesEnvironment,
    shShowUndisplayableLanguages,shSetupLogging,
    shSignedUninstaller, shUsePreviousLanguage, shDisableWelcomePage,
    shCloseApplications, shRestartApplications, shAllowNetworkDrive,
    shForceCloseApplications, shAppNameHasConsts, shUsePreviousPrivileges,
    shWizardResizable, shUninstallLogging, shWizardModern, shWizardBorderStyled,
    shWizardKeepAspectRatio, shWizardLightButtonsUnstyled,
    shRedirectionGuard, shWizardBevelsHidden{,shUnusedPadding});
  const MySetupHeaderOptionLast = ord(High(TMySetupHeaderOption));
  type TMySetupHeaderOptions = set of TMySetupHeaderOption;  

  TMySetupWizardStyle = (wsClassic, wsModern);
  TMySetupWizardDarkStyle = (wdsLight, wdsDark, wdsDynamic);

  TMySetupHeader = record // in-memory only
    AppName, AppVerName, AppId, AppCopyright, AppPublisher, AppPublisherURL,
      AppSupportPhone, AppSupportURL, AppUpdatesURL, AppVersion, DefaultDirName,
      DefaultGroupName, BaseFileName, UninstallFilesDir, UninstallDisplayName,
      UninstallDisplayIcon, AppMutex, DefaultUserInfoName, DefaultUserInfoOrg,
      DefaultUserInfoSerial, AppReadmeFile, AppContact, AppComments,
      AppModifyPath, CreateUninstallRegKey, Uninstallable, CloseApplicationsFilter,
      SetupMutex, ChangesEnvironment, ChangesAssociations,
	  ArchitecturesAllowed, ArchitecturesInstallIn64BitMode: TTextData;
    LicenseText, InfoBeforeText, InfoAfterText, CompiledCodeText: TBinaryData;
    NumLanguageEntries, NumCustomMessageEntries, NumPermissionEntries,
      NumTypeEntries, NumComponentEntries, NumTaskEntries, NumDirEntries,
      NumISSigKeyEntries, NumFileEntries, NumFileLocationEntries, NumIconEntries, NumIniEntries,
      NumRegistryEntries, NumInstallDeleteEntries, NumUninstallDeleteEntries,
      NumRunEntries, NumUninstallRunEntries: Integer;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    BackColor, BackColor2: Longint;
    WizardStyle: TMySetupWizardStyle;
    WizardDarkStyle: TMySetupWizardDarkStyle;
    EncryptionUsed: Boolean;
    PasswordHash: TSetupHash;
    PasswordSalt: TSetupSalt;
    Is64Encryption : TIs64Encryption;
    ExtraDiskSpaceRequired: Int64;
    SlicesPerDisk: Integer;
    UninstallLogMode: TMySetupUninstallLogMode;
    DirExistsWarning: TMySetupDirExistsWarning;
    PrivilegesRequired: TMySetupPrivileges;
    PrivilegesRequiredOverridesAllowed: TMySetupPrivilegesRequiredOverrides;
    ShowLanguageDialog: TMySetupShowLanguageDialog;
    LanguageDetectionMethod: TMySetupLanguageDetectionMethod;
    CompressMethod: TSetupCompressMethod;
    DisableDirPage, DisableProgramGroupPage: TMySetupDisablePage;
    UninstallDisplaySize: Int64;
    Options: TMySetupHeaderOptions;
  end;

  ////////// Warning: changes made here must be reflected in StructTemplate.pas !
  TMySetupFileOption = (foConfirmOverwrite, foUninsNeverUninstall, foRestartReplace,
    foDeleteAfterInstall, foRegisterServer, foRegisterTypeLib, foSharedFile,
    foCompareTimeStamp, foFontIsntTrueType,
    foSkipIfSourceDoesntExist, foOverwriteReadOnly, foOverwriteSameVersion,
    foCustomDestName, foOnlyIfDestFileExists, foNoRegError,
    foUninsRestartDelete, foOnlyIfDoesntExist, foIgnoreVersion,
    foPromptIfOlder, foDontCopy, foUninsRemoveReadOnly,
    foRecurseSubDirsExternal, foReplaceSameVersionIfContentsDiffer,
    foDontVerifyChecksum, foUninsNoSharedFilePrompt, foCreateAllSubDirs,
    fo32bit, fo64bit, foExternalSizePreset, foSetNTFSCompression,
    foUnsetNTFSCompression, foGacInstall, foDownload, foExtractArchive);
  const MySetupFileOptionLast = ord(High(TMySetupFileOption));
  type TMySetupFileOptions = set of TMySetupFileOption;

  TMySetupISSigKeyEntry = record
    PublicX, PublicY, RuntimeID: TTextData;
    end;

  TMySetupFileEntry = record // in-memory only
    SourceFilename, DestName, InstallFontName, StrongAssemblyName: TTextData;
    Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    LocationEntry: Integer;
    Attribs: Integer;
    ExternalSize: Int64;
    PermissionsEntry: Smallint;
    FileType: (ftUserFile, ftUninstExe, ftRegSvrExe, ftFakeFile);
    Options: TMySetupFileOptions;
    // Custom fields
    DestDir: TTextData;
  end;

  TMySetupFileLocationFlag = (foVersionInfoValid, foVersionInfoNotValid, foTimeStampInUTC,
      foIsUninstExe, foCallInstructionOptimized, foTouch, foChunkEncrypted,
      foChunkCompressed, foSolidBreak, foSign, foSignOnce);
  TMySetupFileLocationSign = (fsNoSetting, fsYes, fsOnce, fsCheck);
  const MySetupFileLocationFlagLast = Ord(High(TMySetupFileLocationFlag));
  type TMySetupFileLocationFlags = set of TMySetupFileLocationFlag;

  TMySetupFileLocationEntry = record // in-memory only
    FirstSlice, LastSlice: Integer;
    StartOffset: Int64;
    ChunkSuboffset: Int64;
    OriginalSize: Int64;
    ChunkCompressedSize: Int64;
    HashType: TFileHashType;
    CRC: Longint;
    MD5Sum: TMD5Digest;
    SHA1Sum: TSHA1Digest;	// From version 5309
    SHA256Sum: TSHA256Digest;	// From version 6400
    TimeStamp: TFileTime;
    FileVersionMS, FileVersionLS: DWORD;
    Flags: TMySetupFileLocationFlags;
    Sign : TMySetupFileLocationSign;
    Contents: TBinaryData; // for fake files
    PrimaryFileEntry:integer; // for duplicate files
  end;

  ////////// Warning: changes made here must be reflected in StructTemplate.pas !
  TMySetupRegistryOption = (roCreateValueIfDoesntExist, roUninsDeleteValue,
      roUninsClearValue, roUninsDeleteEntireKey, roUninsDeleteEntireKeyIfEmpty,
      roPreserveStringType, roDeleteKey, roDeleteValue, roNoError,
      roDontCreateKey, ro32Bit, ro64Bit);
  const MySetupRegistryOptionLast = ord(High(TMySetupRegistryOption));
  type TMySetupRegistryOptions = set of TMySetupRegistryOption;

  TMySetupRegistryEntry = record // in-memory only
    Subkey, ValueName, ValueData: TTextData;
    Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    RootKey: HKEY;
//    PermissionsEntry: Smallint;
    Typ: (rtNone, rtString, rtExpandString, rtDWord, rtBinary, rtMultiString, rtQWord);
    Options: TMySetupRegistryOptions;
  end;

  TMySetupRunOption = (roShellExec, roSkipIfDoesntExist,
      roPostInstall, roUnchecked, roSkipIfSilent, roSkipIfNotSilent,
      roHideWizard, roRun32Bit, roRun64Bit, roRunAsOriginalUser,
      roDontLogParameters, roLogOutput);
  const MySetupRunOptionLast = ord(High(TMySetupRunOption));
  type TMySetupRunOptions = set of TMySetupRunOption;

  TMySetupRunEntry = record // in-memory only
    Name, Parameters, WorkingDir, RunOnceId, StatusMsg, Verb: TTextData;
    Description, Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    ShowCmd: Integer;
    Wait: (rwWaitUntilTerminated, rwNoWait, rwWaitUntilIdle);
    Options: TMySetupRunOptions;
  end;

  TMySetupIconCloseOnExit = (icNoSetting, icYes, icNo);
  TMySetupIconEntry = record // in-memory only
    IconName, Filename, Parameters, WorkingDir, IconFilename, Comment: TTextData;
    Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    IconIndex, ShowCmd: Integer;
    CloseOnExit: TMySetupIconCloseOnExit;
    HotKey: Word;
    Options: set of (ioUninsNeverUninstall, ioCreateOnlyIfFileExists,
      ioUseAppPaths);
  end;

  TMySetupTaskEntry = record // in-memory only
    Name, Description, GroupDescription, Components, Languages, Check: TTextData;
    Level: Integer;
    Used: Boolean;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    Options: set of (toExclusive, toUnchecked, toRestart, toCheckedOnce,
      toDontInheritCheck);
  end;

  TMySetupComponentEntry = record // in-memory only
    Name, Description, Types, Languages, Check: TTextData;
    ExtraDiskSpaceRequired: Int64;
    Level: Integer;
    Used: Boolean;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    Options: set of (coFixed, coRestart, coDisableNoUninstallWarning,
      coExclusive, coDontInheritCheck);
  end;

  TMySetupTypeOption = (toIsCustom);
  TMySetupTypeOptions = set of TMySetupTypeOption;
  TMySetupTypeType = (ttUser, ttDefaultFull, ttDefaultCompact, ttDefaultCustom);
//  PSetupTypeEntry = ^TSetupTypeEntry;
  TMySetupTypeEntry = record
    Name, Description, Languages, Check: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    Options: TMySetupTypeOptions;
    Typ: TMySetupTypeType;
  end;

  TMySetupCustomMessageEntry = record
    Name, Value: TTextData;
    LangIndex: Integer;
  end;

  TMySetupLanguageEntry = record
    { Note: LanguageName is Unicode }
    Name, LanguageName, DialogFontName, TitleFontName, WelcomeFontName,
      CopyrightFontName: TTextData;
    Data, LicenseText, InfoBeforeText, InfoAfterText: TBinaryData;
    LanguageID, LanguageCodePage: Cardinal;
    DialogFontSize: Integer;
    DialogFontBaseScaleHeight: Integer;
    DialogFontBaseScaleWidth: Integer;
    TitleFontSize: Integer;
    WelcomeFontSize: Integer;
    CopyrightFontSize: Integer;
    RightToLeft: Boolean;
  end;

   ////////// Warning: changes made here must be reflected in StructTemplate.pas !
  TMySetupDirOption = (doUninsNeverUninstall, doDeleteAfterInstall,
    doUninsAlwaysUninstall, doSetNTFSCompression, doUnsetNTFSCompression);
  const MySetupDirOptionLast = ord(High(TMySetupDirOption));
  type TMySetupDirOptions = set of TMySetupDirOption;

  TMySetupDirEntry = record
    DirName: TTextData;
    Components, Tasks: TTextData;
    Languages, Check, AfterInstall, BeforeInstall: TTextData;
    Attribs: Integer;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    Options: TMySetupDirOptions;
  end;

  TMySetupIniOption = (ioCreateKeyIfDoesntExist, ioUninsDeleteEntry,
    ioUninsDeleteEntireSection, ioUninsDeleteSectionIfEmpty,
    { internally used: }
    ioHasValue);
  const MySetupIniOptionLast = ord(High(TMySetupIniOption));
  type TMySetupIniOptions = set of TMySetupIniOption;

  TMySetupIniEntry = record
    Filename, Section, Entry, Value: TTextData;
    Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    Options: TMySetupIniOptions;
  end;

  TMySetupDeleteType = (dfFiles, dfFilesAndOrSubdirs, dfDirIfEmpty);
  TMySetupDeleteEntry = record
    Name: TTextData;
Components, Tasks, Languages, Check, AfterInstall, BeforeInstall: TTextData;
    MinVersion, OnlyBelowVersion: TMySetupVersionData;
    DeleteType: TMySetupDeleteType;
  end;

  {$IFDEF WIN64}
  TWin32TypeInfoItem = record
    Win64Offset: integer;
    Win32Size: integer;
  end;
  TWin32TypeInfoItems = TArray<TWin32TypeInfoItem>;
  {$ENDIF}

////////// variables get filled in verXXXX units based on information
////////// in structXXXX

  TMySetupHeaderInfo = record
    Size, NumStrings, NumAnsiStrings: Integer;
    {$IFDEF WIN64}
    TypeInfo: Pointer;
    Win32TypeInfo: TWin32TypeInfoItems;
    Win32TypeInfoSignature: int64;
    function SizeInFile: integer;
    function GetWin32TypeInfo: TWin32TypeInfoItems;
    {$ENDIF}
  end;

  TMySetupInfo = record
    SetupHeader,
    SetupLanguageEntry,
    SetupCustomMessageEntry,
    SetupPermissionEntry,
    SetupTypeEntry,
    SetupComponentEntry,
    SetupTaskEntry,
    SetupDirEntry,
    SetupISSigKeyEntry,
    SetupFileEntry,
    SetupIconEntry,
    SetupIniEntry,
    SetupRegistryEntry,
    SetupDeleteEntry,
    SetupRunEntry,
    SetupFileLocationEntry: TMySetupHeaderInfo;
  end;

//////////  encapsulates the version-specific stuff
type
  TInnoVerClass = class of TInnoVer;
  TInnoVer = class
  protected
    class procedure LoadBinaryData(out Dest: TBinaryData); overload;
    class procedure LoadBinaryData(out Dest: TBinaryData; var Src: AnsiString); overload;
    class procedure LoadBinaryData(out Dest: TBinaryData; var Src; Size: integer); overload;
    class procedure LoadTextData(out Dest: TTextData); overload;
    class procedure LoadTextData(out Dest: TTextData; var Src: AnsiString); overload;
    class procedure LoadTextData(out Dest: TTextData; var Src: AnsiString; CodePage: integer); overload;
    class procedure LoadTextData(out Dest: TTextData; var Src: WideString); overload;
    class procedure LoadTextData(out Dest: TTextData; Src: Boolean); overload;
    class procedure LoadIntData(out Dest: Integer); overload;
    class procedure LoadIntData(out Dest: Integer; var Src: Integer); overload;
    class procedure LoadIntData(out Dest: Integer; var Src: Cardinal); overload;
    class procedure LoadIntData(out Dest: Integer64); overload;
    class procedure LoadIntData(out Dest: Integer64; var Src: Integer); overload;
    class procedure LoadIntData(out Dest: Integer64; var Src: Int64); overload;
    class procedure LoadIntData(out Dest: Integer64; var Src: Integer64); overload;
    class procedure LoadIntData(out Dest: Int64); overload;
    class procedure LoadIntData(out Dest: Int64; var Src: Integer); overload;
    class procedure LoadIntData(out Dest: Int64; var Src: Cardinal); overload;
    class procedure LoadIntData(out Dest: Int64; var Src: Int64); overload;
    class procedure LoadIntData(out Dest: Int64; var Src: Integer64); overload;
    class procedure LoadIntData(out Dest: Word); overload;
    class procedure LoadIntData(out Dest: Word; var Src: Word); overload;
    class procedure LoadIntData(out Dest: LongWord); overload;
    class procedure LoadIntData(out Dest: LongWord; var Src: LongWord); overload;
  public
    VerSupported:integer;
    IsUnicode:boolean;
    IsRT:boolean;
    SetupID:array[1..12] of AnsiChar; // other units have no access to global data in structXXXX.pas
    OfsTabVers:UInt32;   // same reason
    OfsTabSize:integer;  // same reason
    constructor Create; virtual; abstract;
    procedure SetupSizes(var Info: TMySetupInfo); virtual; abstract;
    procedure UnifySetupLdrOffsetTable(var p; var OffsetTable:TMySetupLdrOffsetTable); virtual; abstract;
    procedure UnifySetupHeader(var p; var SetupHeader:TMySetupHeader); virtual; abstract;
    procedure UnifySetupISSigKeyEntry(var p; var SetupISSigKeyEntry:TMySetupISSigKeyEntry); virtual; abstract;
    procedure UnifyFileEntry(var p; var FileEntry:TMySetupFileEntry); virtual; abstract;
    procedure UnifyFileLocationEntry(var p; var FileLocationEntry:TMySetupFileLocationEntry); virtual; abstract;
    procedure UnifyRegistryEntry(var p; var RegistryEntry:TMySetupRegistryEntry); virtual; abstract;
    procedure UnifyRunEntry(var p; var RunEntry:TMySetupRunEntry); virtual; abstract;
    procedure UnifyIconEntry(var p; var IconEntry:TMySetupIconEntry); virtual; abstract;
    procedure UnifyTaskEntry(var p; var TaskEntry:TMySetupTaskEntry); virtual; abstract;
    procedure UnifyComponentEntry(var p; var ComponentEntry:TMySetupComponentEntry); virtual; abstract;
    procedure UnifyTypeEntry(var p; var TypeEntry:TMySetupTypeEntry); virtual; abstract;
    procedure UnifyCustomMessageEntry(var p; var CustomMessageEntry:TMySetupCustomMessageEntry); virtual; abstract;
    procedure UnifyLanguageEntry(var p; var LanguageEntry:TMySetupLanguageEntry); virtual; abstract;
    procedure UnifyDirEntry(var p; var DirEntry: TMySetupDirEntry); virtual; abstract;
    procedure UnifyIniEntry(var p; var IniEntry: TMySetupIniEntry); virtual; abstract;
    procedure UnifyDeleteEntry(var p; var DeleteEntry: TMySetupDeleteEntry); virtual; abstract;
    class procedure RegisterVersion(Ver: TInnoVer); overload;
    class procedure RegisterVersion(VerClass: TInnoVerClass); overload;
    class function FindVersionExact(Version: integer; IsUnicode, IsRT: boolean): TInnoVer;
    class function FindVersionApproximate(Version: integer; IsUnicode, IsRT: boolean): TInnoVer;
    class function FindVersionBySetupID(const pSetupId; const SetupVersion: LongWord): TInnoVer;
  end;

  TByteArray = array [byte] of byte;
  PByteArray = ^TByteArray;

procedure TranslateSet(const SourceSet; var DestSet; const XlatTab: TByteArray; MaxElement: integer);

// Delphi's dynamic strings get reallocated on every change (in this case, on every append).
// If a string is at least 100K, operations on it slow down significantly.
type
  TBigString=object // old-style object: no VMT and other stuff unless really necessary
    Capacity, Count, IncrementSize:integer;
    Data:PWideChar;
    constructor Init(IncrementBy:integer=10000);
    destructor Destroy;
    procedure SetCapacity(NewCapacity:integer); // new capacity can be greater than requested
    procedure AppendString(const s: TTextData);
    function CopyAsUTF8String(BOM: boolean = False): AnsiString;
  end;

function GetVersionBySetupId(const pSetupId; const SetupVersion: LongWord; var VerObject: TInnoVer):boolean;

implementation

{$IFNDEF WIN64}
  {$UNDEF WIN64_DEBUG_INFO}
{$ENDIF}
{$IFNDEF DEBUG}
  {$UNDEF WIN64_DEBUG_INFO}
{$ENDIF}

{$IFDEF WIN64}
uses
  TypInfo, RTTI;
{$ENDIF}

constructor TBigString.Init(IncrementBy: integer = 10000);
begin
  Capacity := 0;
  Count := 0;
  IncrementSize := IncrementBy;
  Data := nil;
end;

destructor TBigString.Destroy;
begin
  if Data<>nil then FreeMem(Data);
end;

procedure TBigString.SetCapacity(NewCapacity:integer);
var t:integer;
begin
  t:=NewCapacity mod IncrementSize;
  if t>0 then Inc(NewCapacity,IncrementSize-t);
  ReallocMem(Data,Sizeof(Data^)*NewCapacity);
  Capacity:=NewCapacity;
end;

procedure TBigString.AppendString(const s: TTextData);
var
  n: integer;
begin
  n := Length(s);
  if n > 0 then
  begin
    if Count+n > Capacity then SetCapacity(Count+n);
    Move(s[1], Data[Count], Sizeof(Data^)*n);
    Inc(Count, n);
  end;
end;

function TBigString.CopyAsUTF8String(BOM: boolean): AnsiString;
var
  n: integer;
begin
  if (Data = nil) or (Count <= 0) then
  begin
    Result := '';
  end
  else
  begin
    n := 6*Count;
    SetLength(Result, n);
    n := WideCharToMultiByte(CP_UTF8, 0, Data, Count, @(Result[1]), n, nil, nil);
    if n > 0 then
      SetLength(Result, n)
    else
      raise EConvertError.Create('Conversion to UTF8 failed');
  end;
  if BOM then
    Result := #$EF#$BB#$BF + Result;
end;


procedure TranslateSet(const SourceSet; var DestSet; const XlatTab: TByteArray; MaxElement: integer);
var
  SourceArray: TByteArray absolute SourceSet;
  DestArray: TByteArray absolute DestSet;
  i:integer;
begin
  for i:=0 to MaxElement do
    if XlatTab[i]<>255 then
      if (SourceArray[XlatTab[i] shr 3] and (1 shl (XlatTab[i] and 7))) <> 0 then //XlatTab[i] in SourceSet then
        DestArray[i shr 3]:=DestArray[i shr 3] or (1 shl (i and 7));  //Include(DestSet,i);
end;

function GetVersionBySetupId(const pSetupId; const SetupVersion: LongWord; var VerObject: TInnoVer):boolean;
begin
  VerObject := TInnoVer.FindVersionBySetupID(pSetupId, SetupVersion);
  Result := VerObject <> nil;
end;

var
  FVerList: array of TInnoVer;

procedure Cleanup;
var
  i: integer;
begin
  for i := 0 to High(FVerList) do
    FVerList[i].Free;
  SetLength(FVerList, 0);
end;


class procedure TInnoVer.RegisterVersion(Ver: TInnoVer);
var
  i: integer;
  {$IFDEF WIN64_DEBUG_INFO}
  CheckSetupSizes: TMySetupInfo;
  {$ENDIF}
begin
  {$IFDEF WIN64_DEBUG_INFO}
  Ver.SetupSizes(CheckSetupSizes);
  CheckSetupSizes.SetupHeader.SizeInFile;
  CheckSetupSizes.SetupLanguageEntry.SizeInFile;
  CheckSetupSizes.SetupCustomMessageEntry.SizeInFile;
  CheckSetupSizes.SetupPermissionEntry.SizeInFile;
  CheckSetupSizes.SetupTypeEntry.SizeInFile;
  CheckSetupSizes.SetupComponentEntry.SizeInFile;
  CheckSetupSizes.SetupTaskEntry.SizeInFile;
  CheckSetupSizes.SetupDirEntry.SizeInFile;
  CheckSetupSizes.SetupFileEntry.SizeInFile;
  CheckSetupSizes.SetupIconEntry.SizeInFile;
  CheckSetupSizes.SetupIniEntry.SizeInFile;
  CheckSetupSizes.SetupRegistryEntry.SizeInFile;
  CheckSetupSizes.SetupDeleteEntry.SizeInFile;
  CheckSetupSizes.SetupRunEntry.SizeInFile;
  CheckSetupSizes.SetupFileLocationEntry.SizeInFile;
  {$ENDIF}
  if Ver <> nil then begin
    i := Length(FVerList);
    SetLength(FVerList, i+1);
    FVerList[i] := Ver;
  end;
end;

class procedure TInnoVer.RegisterVersion(VerClass: TInnoVerClass);
begin
  RegisterVersion(VerClass.Create);
end;

class function TInnoVer.FindVersionExact(Version: integer; IsUnicode, IsRT: boolean): TInnoVer;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to High(FVerList) do
    if (FVerList[i].VerSupported = Version) and (FVerList[i].IsUnicode = IsUnicode) and (FVerList[i].IsRT = IsRT) then begin
      Result := FVerList[i];
      break;
    end;
end;

class function TInnoVer.FindVersionApproximate(Version: integer; IsUnicode, IsRT: boolean): TInnoVer;
var
  i, BestVer: integer;
begin
  Result := nil;
  BestVer := 0;
  for i := 0 to High(FVerList) do
    if (Version >= FVerList[i].VerSupported) and (FVerList[i].VerSupported >= BestVer) and (FVerList[i].IsUnicode = IsUnicode) then
    begin
      Result := FVerList[i];
      BestVer := Result.VerSupported;
    end;
end;

class function TInnoVer.FindVersionBySetupID(const pSetupId; const SetupVersion: LongWord): TInnoVer;
var
  i: integer;
  aSetupId: array [1..12] of AnsiChar absolute pSetupId;
begin
  Result := nil;
  for i:=0 to High(FVerList) do
    if (FVerList[i].SetupID = aSetupID) and (FVerList[i].OfsTabVers = SetupVersion) then begin
      Result := FVerList[i];
      break;
    end;
end;

class procedure TInnoVer.LoadBinaryData(out Dest: TBinaryData);
begin
  Dest := '';
end;

class procedure TInnoVer.LoadBinaryData(out Dest: TBinaryData; var Src: AnsiString);
begin
  Dest := Src;
  UniqueString(TBinaryDataInternal(Dest));
  Src := ''; // to prevent leaks
end;

class procedure TInnoVer.LoadBinaryData(out Dest: TBinaryData; var Src; Size: integer);
begin
  SetLength(Dest, Size);
  if Size > 0 then
    Move(Src, Dest[1], Size);
end;

class procedure TInnoVer.LoadTextData(out Dest: TTextData);
begin
  Dest := '';
end;

class procedure TInnoVer.LoadTextData(out Dest: TTextData; var Src: AnsiString);
begin
  Dest := TTextData(Src);
  UniqueString(TTextDataInternal(Dest));
  Src := ''; // to prevent leaks
end;

class procedure TInnoVer.LoadTextData(out Dest: TTextData; var Src: AnsiString; CodePage: integer);
var
  Len: integer;
  Wide: WideString;
begin
  if Src = '' then
  begin
    Dest := '';
  end
  else if CodePage = 1200 then
  begin
    Len := Length(Src);
    SetLength(Wide, Len div 2);
    Move(Src[1], Wide[1], 2*(Len div 2));
    Dest := Wide;
  end
  else
  begin
    Len := MultiByteToWideChar(CodePage, 0, @Src[1], Length(Src), nil, 0);
    SetLength(Wide, Len);
    if Len > 0 then
    begin
      MultiByteToWideChar(CodePage, 0, @Src[1], Length(Src), @Wide[1], Len);
    end;
    Dest := Wide;
  end;
  Src := ''; // to prevent leaks
end;

class procedure TInnoVer.LoadTextData(out Dest: TTextData; var Src: WideString);
begin
  Dest := Src;
  UniqueString(TTextDataInternal(Dest));
  Src := ''; // to prevent leaks
end;

class procedure TInnoVer.LoadTextData(out Dest: TTextData; Src: Boolean);
begin
  if Src then
    Dest := 'yes'
  else
    Dest := 'no';
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer);
begin
  Dest := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer; var Src: Integer);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer; var Src: Cardinal);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer64);
begin
  Dest.Lo := 0;
  Dest.Hi := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer64; var Src: Integer);
begin
  Dest.Lo := Src;
  Dest.Hi := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer64; var Src: Int64);
begin
  Dest := Integer64(Src);
end;

class procedure TInnoVer.LoadIntData(out Dest: Integer64; var Src: Integer64);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Int64);
begin
  Dest := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: Int64; var Src: Integer);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Int64; var Src: Cardinal);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Int64; var Src: Int64);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: Int64; var Src: Integer64);
begin
  Dest := Int64(Src);
end;

class procedure TInnoVer.LoadIntData(out Dest: Word);
begin
  Dest := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: Word; var Src: Word);
begin
  Dest := Src;
end;

class procedure TInnoVer.LoadIntData(out Dest: LongWord);
begin
  Dest := 0;
end;

class procedure TInnoVer.LoadIntData(out Dest: LongWord; var Src: LongWord);
begin
  Dest := Src;
end;

{$IFDEF WIN64}
procedure InternalGetWin32TypeInfo(rtype: TRTTIType; const Win64Offset: integer; var Items: TWin32TypeInfoItems; var ItemCount: integer {$IFDEF WIN64_DEBUG_INFO} ; const ParentName: string {$ENDIF} );

  procedure AddNewItem(const Win64Offset, Win32Size: integer);
  begin
    if Length(Items) <= ItemCount then
      SetLength(Items, ItemCount * 2);
    Items[ItemCount].Win64Offset := Win64Offset;
    Items[ItemCount].Win32Size := Win32Size;
    Inc(ItemCount);
  end;

var
  flds: TArray<TRttiField>;
  i: integer;
  TmpSize: integer;
  {$IFDEF WIN64_DEBUG_INFO}
  PreviousItemCount: Integer;
  ItemOffset, ItemSize: integer;
  {$ENDIF}
begin
  {$IFDEF WIN64_DEBUG_INFO}
  PreviousItemCount := ItemCount;
  {$ENDIF}
  case rtype.TypeKind of
    // Same for both x32 and x64:
    tkInteger,
    tkChar,
    tkFloat,
    tkWChar,
    tkString:
      AddNewItem(Win64Offset, rtype.TypeSize);
    // Pointers
    tkClass,
    tkMethod,
    tkLString,
    tkWString,
    tkUString,
    tkClassRef,
    tkPointer,
    tkProcedure:
      AddNewItem(Win64Offset, 4);
    // Special
    tkInt64:
      begin
        TmpSize := rtype.TypeSize;
        if rtype.Name = 'HKEY' then
          TmpSize := 4; // override for HKEY handles
        AddNewItem(Win64Offset, TmpSize);
      end;
    tkArray:
      begin
        AddNewItem(Win64Offset, rtype.TypeSize);
          // May be wrong for anything other than array of byte
      end;
    //tkDynArray:
    tkEnumeration:
      begin
        TmpSize := rtype.TypeSize;
        if TmpSize = 8 then
          TmpSize := (rtype.AsOrdinal.MaxValue - rtype.AsOrdinal.MinValue + 8) div 8;
        AddNewItem(Win64Offset, TmpSize);
      end;
    tkSet:
      begin
        if not Assigned(rtype.AsSet.ElementType) then
          raise Exception.CreateFmt('%s doesn''t have a valid ElementType. See Struct6700u.TSetupHeaderOption for comments.', [rtype.QualifiedName]);
        TmpSize := (rtype.AsSet.ElementType.AsOrdinal.MaxValue - rtype.AsSet.ElementType.AsOrdinal.MinValue + 8) div 8;
        if TmpSize = 3 then
          TmpSize := 4;
        AddNewItem(Win64Offset, TmpSize);
      end;
    tkRecord:
      begin
        flds := rtype.GetFields;
        for i := Low(flds) to High(flds) do
          if flds[i].FieldType = nil then
            raise Exception.CreateFmt('Failed to find type information for field ' {$IFDEF WIN64_DEBUG_INFO} + '%s' {$ENDIF} + '%s.%s', [ {$IFDEF WIN64_DEBUG_INFO} ParentName, {$ENDIF} rtype.Name, flds[i].Name])
          else
            InternalGetWin32TypeInfo(flds[i].FieldType, Win64Offset + flds[i].Offset, Items, ItemCount {$IFDEF WIN64_DEBUG_INFO} , ParentName + rtype.Name + '.' {$ENDIF} );
      end;
    // Unsupported types
    else
      raise Exception.CreateFmt('Invalid type for field ' {$IFDEF WIN64_DEBUG_INFO} + '%s' {$ENDIF} + '%s', [ {$IFDEF WIN64_DEBUG_INFO} ParentName, {$ENDIF} rtype.Name])
  end;
  {$IFDEF WIN64_DEBUG_INFO}
  ItemOffset := 0;
  ItemSize := 0;
  for i := PreviousItemCount to Pred(ItemCount) do
  begin
    ItemOffset := Items[i].Win64Offset;
    ItemSize := ItemSize + Items[i].Win32Size;
  end;
  Writeln(ParentName + rtype.Name + ' ' + IntToStr(ItemOffset) + ' ' + IntToStr(ItemSize));
  {$ENDIF}
end;

{
    Win32TypeInfo: TWin32TypeInfoItems;
    Win32TypeInfoSignature: int64;
    function SizeInFile: integer;
}
function TMySetupHeaderInfo.GetWin32TypeInfo: TWin32TypeInfoItems;
const
  SIGNATURE = $1d67bc3bf5424ce4;
var
  Count: integer;
  rctx: TRTTIContext;
  rtype: TRTTIType;
begin
  if Self.Win32TypeInfoSignature <> SIGNATURE then
  begin
    if Self.TypeInfo = nil then
      raise exception.Create('Failed to locate type information for this record');
    rctx := TRTTIContext.Create;
    try
      rtype := rctx.GetType(Self.TypeInfo);
      if rtype = nil then
        raise exception.Create('Failed to read type information for this record');
      {$IFDEF WIN64_DEBUG_INFO}
      Writeln(rtype.Name + ' START');
      {$ENDIF}
      Count := 0;
      SetLength(Self.Win32TypeInfo, rtype.TypeSize);
      InternalGetWin32TypeInfo(rtype, 0, Self.Win32TypeInfo, Count {$IFDEF WIN64_DEBUG_INFO} , '' {$ENDIF} );
      SetLength(Self.Win32TypeInfo, Count);
      Self.Win32TypeInfoSignature := SIGNATURE;
    finally
      rctx.Free;
    end;
  end;
  Result := Self.Win32TypeInfo;
end;

function TMySetupHeaderInfo.SizeInFile: integer;
var
  Items: TWin32TypeInfoItems;
  i: Integer;
begin
  if Self.Size = 0 then
  begin
    Result := 0;
    Exit;
  end;
  // Try to get a real value using RTTI. This is necessary, because WIN64 Delphi
  // uses different sizes for some data types, e.g. strings (stored as 4 bytes
  // in the file, but 8 bytes in Delphi) or sets (for sets containing 33-56
  // elements).
  Result := 0;
  Items := GetWin32TypeInfo;
  for i := 0 to Pred(Length(Items)) do
    Result := Result + Items[i].Win32Size;
end;
{$ENDIF}

initialization
  SetLength(FVerList, 0);

finalization
  Cleanup;

end.
