1berry/Inno-Setup-issrc
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'novista'. Did a few final tweaks during merge.

Browse Source
This commit is contained in:
Martijn Laan 2024-04-02 12:17:05 +02:00
commit 91b75da1e2
73 changed files with 725 additions and 3221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Components/ASMInline.pas
View File

@ -23,7 +23,7 @@ interface
!!!! Not all special cases have been implemented in WriteRegRef().
}
uses Sysutils, windows, classes, contnrs;
uses Sysutils, Windows, Classes, Contnrs;
type
TModMode = (mmNaked, mmDeref, mmDisp8, mmDisp32);

85
Components/FolderTreeView.pas
View File

@ -2,7 +2,7 @@ unit FolderTreeView;
{
Inno Setup
Copyright (C) 1997-2018 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -24,7 +24,6 @@ type
private
FDestroyingHandle: Boolean;
FDirectory: String;
FFriendlyTree: Boolean;
FItemExpanding: Boolean;
FOnChange: TNotifyEvent;
FOnRename: TFolderRenameEvent;
@ -329,34 +328,6 @@ begin
end;
end;
function UseFriendlyTree: Boolean;
{ Returns True if running Windows XP or 2003 and the "Display simple folder
view" option in Explorer is enabled (by default, it is).
Note: Windows Vista also has this option, but regardless of how it is set,
folders never expand with a single click in Explorer. So on Vista and later,
False is always returned. }
var
Ver: Word;
K: HKEY;
Typ, Value, Size: DWORD;
begin
Ver := Word(GetVersion);
if (Lo(Ver) = 5) and (Hi(Ver) >= 1) then begin
Result := True;
if RegOpenKeyEx(HKEY_CURRENT_USER,
'Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
Size := SizeOf(Value);
if (RegQueryValueEx(K, 'FriendlyTree', nil, @Typ, @Value, @Size) = ERROR_SUCCESS) and
(Typ = REG_DWORD) and (Size = SizeOf(Value)) then
Result := (Value <> 0);
RegCloseKey(K);
end;
end
else
Result := False;
end;
{ TCustomFolderTreeView }
type
@ -377,8 +348,6 @@ begin
Height := 97;
ParentColor := False;
TabStop := True;
if Lo(GetVersion) < 6 then
Cursor := crArrow; { prevent hand cursor from appearing in TVS_TRACKSELECT mode }
if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(LogFont), @LogFont, 0) then
Font.Handle := CreateFontIndirect(LogFont);
end;
@ -394,15 +363,7 @@ begin
with Params do begin
Style := Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or TVS_LINESATROOT or
TVS_HASBUTTONS or TVS_SHOWSELALWAYS or TVS_EDITLABELS;
FFriendlyTree := UseFriendlyTree;
if FFriendlyTree then
Style := Style or TVS_TRACKSELECT or TVS_SINGLEEXPAND
else begin
if Lo(GetVersion) >= 6 then
Style := Style or TVS_TRACKSELECT
else
Style := Style or TVS_HASLINES;
end;
Style := Style or TVS_TRACKSELECT;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
@ -420,8 +381,8 @@ begin
if csDesigning in ComponentState then
Exit;
{ On Vista, enable the new Explorer-style look }
if (Lo(GetVersion) >= 6) and Assigned(SetWindowTheme) then begin
{ Enable the new Explorer-style look }
if Assigned(SetWindowTheme) then begin
SetWindowTheme(Handle, 'Explorer', nil);
{ Like Explorer, enable double buffering to avoid flicker when the mouse
is moved across the items }
@ -489,7 +450,7 @@ end;
procedure TCustomFolderTreeView.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
{ For TVS_EX_DOUBLEBUFFER to be truly flicker-free on Vista, we must use
{ For TVS_EX_DOUBLEBUFFER to be truly flicker-free, we must use
comctl32's default WM_ERASEBKGND handling, not the VCL's (which calls
FillRect). }
DefaultHandler(Message);
@ -555,19 +516,8 @@ const
if Assigned(Item) then begin
if HitTestInfo.flags and TVHT_ONITEMBUTTON <> 0 then
TreeView_Expand(Handle, Item, TVE_TOGGLE)
else begin
if TreeView_GetSelection(Handle) <> Item then
SelectItem(Item)
else begin
{ In 'friendly tree' mode, if the item is already selected, ensure
it's expanded.
Note: We do this only if SelectItem wasn't called, since newly
selected items are expanded automatically. If we were to call this
unconditionally, any error message would be shown twice. }
if FFriendlyTree and (HitTestInfo.flags and TVHT_ONITEM <> 0) then
TreeView_Expand(Handle, Item, TVE_EXPAND);
end;
end;
else if TreeView_GetSelection(Handle) <> Item then
SelectItem(Item);
end;
end;
@ -687,25 +637,6 @@ begin
HandleClick;
Message.Result := 1;
end;
TVN_SINGLEEXPAND:
begin
Hdr := PNMTreeView(Message.NMHdr);
{ Trying to emulate Windows XP's Explorer here:
Only collapse old item if it's at the same level as the new item. }
if Assigned(Hdr.itemOld.hItem) and Assigned(Hdr.itemNew.hItem) and
(TreeView_GetParent(Handle, Hdr.itemNew.hItem) <>
TreeView_GetParent(Handle, Hdr.itemOld.hItem)) then
Message.Result := Message.Result or TVNRET_SKIPOLD;
{ Selecting expanded items shouldn't collapse them }
if Assigned(Hdr.itemNew.hItem) then begin
TVItem.mask := TVIF_STATE;
TVItem.hItem := Hdr.itemNew.hItem;
TVItem.stateMask := TVIS_EXPANDED;
if TreeView_GetItem(Handle, TVItem) and
(TVItem.state and TVIS_EXPANDED <> 0) then
Message.Result := Message.Result or TVNRET_SKIPNEW;
end;
end;
end;
end;
@ -1205,5 +1136,5 @@ end;
initialization
InitThemeLibrary;
SHPathPrepareForWriteFunc := GetProcAddress(LoadLibrary(PChar(AddBackslash(GetSystemDir) + shell32)),
{$IFDEF UNICODE}'SHPathPrepareForWriteW'{$ELSE}'SHPathPrepareForWriteA'{$ENDIF});
'SHPathPrepareForWriteW');
end.

61
Components/NewCheckListBox.pas
View File

@ -93,10 +93,9 @@ type
procedure LBDeleteString(var Message: TMessage); message LB_DELETESTRING;
procedure LBResetContent(var Message: TMessage); message LB_RESETCONTENT;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMGetObject(var Message: TMessage); message $003D; //WM_GETOBJECT
procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMMouseWheel(var Message: TMessage); message $020A; //WM_MOUSEWHEEL
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
@ -239,9 +238,6 @@ const
IID_IAccessible: TGUID = (
D1:$618736e0; D2:$3c3d; D3:$11cf; D4:($81,$0c,$00,$aa,$00,$38,$9b,$71));
var
CanQueryUIState: Boolean;
type
TWinControlAccess = class (TWinControl);
@ -623,8 +619,8 @@ begin
FlipRect(rcItem, ClientRect, FUseRightToLeft);
end;
{ Don't let TCustomListBox.CNDrawItem draw the focus }
if FWantTabs or (CanQueryUIState and
(SendMessage(Handle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS <> 0)) then
if FWantTabs or
(SendMessage(Handle, WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS <> 0) then
itemState := itemState and not ODS_FOCUS;
inherited;
end;
@ -775,10 +771,7 @@ begin
FlipRect(Rect, SavedClientRect, FUseRightToLeft);
ItemState := ItemStates[Index];
if CanQueryUIState then
UIState := SendMessage(Handle, WM_QUERYUISTATE, 0, 0)
else
UIState := 0; //no UISF_HIDEACCEL and no UISF_HIDEFOCUS
UIState := SendMessage(Handle, WM_QUERYUISTATE, 0, 0);
Disabled := not Enabled or not ItemState.Enabled;
with Canvas do begin
if not FWantTabs and (odSelected in State) and Focused then begin
@ -1751,39 +1744,6 @@ begin
UpdateHotIndex(NewHotIndex);
end;
procedure TNewCheckListBox.WMMouseWheel(var Message: TMessage);
const
WHEEL_DELTA = 120;
begin
{ Work around a Windows bug (reproducible on 2000/XP/2003, but not Vista):
On an ownerdraw-variable list box, scrolling up or down more than one item
at a time with animation enabled causes a strange effect: first all visible
items appear to scroll off the bottom, then the items are all repainted in
the correct position. To avoid that, we implement our own mouse wheel
handling that scrolls only one item at a time.
(Note: The same problem exists when scrolling a page at a time using the
scroll bar. But because it's not as obvious, we don't work around it.) }
if (Lo(GetVersion) = 5) and
(Message.WParam and (MK_CONTROL or MK_SHIFT) = 0) then begin
Inc(FWheelAccum, Smallint(Message.WParam shr 16));
if Abs(FWheelAccum) >= WHEEL_DELTA then begin
while FWheelAccum >= WHEEL_DELTA do begin
SendMessage(Handle, WM_VSCROLL, SB_LINEUP, 0);
Dec(FWheelAccum, WHEEL_DELTA);
end;
while FWheelAccum <= -WHEEL_DELTA do begin
SendMessage(Handle, WM_VSCROLL, SB_LINEDOWN, 0);
Inc(FWheelAccum, WHEEL_DELTA);
end;
SendMessage(Handle, WM_VSCROLL, SB_ENDSCROLL, 0);
end;
end
else
{ Like the default handling, don't scroll if Control or Shift are down,
and on Vista always use the default handling since it isn't bugged. }
inherited;
end;
procedure TNewCheckListBox.WMNCHitTest(var Message: TWMNCHitTest);
var
I: Integer;
@ -2144,18 +2104,6 @@ begin
RegisterComponents('JR', [TNewCheckListBox]);
end;
procedure InitCanQueryUIState;
var
OSVersionInfo: TOSVersionInfo;
begin
CanQueryUIState := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
if GetVersionEx(OSVersionInfo) then
CanQueryUIState := OSVersionInfo.dwMajorVersion >= 5;
end;
end;
{ Note: This COM initialization code based on code from DBTables }
var
SaveInitProc: Pointer;
@ -2172,7 +2120,6 @@ initialization
SaveInitProc := InitProc;
InitProc := @InitCOM;
end;
InitCanQueryUIState;
InitThemeLibrary;
NotifyWinEventFunc := GetProcAddress(GetModuleHandle(user32), 'NotifyWinEvent');
finalization

31
Components/NewProgressBar.pas
View File

@ -2,13 +2,13 @@ unit NewProgressBar;
{
Inno Setup
Copyright (C) 1997-2018 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
TNewProgressBar component - a smooth 32 bit TProgressBar
Note: themed Vista and newer animate progress bars and don't immediately show changes.
Note: themed animated progress bars and don't immediately show changes.
This applies both to Position and State. For example if you set State while the
progress bar is still moving towards a new Position, the new State doesnt show until
the moving animation has finished.
@ -59,9 +59,6 @@ implementation
uses
Windows, CommCtrl;
var
XP, Vista: Boolean;
procedure Register;
begin
RegisterComponents('JR', [TNewProgressBar]);
@ -85,7 +82,7 @@ begin
inherited;
CreateSubClass(Params, PROGRESS_CLASS);
Params.Style := Params.Style or PBS_SMOOTH;
if XP and (Style = npbstMarquee) then
if Style = npbstMarquee then
Params.Style := Params.Style or PBS_MARQUEE;
end;
@ -97,8 +94,7 @@ begin
SendMessage(Handle, PBM_SETRANGE, 0, MAKELPARAM(0, 65535));
SetPosition(FPosition);
SetState(FState);
if XP then
SendMessage(Handle, PBM_SETMARQUEE, WPARAM(FStyle = npbstMarquee), 0);
SendMessage(Handle, PBM_SETMARQUEE, WPARAM(FStyle = npbstMarquee), 0);
end;
procedure TNewProgressBar.SetMin(Value: LongInt);
@ -132,16 +128,14 @@ const
PBM_SETSTATE = WM_USER+16;
States: array[TNewProgressBarState] of UINT = (PBST_NORMAL, PBST_ERROR, PBST_PAUSED);
begin
if Vista then begin
FState := Value;
if HandleAllocated then
SendMessage(Handle, PBM_SETSTATE, States[Value], 0);
end;
FState := Value;
if HandleAllocated then
SendMessage(Handle, PBM_SETSTATE, States[Value], 0);
end;
procedure TNewProgressBar.SetStyle(Value: TNewProgressBarStyle);
begin
if XP and (FStyle <> Value) then begin
if FStyle <> Value then begin
FStyle := Value;
RecreateWnd;
end;
@ -158,13 +152,4 @@ begin
DefaultHandler(Message);
end;
var
OSVersionInfo: TOSVersionInfo;
initialization
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
Vista := OSVersionInfo.dwMajorVersion >= 6;
XP := Vista or ((OSVersionInfo.dwMajorVersion = 5) and (OSVersionInfo.dwMinorVersion >= 1));
end;
end.

56
Components/NewStaticText.pas
View File

@ -1,22 +1,12 @@
unit NewStaticText;
{
TNewStaticText - similar to TStaticText on D3+ but with multi-line AutoSize
TNewStaticText - similar to TStaticText but with multi-line AutoSize
support and a WordWrap property
}
interface
{$IFNDEF VER90}
{$IFNDEF VER100}
{$IFNDEF VER120}
{$IFNDEF VER130}
{$DEFINE Delphi6OrHigher}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
uses
Windows, Messages, SysUtils, Classes, Controls, Forms;
@ -44,7 +34,7 @@ type
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetAutoSize(Value: Boolean); {$IFDEF Delphi6OrHigher}override;{$ENDIF}
procedure SetAutoSize(Value: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
function AdjustHeight: Integer;
@ -95,38 +85,6 @@ begin
RegisterComponents('JR', [TNewStaticText]);
end;
procedure DrawTextACP(const DC: HDC; const S: String; var R: TRect;
const AFormat: UINT);
{ Draws an ANSI string using the system's code page (CP_ACP), unlike DrawTextA
which uses the code page defined by the selected font. }
{$IFDEF UNICODE}
begin
DrawText(DC, PChar(S), Length(S), R, AFormat);
end;
{$ELSE}
var
SLen, WideLen: Integer;
WideStr: PWideChar;
begin
SLen := Length(S);
if SLen = 0 then
Exit;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if SLen > High(Integer) div SizeOf(WideChar) then
Exit;
GetMem(WideStr, SLen * SizeOf(WideChar));
try
WideLen := MultiByteToWideChar(CP_ACP, 0, PChar(S), SLen, WideStr, SLen);
DrawTextW(DC, WideStr, WideLen, R, AFormat);
finally
FreeMem(WideStr);
end;
end
else
DrawText(DC, PChar(S), SLen, R, AFormat);
end;
{$ENDIF}
{ TNewStaticText }
constructor TNewStaticText.Create(AOwner: TComponent);
@ -234,15 +192,7 @@ begin
DC := GetDC(0);
try
SelectObject(DC, Font.Handle);
{ On NT platforms, static controls are Unicode-based internally; when
ANSI text is assigned to them, it is converted to Unicode using the
system code page (ACP). We must be sure to use the ACP here, too,
otherwise the calculated size could be incorrect. The code page used
by DrawTextA is defined by the font, and not necessarily equal to the
ACP, so we can't use it. (To reproduce: with the ACP set to Hebrew
(1255), try passing Hebrew text to DrawTextA with the font set to
"Lucida Console". It appears to use CP 1252, not 1255.) }
DrawTextACP(DC, S, R, DT_CALCRECT or GetDrawTextFlags);
DrawText(DC, PChar(S), Length(S), R, DT_CALCRECT or GetDrawTextFlags);
finally
ReleaseDC(0, DC);
end;

79
Components/PathFunc.pas
View File

@ -2,17 +2,11 @@ unit PathFunc;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
This unit provides some path-related, MBCS-aware functions.
These functions should always be used in lieu of their SysUtils counterparts
since they aren't MBCS-aware on Delphi 2, and sometimes not MBCS-aware on
Delphi 6 and 7 either (see QC#5096).
$jrsoftware: issrc/Components/PathFunc.pas,v 1.43 2010/04/19 21:43:01 jr Exp $
This unit provides some path-related functions.
}
interface
@ -66,20 +60,9 @@ begin
end;
function PathCharLength(const S: String; const Index: Integer): Integer;
{ Returns the length in bytes of the character at Index in S.
Notes:
1. If Index specifies the last character in S, 1 will always be returned,
even if the last character is a lead byte.
2. If a lead byte is followed by a null character (e.g. #131#0), 2 will be
returned. This mimics the behavior of MultiByteToWideChar and CharPrev,
but not CharNext(P)-P, which would stop on the null. }
{ Returns the length in characters of the character at Index in S. }
begin
{$IFNDEF UNICODE}
if IsDBCSLeadByte(Ord(S[Index])) and (Index < Length(S)) then
Result := 2
else
{$ENDIF}
Result := 1;
Result := 1;
end;
function PathCharIsSlash(const C: Char): Boolean;
@ -188,8 +171,7 @@ function PathDrivePartLengthEx(const Filename: String;
'x:\file' -> 3 ('x:\')
'\\server\share\file' -> 14 ('\\server\share')
'\file' -> 1 ('\')
Note: This is MBCS-safe, unlike the Delphi's ExtractFileDrive function.
(Computer and share names can include multi-byte characters!) }
}
var
Len, I, C: Integer;
begin
@ -392,8 +374,8 @@ begin
end;
function PathLastChar(const S: String): PChar;
{ Returns pointer to last character in the string. Is MBCS-aware. Returns nil
if the string is empty. }
{ Returns pointer to last character in the string. Returns nil if the string is
empty. }
begin
if S = '' then
Result := nil
@ -426,37 +408,11 @@ end;
function PathLowercase(const S: String): String;
{ Converts the specified path name to lowercase }
{$IFNDEF UNICODE}
var
I, L: Integer;
{$ENDIF}
begin
{$IFNDEF UNICODE}
if (Win32Platform <> VER_PLATFORM_WIN32_NT) and
(GetSystemMetrics(SM_DBCSENABLED) <> 0) then begin
{ Japanese Windows 98's handling of double-byte Roman characters in
filenames is case sensitive, so we can't change the case of double-byte
characters. (Japanese Windows NT/2000 is case insensitive, on both FAT
and NTFS, in my tests.) Based on code from AnsiLowerCaseFileName. }
Result := S;
L := Length(Result);
I := 1;
while I <= L do begin
if Result[I] in ['A'..'Z'] then begin
Inc(Byte(Result[I]), 32);
Inc(I);
end
else
Inc(I, PathCharLength(Result, I));
end;
end
else
{$ENDIF}
Result := AnsiLowerCase(S);
Result := AnsiLowerCase(S);
end;
function PathPos(Ch: Char; const S: String): Integer;
{ This is an MBCS-aware Pos function. }
var
Len, I: Integer;
begin
@ -499,7 +455,7 @@ end;
function PathStartsWith(const S, AStartsWith: String): Boolean;
{ Returns True if S starts with (or is equal to) AStartsWith. Uses path casing
rules, and is MBCS-aware. }
rules. }
var
AStartsWithLen: Integer;
begin
@ -513,35 +469,24 @@ begin
end;
function PathStrNextChar(const S: PChar): PChar;
{ Returns pointer to the character after S, unless S points to a null (#0).
Is MBCS-aware. }
{ Returns pointer to the character after S, unless S points to a null (#0). }
begin
{$IFNDEF UNICODE}
Result := CharNext(S);
{$ELSE}
Result := S;
if Result^ <> #0 then
Inc(Result);
{$ENDIF}
end;
function PathStrPrevChar(const Start, Current: PChar): PChar;
{ Returns pointer to the character before Current, unless Current = Start.
Is MBCS-aware. }
{ Returns pointer to the character before Current, unless Current = Start. }
begin
{$IFNDEF UNICODE}
Result := CharPrev(Start, Current);
{$ELSE}
Result := Current;
if Result > Start then
Dec(Result);
{$ENDIF}
end;
function PathStrScan(const S: PChar; const C: Char): PChar;
{ Returns pointer to first occurrence of C in S, or nil if there are no
occurrences. Like StrScan, but MBCS-aware.
Note: As with StrScan, specifying #0 for the search character is legal. }
occurrences. As with StrScan, specifying #0 for the search character is legal. }
begin
Result := S;
while Result^ <> C do begin

15
Components/RestartManager.pas
View File

@ -1,21 +1,13 @@
unit RestartManager;
{
Basic RestartManager API interface Unit for Delphi 2 and higher
by Martijn Laan
Basic RestartManager API interface unit by Martijn Laan
}
{$IFNDEF VER90}
{$IFNDEF VER93}
{$DEFINE Delphi3orHigher}
{$ENDIF}
{$ENDIF}
interface
uses
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
Windows;
ActiveX, Windows;
procedure FreeRestartManagerLibrary;
function InitRestartManagerLibrary: Boolean;
@ -151,8 +143,7 @@ function InitRestartManagerLibrary: Boolean;
begin
Inc(ReferenceCount);
{ Only attempt to load rstrtmgr.dll if running Windows Vista or later }
if (RestartManagerLibrary = 0) and (Lo(GetVersion) >= 6) then
if RestartManagerLibrary = 0 then
begin
RestartManagerLibrary := LoadLibrary(PChar(AddBackslash(GetSystemDir) + restartmanagerlib));
if RestartManagerLibrary <> 0 then

22
Components/RichEditViewer.pas
View File

@ -72,9 +72,6 @@ uses
ShellApi, BidiUtils, PathFunc, ComObj;
const
{ Note: There is no 'W' 1.0 class }
RICHEDIT_CLASS10A = 'RICHEDIT';
RICHEDIT_CLASSA = 'RichEdit20A';
RICHEDIT_CLASSW = 'RichEdit20W';
MSFTEDIT_CLASS = 'RICHEDIT50W';
EM_AUTOURLDETECT = WM_USER + 91;
@ -116,7 +113,7 @@ type
TTextRange = record
chrg: TCharRange;
lpstrText: {$IFDEF UNICODE} PWideChar {$ELSE} PAnsiChar {$ENDIF};
lpstrText: PWideChar;
end;
var
@ -136,22 +133,12 @@ procedure LoadRichEdit;
begin
if RichEditUseCount = 0 then begin
{$IFDEF UNICODE}
RichEditVersion := 4;
RichEditModule := LoadLibrary(PChar(AddBackslash(GetSystemDir) + 'MSFTEDIT.DLL'));
{$ELSE}
RichEditModule := 0;
{$ENDIF}
if RichEditModule = 0 then begin
RichEditVersion := 2;
RichEditModule := LoadLibrary(PChar(AddBackslash(GetSystemDir) + 'RICHED20.DLL'));
end;
{$IFNDEF UNICODE}
if RichEditModule = 0 then begin
RichEditVersion := 1;
RichEditModule := LoadLibrary(PChar(AddBackslash(GetSystemDir) + 'RICHED32.DLL'));
end;
{$ENDIF}
end;
Inc(RichEditUseCount);
end;
@ -266,17 +253,10 @@ begin
end;
inherited;
if UseRichEdit then begin
{$IFDEF UNICODE}
if RichEditVersion = 4 then
CreateSubClass(Params, MSFTEDIT_CLASS)
else
CreateSubClass(Params, RICHEDIT_CLASSW);
{$ELSE}
if RichEditVersion = 2 then
CreateSubClass(Params, RICHEDIT_CLASSA)
else
CreateSubClass(Params, RICHEDIT_CLASS10A);
{$ENDIF}
end else
{ Inherited handler creates a subclass of 'EDIT'.
Must have a unique class name since it uses two different classes

40
Components/ScintEdit.pas
View File

@ -2,7 +2,7 @@ unit ScintEdit;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -25,7 +25,7 @@ type
TScintEditCharAddedEvent = procedure(Sender: TObject; Ch: AnsiChar) of object;
TScintEditDropFilesEvent = procedure(Sender: TObject; X, Y: Integer;
AFiles: TStrings) of object;
TScintHintInfo = {$IFDEF UNICODE} Controls. {$ENDIF} THintInfo;
TScintHintInfo = Controls.THintInfo;
TScintEditHintShowEvent = procedure(Sender: TObject;
var Info: TScintHintInfo) of object;
TScintEditMarginClickEvent = procedure(Sender: TObject; MarginNumber: Integer;
@ -43,7 +43,7 @@ type
StartPos, EndPos: Integer;
end;
TScintRawCharSet = set of AnsiChar;
TScintRawString = type {$IFDEF UNICODE} RawByteString {$ELSE} AnsiString {$ENDIF};
TScintRawString = type RawByteString;
TScintRectangle = record
Left, Top, Right, Bottom: Integer;
end;
@ -327,9 +327,6 @@ type
protected
procedure CheckIndexRange(const Index: Integer);
procedure CheckIndexRangePlusOne(const Index: Integer);
{$IFNDEF UNICODE}
class procedure Error(Msg: PResStringRec; Data: Integer);
{$ENDIF}
function Get(Index: Integer): String; override;
function GetCount: Integer; override;
function GetTextStr: String; override;
@ -552,7 +549,6 @@ begin
end;
function TScintEdit.ConvertRawStringToString(const S: TScintRawString): String;
{$IFDEF UNICODE}
var
SrcLen, DestLen: Integer;
DestStr: UnicodeString;
@ -569,22 +565,14 @@ begin
end;
Result := DestStr;
end;
{$ELSE}
begin
Result := S;
end;
{$ENDIF}
function TScintEdit.ConvertPCharToRawString(const Text: PChar;
const TextLen: Integer): TScintRawString;
var
{$IFDEF UNICODE}
DestLen: Integer;
{$ENDIF}
DestStr: TScintRawString;
begin
if TextLen > 0 then begin
{$IFDEF UNICODE}
DestLen := WideCharToMultiByte(FCodePage, 0, Text, TextLen, nil, 0, nil, nil);
if DestLen <= 0 then
Error('WideCharToMultiByte failed');
@ -592,20 +580,13 @@ begin
if WideCharToMultiByte(FCodePage, 0, Text, TextLen, @DestStr[1], Length(DestStr),
nil, nil) <> DestLen then
Error('Unexpected result from WideCharToMultiByte');
{$ELSE}
SetString(DestStr, Text, TextLen);
{$ENDIF}
end;
Result := DestStr;
end;
function TScintEdit.ConvertStringToRawString(const S: String): TScintRawString;
begin
{$IFDEF UNICODE}
Result := ConvertPCharToRawString(PChar(S), Length(S));
{$ELSE}
Result := S;
{$ENDIF}
end;
procedure TScintEdit.CopyToClipboard;
@ -633,12 +614,6 @@ begin
Call(SCI_SETSCROLLWIDTHTRACKING, 1, 0);
{ The default popup menu conflicts with the VCL's PopupMenu on Delphi 3 }
Call(SCI_USEPOPUP, 0, 0);
{$IFNDEF UNICODE}
{ This hack is needed because non-Unicode VCL replaces the Scintilla's
default Unicode window proc with an ANSI one }
if Win32Platform = VER_PLATFORM_WIN32_NT then
Call(SCI_SETKEYSUNICODE, 1, 0);
{$ENDIF}
SetDefaultWordChars;
ApplyOptions;
UpdateStyleAttributes;
@ -1021,11 +996,9 @@ end;
procedure TScintEdit.InitRawString(var S: TScintRawString; const Len: Integer);
begin
SetString(S, nil, Len);
{$IFDEF UNICODE}
//experimental, dont need this ATM:
if FCodePage <> 0 then
System.SetCodePage(RawByteString(S), FCodePage, False);
{$ENDIF}
end;
function TScintEdit.IsPositionInViewVertically(const Pos: Integer): Boolean;
@ -1869,13 +1842,6 @@ begin
FEdit.ReplaceRawTextRange(StartPos, EndPos, '');
end;
{$IFNDEF UNICODE}
class procedure TScintEditStrings.Error(Msg: PResStringRec; Data: Integer);
begin
TList.Error(LoadResString(Msg), Data);
end;
{$ENDIF}
function TScintEditStrings.Get(Index: Integer): String;
begin
Result := FEdit.ConvertRawStringToString(GetRawLine(Index));

25
Components/UxTheme.pas
View File

@ -44,7 +44,7 @@
{ }
{******************************************************************************}
{ Simplified by Martijn Laan for Inno Setup and Delphi 2 }
{ Simplified by Martijn Laan for Inno Setup }
unit UxTheme;
@ -1088,19 +1088,6 @@ end;
function InitThemeLibrary: Boolean;
function IsWindowsXP: Boolean;
var
Info: TOSVersionInfo;
begin
Result := False;
Info.dwOSVersionInfoSize := SizeOf(Info);
if GetVersionEx(Info) then
if Info.dwPlatformId = VER_PLATFORM_WIN32_NT then
if (Info.dwMajorVersion > 5) or
((Info.dwMajorVersion = 5) and (Info.dwMinorVersion >= 1)) then
Result := True;
end;
function GetSystemDir: String;
var
Buf: array[0..MAX_PATH-1] of Char;
@ -1112,15 +1099,9 @@ function InitThemeLibrary: Boolean;
begin
Inc(ReferenceCount);
{ Only attempt to load uxtheme.dll if running Windows XP or later; otherwise
if uxtheme.dll happens to exist on Windows 2000 (it shouldn't unless a
bugged installer put it there) we get a "RtlUnhandledExceptionFilter could
not be located in the dynamic link library ntdll.dll" error message }
if (ThemeLibrary = 0) and IsWindowsXP then
begin
if ThemeLibrary = 0 then begin
ThemeLibrary := LoadLibrary(PChar(AddBackslash(GetSystemDir) + themelib));
if ThemeLibrary <> 0 then
begin
if ThemeLibrary <> 0 then begin
OpenThemeData := GetProcAddress(ThemeLibrary, 'OpenThemeData');
CloseThemeData := GetProcAddress(ThemeLibrary, 'CloseThemeData');
DrawThemeBackground := GetProcAddress(ThemeLibrary, 'DrawThemeBackground');

41
Components/dwTaskbarList.pas
View File

@ -2,29 +2,21 @@
http://www.gumpi.com/Blog/2009/01/20/Alpha1OfWindows7ControlsForDelphi.aspx
MPL licensed }
{ D2/D3 support and correct IID consts added by Martijn Laan for Inno Setup }
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
This unit provides the ITaskbarList3 interface for Windows 7 taskbar progress indicators.
$jrsoftware: issrc/Components/dwTaskbarList.pas,v 1.5 2010/10/21 02:14:14 jr Exp $
}
{$IFDEF VER90}
{$DEFINE DELPHI2}
{$ENDIF}
unit dwTaskbarList;
interface
uses
Windows {$IFDEF DELPHI2}, OLE2 {$ENDIF};
Windows;
const
CLSID_TaskbarList: TGUID = (
@ -86,34 +78,6 @@ type
end;
type
{$IFDEF DELPHI2}
ITaskbarList = class(IUnknown)
function HrInit: HRESULT; virtual; stdcall; abstract;
function AddTab(hwnd: Cardinal): HRESULT; virtual; stdcall; abstract;
function DeleteTab(hwnd: Cardinal): HRESULT; virtual; stdcall; abstract;
function ActivateTab(hwnd: Cardinal): HRESULT; virtual; stdcall; abstract;
function SetActiveAlt(hwnd: Cardinal): HRESULT; virtual; stdcall; abstract;
end;
ITaskbarList2 = class(ITaskbarList)
function MarkFullscreenWindow(hwnd: Cardinal; fFullscreen: Bool): HRESULT; virtual; stdcall; abstract;
end;
ITaskbarList3 = class(ITaskbarList2)
function SetProgressValue(hwnd: Cardinal; ullCompleted, ullTotal: dwInteger64): HRESULT; virtual; stdcall; abstract;
function SetProgressState(hwnd: Cardinal; tbpFlags: DWORD): HRESULT; virtual; stdcall; abstract;
function RegisterTab(hwndTab: Cardinal; hwndMDI: Cardinal): HRESULT; virtual; stdcall; abstract;
function UnregisterTab(hwndTab: Cardinal): HRESULT; virtual; stdcall; abstract;
function SetTabOrder(hwndTab: Cardinal; hwndInsertBefore: Cardinal): HRESULT; virtual; stdcall; abstract;
function SetTabActive(hwndTab: Cardinal; hwndMDI: Cardinal; tbatFlags: DWORD): HRESULT; virtual; stdcall; abstract;
function ThumbBarAddButtons(hwnd: Cardinal; cButtons: UINT; Button: THUMBBUTTONLIST): HRESULT; virtual; stdcall; abstract;
function ThumbBarUpdateButtons(hwnd: Cardinal; cButtons: UINT; pButton: THUMBBUTTONLIST): HRESULT; virtual; stdcall; abstract;
function ThumbBarSetImageList(hwnd: Cardinal; himl: Cardinal): HRESULT; virtual; stdcall; abstract;
function SetOverlayIcon(hwnd: Cardinal; hIcon: HICON; pszDescription: LPCWSTR): HRESULT; virtual; stdcall; abstract;
function SetThumbnailTooltip(hwnd: Cardinal; pszTip: LPCWSTR): HRESULT; virtual; stdcall; abstract;
function SetThumbnailClip(hwnd: Cardinal; prcClip: PRect): HRESULT; virtual; stdcall; abstract;
end;
{$ELSE}
ITaskbarList = interface
['{56FDF342-FD6D-11D0-958A-006097C9A090}']
function HrInit: HRESULT; stdcall;
@ -143,7 +107,6 @@ type
function SetThumbnailTooltip(hwnd: Cardinal; pszTip: LPCWSTR): HRESULT; stdcall;
function SetThumbnailClip(hwnd: Cardinal; prcClip: PRect): HRESULT; stdcall;
end;
{$ENDIF}
implementation

7
ISHelp/ISHelpGen/UIsxclassesParser.pas
View File

@ -23,13 +23,6 @@ uses
Windows,
SysUtils;
{$IFNDEF UNICODE}
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
begin
Result := C in CharSet;
end;
{$ENDIF}
constructor TIsxclassesParser.Create();
begin
inherited;

31
ISHelp/isetup.xml
View File

@ -101,7 +101,7 @@ Inno Setup is a <i>free</i> installer for Windows programs by Jordan Russell and
<ul>
<li>Support for every Windows release since 2006, including: Windows 11, Windows 10, Windows 10 on ARM, Windows Server 2019, Windows Server 2016, Windows 8.1, Windows 8, Windows Server 2012, Windows 7, Windows Server 2008 R2, Windows Server 2008, and Windows Vista. (No service packs are required.)</li>
<li>Support for every Windows release since 2009, including: Windows 11, Windows 10, Windows 10 on ARM, Windows Server 2019, Windows Server 2016, Windows 8.1, Windows 8, Windows Server 2012, Windows 7, and Windows Server 2008 R2. (No service packs are required.)</li>
<li>Extensive support for installation of <link topic="32vs64bitinstalls">64-bit</link> applications on the 64-bit editions of Windows. The x64, ARM64 and Itanium architectures are all supported.</li>
@ -1953,11 +1953,6 @@ Filename: "http://www.example.com/"
<flag name="excludefromshowinnewinstall">
<p>Prevents the Start menu entry for the new shortcut from receiving a highlight on Windows 7 and additionally prevents the new shortcut from being automatically pinned the Start screen on Windows 8 (or later). Ignored on earlier Windows versions.</p>
</flag>
<flag name="foldershortcut">
<p>Creates a special type of shortcut known as a "Folder Shortcut". Normally, when a shortcut to a folder is present on the Start Menu, clicking the item causes a separate Explorer window to open showing the target folder's contents. In contrast, a "folder shortcut" will show the contents of the target folder as a submenu instead of opening a separate window.</p>
<p>This flag is currently ignored when running on Windows 7 (or later), as folder shortcuts do not expand properly on the Start Menu anymore. It is not known whether this is a bug in Windows 7 or a removed feature.</p>
<p>When this flag is used, a folder name must be specified in the <tt>Filename</tt> parameter. Specifying the name of a file will result in a non-working shortcut.</p>
</flag>
<flag name="preventpinning">
<p>Prevents a Start menu entry from being pinnable to Taskbar or the Start Menu on Windows 7 (or later). This also makes the entry ineligible for inclusion in the Start menu's Most Frequently Used (MFU) list. Ignored on earlier Windows versions.</p>
</flag>
@ -4144,21 +4139,10 @@ Name: portablemode; Description: "Portable Mode"</pre></example>
<setupvalid><tt>admin</tt>, or <tt>lowest</tt></setupvalid>
<setupdefault><tt>admin</tt></setupdefault>
<body>
<!--
<p>The effect of this directive depends on which version of Windows the user is running:</p>
<p><b>On Windows Vista and later:</b></p>
-->
<p>This directive affects whether elevated rights are requested (via a User Account Control dialog) when the installation is started.</p>
<p>When set to <tt>admin</tt> (the default), Setup will always run with administrative privileges and in <link topic="admininstallmode">administrative install mode</link>. If Setup was started by an unprivileged user, Windows will ask for the password to an account that has administrative privileges, and Setup will then run under that account.</p>
<!-- <p>When set to <tt>none</tt>, Setup will only run with administrative privileges if it was started by a member of the Administrators group. Do not use this setting unless you are sure your installation will run successfully on unprivileged accounts.</p> -->
<p>When set to <tt>lowest</tt>, Setup will not request to be run with administrative privileges even if it was started by a member of the Administrators group and will always run in <link topic="admininstallmode">non administrative install mode</link>. Do not use this setting unless you are sure your installation will run successfully on unprivileged accounts.</p>
<!--
<p><b>On earlier versions of Windows:</b></p>
<p>This directive specifies the minimum user privileges required to run the installation.</p>
<p>When set to <tt>admin</tt> (the default), Setup will only run if the user is a member of the Administrators group and will always run in <link topic="admininstallmode">administrative install mode</link>. Otherwise, it will display the following message and exit: "You must be logged in as an administrator when installing this program."</p>
<p>When set to <tt>none</tt> Setup will not check the user's group membership. Do not use this setting unless you are sure your installation will run successfully on unprivileged accounts.</p>
<p>When set to <tt>lowest</tt> Setup will not check the user's group membership and will always run in <link topic="admininstallmode">non administrative install mode</link>. Do not use this setting unless you are sure your installation will run successfully on unprivileged accounts.</p>
-->
<p><b>See also:</b><br/>
<link topic="setup_privilegesrequiredoverridesallowed">PrivilegesRequiredOverridesAllowed</link>
</p>
@ -5646,15 +5630,14 @@ SignTool=byparam format c:
<p>The versions specified in <tt>MinVersion</tt> and <tt>OnlyBelowVersion</tt> can optionally include build numbers and/or service pack levels.</p>
<examples>
<pre>
5.0.2195
5.0sp4
5.0.2195sp4
6.1sp1
10.0.22000
</pre>
</examples>
<p>If a build number is not specified or is zero, Setup will not check the system's build number.</p>
<p>If a service pack level is not specified or is zero, Setup will not check the system's service pack level.</p>
<p>When a service pack level is specified, Setup will only compare it against the system's service pack level if the specified major and minor versions match the system's version. For example, if <tt>MinVersion</tt> specifies <tt>5.0sp4</tt>, Setup will only check for SP4 on Windows 2000 (5.0) systems.</p>
<p>In an <tt>OnlyBelowVersion</tt> parameter, if the specified version matches the system's version, then Setup will normally consider the system's version to be too high. However, when a service pack level is specified, the specified version is allowed to match the system's version. For example, on Windows 2000 SP4, values of <tt>5.0</tt> and <tt>5.0.2195</tt> will fail the <tt>OnlyBelowVersion</tt> test, but <tt>5.0sp5</tt> and <tt>5.0.2195sp5</tt> will pass (as SP4 &lt; <tt>sp5</tt>).</p>
<p>When a service pack level is specified, Setup will only compare it against the system's service pack level if the specified major and minor versions match the system's version. For example, if <tt>MinVersion</tt> specifies <tt>6.1sp1</tt>, Setup will only check for SP1 on Windows 7 and Windows Server 2008 R2 (6.1) systems.</p>
<p>In an <tt>OnlyBelowVersion</tt> parameter, if the specified version matches the system's version, then Setup will normally consider the system's version to be too high. However, when a service pack level is specified, the specified version is allowed to match the system's version.<!-- For example, on Windows 2000 SP4, values of <tt>5.0</tt> and <tt>5.0.2195</tt> will fail the <tt>OnlyBelowVersion</tt> test, but <tt>5.0sp5</tt> and <tt>5.0.2195sp5</tt> will pass (as SP4 &lt; <tt>sp5</tt>). --></p>
</body>
</topic>
@ -5662,8 +5645,6 @@ SignTool=byparam format c:
<keyword value="Windows Versions" />
<body>
<table>
<tr><td>6.0.6000</td><td>Windows Vista</td></tr>
<tr><td>6.0.6001</td><td>Windows Vista with Service Pack 1<br/>or Windows Server 2008</td></tr>
<tr><td>6.1.7600</td><td>Windows 7<br/>or Windows Server 2008 R2</td></tr>
<tr><td>6.1.7601</td><td>Windows 7 with Service Pack 1<br/>or Windows Server 2008 R2 with Service Pack 1</td></tr>
<tr><td>6.2.9200</td><td>Windows 8<br/>or Windows Server 2012</td></tr>
@ -5688,7 +5669,7 @@ SignTool=byparam format c:
<tr><td>10.0.22621</td><td>Windows 11 Version 22H2 (2022 Update)</td></tr>
<tr><td>10.0.22631</td><td>Windows 11 Version 23H2 (2023 Update)</td></tr>
</table>
<p>Note that there is normally no need to specify the build numbers (i.e., you may simply use "6.2" for Windows 8).</p>
<p>Note that except for Windows 11 there is normally no need to specify the build numbers (i.e., you may simply use "6.2" for Windows 8).</p>
</body>
</topic>

6
Projects/BrowseFunc.pas
View File

@ -2,13 +2,11 @@ unit BrowseFunc;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Functions for browsing for folders/files
$jrsoftware: issrc/Projects/BrowseFunc.pas,v 1.9 2010/09/10 01:08:44 jr Exp $
}
interface
@ -33,7 +31,7 @@ function NewGetSaveFileName(const Prompt: String; var FileName: String;
implementation
uses
CommDlg, ShlObj, {$IFNDEF Delphi3orHigher} Ole2, {$ELSE} ActiveX, {$ENDIF}
CommDlg, ShlObj, ActiveX,
PathFunc;
function BrowseCallback(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall;

81
Projects/CmnFunc.pas
View File

@ -2,7 +2,7 @@ unit CmnFunc;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -209,62 +209,10 @@ begin
end;
end;
{$IFNDEF IS_D4}
function MoveAppWindowToActiveWindowMonitor(var OldRect: TRect): Boolean;
{ This moves the application window (Application.Handle) to the same monitor
as the active window, so that a subsequent call to Application.MessageBox
displays the message box on that monitor. Based on code from D4+'s
TApplication.MessageBox. }
type
HMONITOR = type THandle;
TMonitorInfo = record
cbSize: DWORD;
rcMonitor: TRect;
rcWork: TRect;
dwFlags: DWORD;
end;
const
MONITOR_DEFAULTTONEAREST = $00000002;
var
ActiveWindow: HWND;
Module: HMODULE;
MonitorFromWindow: function(hwnd: HWND; dwFlags: DWORD): HMONITOR; stdcall;
GetMonitorInfo: function(hMonitor: HMONITOR; var lpmi: TMonitorInfo): BOOL; stdcall;
MBMonitor, AppMonitor: HMONITOR;
Info: TMonitorInfo;
begin
Result := False;
ActiveWindow := GetActiveWindow;
if ActiveWindow = 0 then Exit;
Module := GetModuleHandle(user32);
MonitorFromWindow := GetProcAddress(Module, 'MonitorFromWindow');
GetMonitorInfo := GetProcAddress(Module, 'GetMonitorInfoA');
if Assigned(MonitorFromWindow) and Assigned(GetMonitorInfo) then begin
MBMonitor := MonitorFromWindow(ActiveWindow, MONITOR_DEFAULTTONEAREST);
AppMonitor := MonitorFromWindow(Application.Handle, MONITOR_DEFAULTTONEAREST);
if MBMonitor <> AppMonitor then begin
Info.cbSize := SizeOf(Info);
if GetMonitorInfo(MBMonitor, Info) then begin
GetWindowRect(Application.Handle, OldRect);
SetWindowPos(Application.Handle, 0,
Info.rcMonitor.Left + ((Info.rcMonitor.Right - Info.rcMonitor.Left) div 2),
Info.rcMonitor.Top + ((Info.rcMonitor.Bottom - Info.rcMonitor.Top) div 2),
0, 0, SWP_NOACTIVATE or SWP_NOREDRAW or SWP_NOSIZE or SWP_NOZORDER);
Result := True;
end;
end;
end;
end;
{$ENDIF}
function AppMessageBox(const Text, Caption: PChar; Flags: Longint): Integer;
var
ActiveWindow: HWND;
WindowList: Pointer;
{$IFNDEF IS_D4}
DidMove: Boolean;
OldRect: TRect;
{$ENDIF}
begin
if MessageBoxRightToLeft then
Flags := Flags or (MB_RTLREADING or MB_RIGHT);
@ -289,31 +237,7 @@ begin
Exit;
end;
{$IFDEF IS_D4}
{ On Delphi 4+, simply call Application.MessageBox }
Result := Application.MessageBox(Text, Caption, Flags);
{$ELSE}
{ Use custom implementation on Delphi 2 and 3. The Flags parameter is
incorrectly declared as a Word on Delphi 2's Application.MessageBox, and
there is no support for multiple monitors. }
DidMove := MoveAppWindowToActiveWindowMonitor(OldRect);
try
ActiveWindow := GetActiveWindow;
WindowList := DisableTaskWindows(0);
try
Result := MessageBox(Application.Handle, Text, Caption, Flags);
finally
EnableTaskWindows(WindowList);
SetActiveWindow(ActiveWindow);
end;
finally
if DidMove then
SetWindowPos(Application.Handle, 0,
OldRect.Left + ((OldRect.Right - OldRect.Left) div 2),
OldRect.Top + ((OldRect.Bottom - OldRect.Top) div 2),
0, 0, SWP_NOACTIVATE or SWP_NOREDRAW or SWP_NOSIZE or SWP_NOZORDER);
end;
{$ENDIF}
finally
TriggerMessageBoxCallbackFunc(Flags, True);
end;
@ -429,9 +353,6 @@ begin
FOwnerWnd := CreateWindowEx(0, WindowDisablerWndClassName, '',
WS_POPUP or WS_DISABLED, 0, 0, 0, 0, HWND_DESKTOP, 0, HInstance, nil);
if FOwnerWnd <> 0 then begin
{ Note: We give the window a valid title since the user can see it in the
Alt+Tab list (on 2000 and XP, but not Vista, which appears to exclude
zero-width/height windows). }
FFallbackWnd := CreateWindowEx(0, WindowDisablerWndClassName,
PChar(Application.Title), WS_POPUP, 0, 0, 0, 0, FOwnerWnd, 0,
HInstance, nil);

349
Projects/CmnFunc2.pas
View File

@ -2,7 +2,7 @@ unit CmnFunc2;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -18,28 +18,11 @@ interface
uses
Windows, SysUtils;
{ Delphi 2.01's RegStr unit should never be used because it contains many
wrong declarations. Delphi 3's RegStr unit doesn't have this problem, but
for backward compatibility, it defines a few of the correct registry key
constants here. }
const
{ Do NOT localize any of these }
NEWREGSTR_PATH_SETUP = 'Software\Microsoft\Windows\CurrentVersion';
NEWREGSTR_PATH_EXPLORER = NEWREGSTR_PATH_SETUP + '\Explorer';
NEWREGSTR_PATH_SPECIAL_FOLDERS = NEWREGSTR_PATH_EXPLORER + '\Shell Folders';
NEWREGSTR_PATH_UNINSTALL = NEWREGSTR_PATH_SETUP + '\Uninstall';
NEWREGSTR_VAL_UNINSTALLER_DISPLAYNAME = 'DisplayName';
NEWREGSTR_VAL_UNINSTALLER_COMMANDLINE = 'UninstallString';
KEY_WOW64_64KEY = $0100;
type
{$IFNDEF UNICODE}
PLeadByteSet = ^TLeadByteSet;
TLeadByteSet = set of AnsiChar;
{$ENDIF}
TOneShotTimer = {$IFDEF UNICODE} record {$ELSE} object {$ENDIF}
TOneShotTimer = record
private
FLastElapsed: Cardinal;
FStartTick: DWORD;
@ -88,7 +71,6 @@ function StringChange(var S: String; const FromStr, ToStr: String): Integer;
function StringChangeEx(var S: String; const FromStr, ToStr: String;
const SupportDBCS: Boolean): Integer;
function AdjustLength(var S: String; const Res: Cardinal): Boolean;
function UsingWinNT: Boolean;
function ConvertConstPercentStr(var S: String): Boolean;
function ConvertPercentStr(var S: String): Boolean;
function ConstPos(const Ch: Char; const S: String): Integer;
@ -111,10 +93,6 @@ function IsAdminLoggedOn: Boolean;
function IsPowerUserLoggedOn: Boolean;
function IsMultiByteString(const S: AnsiString): Boolean;
function FontExists(const FaceName: String): Boolean;
{$IFNDEF IS_D5}
procedure FreeAndNil(var Obj);
function SafeLoadLibrary(const Filename: String; ErrorMode: UINT): HMODULE;
{$ENDIF}
function GetUILanguage: LANGID;
function RemoveAccelChar(const S: String): String;
function GetTextWidth(const DC: HDC; S: String; const Prefix: Boolean): Integer;
@ -125,20 +103,9 @@ function IsWildcard(const Pattern: String): Boolean;
function WildcardMatch(const Text, Pattern: PChar): Boolean;
function IntMax(const A, B: Integer): Integer;
function Win32ErrorString(ErrorCode: Integer): String;
{$IFNDEF UNICODE}
procedure GetLeadBytes(var ALeadBytes: TLeadByteSet);
{$ENDIF}
{$IFNDEF IS_D3}
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
{$ENDIF}
function DeleteDirTree(const Dir: String): Boolean;
function SetNTFSCompression(const FileOrDir: String; Compress: Boolean): Boolean;
procedure AddToWindowMessageFilterEx(const Wnd: HWND; const Msg: UINT);
{$IFNDEF UNICODE}
type
TSysCharSet = set of AnsiChar;
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
{$ENDIF}
function ShutdownBlockReasonCreate(Wnd: HWND; const Reason: String): Boolean;
function ShutdownBlockReasonDestroy(Wnd: HWND): Boolean;
function TryStrToBoolean(const S: String; var BoolResult: Boolean): Boolean;
@ -147,17 +114,10 @@ function MoveFileReplace(const ExistingFileName, NewFileName: String): Boolean;
procedure TryEnableAutoCompleteFileSystem(Wnd: HWND);
procedure CreateMutex(const MutexName: String);
{$IFNDEF UNICODE}
var
ConstLeadBytes: PLeadByteSet = nil;
{$ENDIF}
implementation
uses
{$IFNDEF Delphi3orHigher} OLE2, ShlObj, {$ENDIF} PathFunc;
{$IFDEF Delphi3orHigher}
PathFunc;
{ Avoid including Variants (via ActiveX and ShlObj) in SetupLdr (SetupLdr uses CmnFunc2), saving 26 KB. }
@ -194,9 +154,8 @@ function SHGetMalloc(var ppMalloc: IMalloc): HResult; stdcall; external shell32
function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer;
var ppidl: PItemIDList): HResult; stdcall; external shell32 name 'SHGetSpecialFolderLocation';
function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall;
external shell32 name {$IFDEF UNICODE}'SHGetPathFromIDListW'{$ELSE}'SHGetPathFromIDListA'{$ENDIF};
external shell32 name 'SHGetPathFromIDListW';
{$ENDIF}
function InternalGetFileAttr(const Name: String): Integer;
begin
@ -592,11 +551,6 @@ begin
Exit;
end;
end;
else
{$IFNDEF UNICODE}
if S[Result] in ConstLeadBytes^ then
Inc(Result);
{$ENDIF}
end;
Inc(Result);
end;
@ -641,11 +595,6 @@ begin
Delete(S, I+1, 2);
S[I] := Chr(C);
end;
else
{$IFNDEF UNICODE}
if S[I] in ConstLeadBytes^ then
Inc(I);
{$ENDIF}
end;
Inc(I);
end;
@ -670,13 +619,8 @@ begin
if I = 0 then
Break;
end
else begin
{$IFNDEF UNICODE}
if S[I] in ConstLeadBytes^ then
Inc(I);
{$ENDIF}
else
Inc(I);
end;
end;
end;
@ -737,19 +681,13 @@ function GetSysWow64Dir: String;
Returns '' if there is no SysWow64 directory (e.g. running 32-bit Windows). }
var
GetSystemWow64DirectoryFunc: function(
lpBuffer: {$IFDEF UNICODE} PWideChar {$ELSE} PAnsiChar {$ENDIF};
uSize: UINT): UINT; stdcall;
lpBuffer: PWideChar; uSize: UINT): UINT; stdcall;
Res: Integer;
Buf: array[0..MAX_PATH] of Char;
begin
Result := '';
GetSystemWow64DirectoryFunc := GetProcAddress(GetModuleHandle(kernel32),
{$IFDEF UNICODE}
'GetSystemWow64DirectoryW'
{$ELSE}
'GetSystemWow64DirectoryA'
{$ENDIF} );
{ Note: This function does exist on 32-bit XP, but always returns 0 }
'GetSystemWow64DirectoryW');
if Assigned(GetSystemWow64DirectoryFunc) then begin
Res := GetSystemWow64DirectoryFunc(Buf, SizeOf(Buf) div SizeOf(Buf[0]));
if (Res > 0) and (Res < SizeOf(Buf) div SizeOf(Buf[0])) then
@ -764,9 +702,8 @@ begin
{ From MSDN: 32-bit applications can access the native system directory by
substituting %windir%\Sysnative for %windir%\System32. WOW64 recognizes
Sysnative as a special alias used to indicate that the file system should
not redirect the access. The Sysnative alias was added starting
with Windows Vista. }
if IsWin64 and (Lo(GetVersion) >= 6) then
not redirect the access. }
if IsWin64 then
{ Note: Avoiding GetWinDir here as that might not return the real Windows
directory under Terminal Services }
Result := PathExpand(AddBackslash(GetSystemDir) + '..\Sysnative') { Do not localize }
@ -786,13 +723,11 @@ begin
Result := GetEnv('TEMP');
if (Result <> '') and DirExists(Result) then
goto 1;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
{ Like Windows 2000's GetTempPath, return USERPROFILE when TMP and TEMP
are not set }
Result := GetEnv('USERPROFILE');
if (Result <> '') and DirExists(Result) then
goto 1;
end;
{ Like Windows 2000's GetTempPath, return USERPROFILE when TMP and TEMP
are not set }
Result := GetEnv('USERPROFILE');
if (Result <> '') and DirExists(Result) then
goto 1;
Result := GetWinDir;
1:Result := AddBackslash(PathExpand(Result));
end;
@ -851,13 +786,6 @@ begin
SetLength(S, Res);
end;
function UsingWinNT: Boolean;
{ Returns True if system is running any version of Windows NT. Never returns
True on Windows 95 or 3.1. }
begin
Result := Win32Platform = VER_PLATFORM_WIN32_NT;
end;
function InternalRegQueryStringValue(H: HKEY; Name: PChar; var ResultStr: String;
Type1, Type2: DWORD): Boolean;
var
@ -939,33 +867,8 @@ end;
function RegValueExists(H: HKEY; Name: PChar): Boolean;
{ Returns True if the specified value exists. Requires KEY_QUERY_VALUE access
to the key. }
var
I: Integer;
EnumName: array[0..1] of Char;
Count: DWORD;
ErrorCode: Longint;
begin
Result := RegQueryValueEx(H, Name, nil, nil, nil, nil) = ERROR_SUCCESS;
if Result and ((Name = nil) or (Name^ = #0)) and
(Win32Platform <> VER_PLATFORM_WIN32_NT) then begin
{ On Win9x/Me a default value always exists according to RegQueryValueEx,
so it must use RegEnumValue instead to check if a default value
really exists }
Result := False;
I := 0;
while True do begin
Count := SizeOf(EnumName) div SizeOf(EnumName[0]);
ErrorCode := RegEnumValue(H, I, EnumName, Count, nil, nil, nil, nil);
if (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ERROR_MORE_DATA) then
Break;
{ is it the default value? }
if (ErrorCode = ERROR_SUCCESS) and (EnumName[0] = #0) then begin
Result := True;
Break;
end;
Inc(I);
end;
end;
end;
function RegCreateKeyExView(const RegView: TRegView; hKey: HKEY; lpSubKey: PChar;
@ -989,8 +892,7 @@ end;
var
RegDeleteKeyExFunc: function(hKey: HKEY;
lpSubKey: {$IFDEF UNICODE} PWideChar {$ELSE} PAnsiChar {$ENDIF};
samDesired: REGSAM; Reserved: DWORD): Longint; stdcall;
lpSubKey: PWideChar; samDesired: REGSAM; Reserved: DWORD): Longint; stdcall;
function RegDeleteKeyView(const RegView: TRegView; const Key: HKEY;
const Name: PChar): Longint;
@ -1000,11 +902,7 @@ begin
else begin
if @RegDeleteKeyExFunc = nil then
RegDeleteKeyExFunc := GetProcAddress(GetModuleHandle(advapi32),
{$IFDEF UNICODE}
'RegDeleteKeyExW'
{$ELSE}
'RegDeleteKeyExA'
{$ENDIF} );
'RegDeleteKeyExW');
if Assigned(RegDeleteKeyExFunc) then
Result := RegDeleteKeyExFunc(Key, Name, KEY_WOW64_64KEY, 0)
else
@ -1026,32 +924,30 @@ begin
Result := ERROR_INVALID_PARAMETER;
Exit;
end;
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if RegOpenKeyExView(RegView, Key, Name, 0, KEY_ENUMERATE_SUB_KEYS, H) = ERROR_SUCCESS then begin
try
SetString(KeyName, nil, 256);
I := 0;
while True do begin
KeyNameCount := Length(KeyName);
ErrorCode := RegEnumKeyEx(H, I, @KeyName[1], KeyNameCount, nil, nil, nil, nil);
if ErrorCode = ERROR_MORE_DATA then begin
{ Double the size of the buffer and try again }
if Length(KeyName) >= 65536 then begin
{ Sanity check: If we tried a 64 KB buffer and it's still saying
there's more data, something must be seriously wrong. Bail. }
Break;
end;
SetString(KeyName, nil, Length(KeyName) * 2);
Continue;
end;
if ErrorCode <> ERROR_SUCCESS then
if RegOpenKeyExView(RegView, Key, Name, 0, KEY_ENUMERATE_SUB_KEYS, H) = ERROR_SUCCESS then begin
try
SetString(KeyName, nil, 256);
I := 0;
while True do begin
KeyNameCount := Length(KeyName);
ErrorCode := RegEnumKeyEx(H, I, @KeyName[1], KeyNameCount, nil, nil, nil, nil);
if ErrorCode = ERROR_MORE_DATA then begin
{ Double the size of the buffer and try again }
if Length(KeyName) >= 65536 then begin
{ Sanity check: If we tried a 64 KB buffer and it's still saying
there's more data, something must be seriously wrong. Bail. }
Break;
if RegDeleteKeyIncludingSubkeys(RegView, H, PChar(KeyName)) <> ERROR_SUCCESS then
Inc(I);
end;
SetString(KeyName, nil, Length(KeyName) * 2);
Continue;
end;
finally
RegCloseKey(H);
if ErrorCode <> ERROR_SUCCESS then
Break;
if RegDeleteKeyIncludingSubkeys(RegView, H, PChar(KeyName)) <> ERROR_SUCCESS then
Inc(I);
end;
finally
RegCloseKey(H);
end;
end;
Result := RegDeleteKeyView(RegView, Key, Name);
@ -1106,8 +1002,7 @@ var
StringSid: PWideChar;
begin
Result := '';
if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
{$IFDEF Delphi3orHigher} Token {$ELSE} @Token {$ENDIF}) then
if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token) then
Exit;
UserInfo := nil;
try
@ -1133,7 +1028,7 @@ end;
function IsMemberOfGroup(const DomainAliasRid: DWORD): Boolean;
{ Returns True if the logged-on user is a member of the specified local
group. Always returns True on Windows 9x/Me. }
group. }
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
@ -1150,11 +1045,6 @@ var
GroupInfo: PTokenGroups;
I: Integer;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then begin
Result := True;
Exit;
end;
Result := False;
if not AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
@ -1168,22 +1058,18 @@ begin
access token. This function eliminates potential misinterpretations of
the active group membership if changes to access tokens are made in
future releases." }
CheckTokenMembership := nil;
if Lo(GetVersion) >= 5 then
CheckTokenMembership := GetProcAddress(GetModuleHandle(advapi32),
'CheckTokenMembership');
CheckTokenMembership := GetProcAddress(GetModuleHandle(advapi32),
'CheckTokenMembership');
if Assigned(CheckTokenMembership) then begin
if CheckTokenMembership(0, Sid, IsMember) then
Result := IsMember;
end
else begin
else begin { Should never happen }
GroupInfo := nil;
if not OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
{$IFDEF Delphi3orHigher} Token {$ELSE} @Token {$ENDIF}) then begin
if not OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token) then begin
if GetLastError <> ERROR_NO_TOKEN then
Exit;
if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
{$IFDEF Delphi3orHigher} Token {$ELSE} @Token {$ENDIF}) then
if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token) then
Exit;
end;
try
@ -1217,7 +1103,7 @@ end;
function IsAdminLoggedOn: Boolean;
{ Returns True if the logged-on user is a member of the Administrators local
group. Always returns True on Windows 9x/Me. }
group. }
const
DOMAIN_ALIAS_RID_ADMINS = $00000220;
begin
@ -1226,7 +1112,7 @@ end;
function IsPowerUserLoggedOn: Boolean;
{ Returns True if the logged-on user is a member of the Power Users local
group. Always returns True on Windows 9x/Me. }
group. }
const
DOMAIN_ALIAS_RID_POWER_USERS = $00000223;
begin
@ -1265,42 +1151,6 @@ begin
end;
end;
{$IFNDEF IS_D5}
procedure FreeAndNil(var Obj);
var
Temp: TObject;
begin
Temp := TObject(Obj);
Pointer(Obj) := nil;
Temp.Free;
end;
{$ENDIF}
{$IFNDEF IS_D5}
function SafeLoadLibrary(const Filename: String; ErrorMode: UINT): HMODULE;
var
SaveErrorMode: UINT;
SaveFPUControlWord: Word;
begin
SaveErrorMode := SetErrorMode(ErrorMode);
try
asm
FNSTCW SaveFPUControlWord
end;
try
Result := LoadLibrary(PChar(Filename));
finally
asm
FNCLEX
FLDCW SaveFPUControlWord
end;
end;
finally
SetErrorMode(SaveErrorMode);
end;
end;
{$ENDIF}
function GetUILanguage: LANGID;
{ Platform-independent version of GetUserDefaultUILanguage. May return 0 in
case of failure. }
@ -1313,24 +1163,14 @@ begin
GetUserDefaultUILanguage := GetProcAddress(GetModuleHandle(kernel32),
'GetUserDefaultUILanguage');
if Assigned(GetUserDefaultUILanguage) then
{ This function is available on Windows 2000, Me, and later }
Result := GetUserDefaultUILanguage
else begin
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
{ Windows NT 4.0 }
if RegOpenKeyExView(rvDefault, HKEY_USERS, '.DEFAULT\Control Panel\International',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
RegQueryStringValue(K, 'Locale', S);
RegCloseKey(K);
end;
end
else begin
{ Windows 95/98 }
if RegOpenKeyExView(rvDefault, HKEY_CURRENT_USER, 'Control Panel\Desktop\ResourceLocale',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
RegQueryStringValue(K, '', S);
RegCloseKey(K);
end;
{ GetUserDefaultUILanguage is available on Windows 2000, Me, and later so
should never get here }
if RegOpenKeyExView(rvDefault, HKEY_USERS, '.DEFAULT\Control Panel\International',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
RegQueryStringValue(K, 'Locale', S);
RegCloseKey(K);
end;
Val('$' + S, Result, E);
if E <> 0 then
@ -1493,49 +1333,6 @@ begin
SetString(Result, Buffer, Len);
end;
{$IFNDEF UNICODE}
procedure GetLeadBytes(var ALeadBytes: TLeadByteSet);
var
AnsiCPInfo: TCPInfo;
I: Integer;
J: Byte;
begin
ALeadBytes := [];
if GetCPInfo(CP_ACP, AnsiCPInfo) then
with AnsiCPInfo do begin
I := 0;
while (I < MAX_LEADBYTES) and ((LeadByte[I] or LeadByte[I+1]) <> 0) do begin
for J := LeadByte[I] to LeadByte[I+1] do
Include(ALeadBytes, AnsiChar(J));
Inc(I, 2);
end;
end;
end;
{$ENDIF}
{$IFNDEF IS_D3}
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
asm
PUSH ESI
PUSH EDI
MOV ESI,P1
MOV EDI,P2
MOV EDX,ECX
XOR EAX,EAX
AND EDX,3
SHR ECX,1
SHR ECX,1
REPE CMPSD
JNE @@2
MOV ECX,EDX
REPE CMPSB
JNE @@2
@@1: INC EAX
@@2: POP EDI
POP ESI
end;
{$ENDIF}
function DeleteDirTree(const Dir: String): Boolean;
{ Removes the specified directory including any files/subdirectories inside
it. Returns True if successful. }
@ -1603,8 +1400,7 @@ var
action: DWORD; pChangeFilterStruct: Pointer): BOOL; stdcall;
procedure AddToWindowMessageFilter(const Msg: UINT);
{ Adds a single message number to the process-wide message filter on Windows
Vista and later. Has no effect on prior Windows versions. }
{ Adds a single message number to the process-wide message filter. }
const
MSGFLT_ADD = 1;
begin
@ -1618,9 +1414,9 @@ begin
end;
procedure AddToWindowMessageFilterEx(const Wnd: HWND; const Msg: UINT);
{ Adds a single message number to Wnd's window-specific message filter, which
is supported on Windows 7 and later. On Windows Vista, it falls back to
modifying the process-wide message filter. }
{ Adds a single message number to Wnd's window-specific message filter. Falls
back to modifying the process-wide message filter but in reality that should
never happen. }
const
MSGFLT_ALLOW = 1;
begin
@ -1635,34 +1431,18 @@ begin
AddToWindowMessageFilter(Msg);
end;
{$IFNDEF UNICODE}
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
begin
Result := C in CharSet;
end;
{$ENDIF}
function ShutdownBlockReasonCreate(Wnd: HWND; const Reason: String): Boolean;
var
ShutdownBlockReasonCreateFunc: function(Wnd: HWND; pwszReason: LPCWSTR): Bool; stdcall;
{$IFNDEF UNICODE}
Buf: array[0..4095] of WideChar;
{$ENDIF}
begin
{ MSDN doesn't say whether you must call Destroy before a second Create, but it does say a Destroy
without a previous Create is a no-op, so call Destroy for safety. }
ShutdownBlockReasonDestroy(Wnd);
ShutdownBlockReasonCreateFunc := GetProcAddress(GetModuleHandle(user32), 'ShutdownBlockReasonCreate');
if Assigned(ShutdownBlockReasonCreateFunc) then begin
{$IFDEF UNICODE}
Result := ShutdownBlockReasonCreateFunc(Wnd, PChar(Reason));
{$ELSE}
Buf[MultiByteToWideChar(CP_ACP, 0, PChar(Reason), Length(Reason), Buf,
(SizeOf(Buf) div SizeOf(Buf[0])) - 1)] := #0;
Result := ShutdownBlockReasonCreateFunc(Wnd, Buf);
{$ENDIF}
end else
if Assigned(ShutdownBlockReasonCreateFunc) then
Result := ShutdownBlockReasonCreateFunc(Wnd, PChar(Reason))
else
Result := False;
end;
@ -1698,15 +1478,8 @@ end;
function MoveFileReplace(const ExistingFileName, NewFileName: String): Boolean;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
Result := MoveFileEx(PChar(ExistingFileName), PChar(NewFileName),
MOVEFILE_REPLACE_EXISTING);
end
else begin
Result := DeleteFile(PChar(NewFileName));
if Result or (GetLastError = ERROR_FILE_NOT_FOUND) then
Result := MoveFile(PChar(ExistingFileName), PChar(NewFileName));
end;
Result := MoveFileEx(PChar(ExistingFileName), PChar(NewFileName),
MOVEFILE_REPLACE_EXISTING);
end;
var

74
Projects/CompExeUpdate.pas
View File

@ -2,7 +2,7 @@ unit CompExeUpdate;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -17,23 +17,22 @@ uses
{$I VERSION.INC}
procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
const IsVistaCompatible, IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
procedure UpdateIcons(const FileName, IcoFileName: String; const DeleteUninstallIcon: Boolean);
procedure UpdateVersionInfo(const F: TCustomFile;
const NewBinaryFileVersion, NewBinaryProductVersion: TFileVersionNumbers;
const NewCompanyName, NewFileDescription, NewTextFileVersion, NewLegalCopyright,
NewProductName, NewTextProductVersion, NewOriginalFileName: String;
const SetFileVersionAndDescription: Boolean);
procedure RemoveManifestDllHijackProtection(const F: TCustomFile; const TestBlockOnly: Boolean);
procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
implementation
uses
ResUpdate{$IFDEF UNICODE}, Math{$ENDIF}, Int64Em;
ResUpdate, Math, Int64Em;
procedure UpdateSetupPEHeaderFields(const F: TCustomFile;
const IsVistaCompatible, IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
const IsTSAware, IsDEPCompatible, IsASLRCompatible: Boolean);
function SeekToPEHeader(const F: TCustomFile): Boolean;
var
@ -69,9 +68,6 @@ var
Header: TImageFileHeader;
Ofs: Cardinal;
OptMagic, DllChars, OrigDllChars: Word;
VersionRecord: packed record
Major, Minor: Word;
end;
begin
if SeekToPEHeader(F) then begin
if (F.Read(Header, SizeOf(Header)) = SizeOf(Header)) and
@ -79,32 +75,6 @@ begin
Ofs := F.Position.Lo;
if (F.Read(OptMagic, SizeOf(OptMagic)) = SizeOf(OptMagic)) and
(OptMagic = IMAGE_NT_OPTIONAL_HDR32_MAGIC) then begin
if IsVistaCompatible then begin
{ Update OS/Subsystem version }
VersionRecord.Major := 6;
VersionRecord.Minor := 0;
F.Seek(Ofs + OffsetOfOperatingSystemVersion);
F.WriteBuffer(VersionRecord, SizeOf(VersionRecord));
F.Seek(Ofs + OffsetOfSubsystemVersion);
F.WriteBuffer(VersionRecord, SizeOf(VersionRecord));
end;
{ Update MajorImageVersion and MinorImageVersion to 6.0.
Works around apparent bug in Vista (still present in Vista SP1;
not reproducible on Server 2008): When UAC is turned off,
launching an uninstaller (as admin) from ARP and answering No at the
ConfirmUninstall message box causes a "This program might not have
uninstalled correctly" dialog to be displayed, even if the EXE
has a proper "Vista-aware" manifest. I discovered that if the EXE's
image version is set to 6.0, like the EXEs that ship with Vista
(notepad.exe), the dialog does not appear. (This is reproducible
with notepad.exe too if its image version is changed to anything
other than 6.0 exactly.) }
VersionRecord.Major := 6;
VersionRecord.Minor := 0;
F.Seek(Ofs + OffsetOfImageVersion);
F.WriteBuffer(VersionRecord, SizeOf(VersionRecord));
{ Update DllCharacteristics }
F.Seek(Ofs + OffsetOfDllCharacteristics);
if F.Read(DllChars, SizeOf(DllChars)) = SizeOf(DllChars) then begin
@ -247,11 +217,7 @@ procedure UpdateVersionInfo(const F: TCustomFile;
begin
if not QueryValue(P, Path, Pointer(Value), ValueLen) then
ResUpdateError('Unexpected version resource format (1)');
{$IFDEF UNICODE}
Move(Pointer(NewValue)^, Value^, (Min(Length(NewValue), lstrlenW(Value)))*SizeOf(Char));
{$ELSE}
MultiByteToWideChar(CP_ACP, 0, PChar(NewValue), Length(NewValue), Value, lstrlenW(Value));
{$ENDIF}
ReplaceWithRealCopyrightSymbols(Value);
end;
@ -426,9 +392,6 @@ var
N: Cardinal;
NewGroupIconDirSize: LongInt;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
ResUpdateError('Only supported on Windows NT and above');
Ico := nil;
try
@ -500,35 +463,6 @@ begin
end;
end;
procedure RemoveManifestDllHijackProtection(const F: TCustomFile; const TestBlockOnly: Boolean);
const
BlockStartText: AnsiString = '<file name="';
BlockLength = 380;
var
S: AnsiString;
Offset: Integer64;
P: Integer;
begin
{ Read the manifest resource into a string }
SetString(S, nil, SeekToResourceData(F, 24, 1));
Offset := F.Position;
F.ReadBuffer(S[1], Length(S));
{ Locate and update the block with file elements }
P := Pos(BlockStartText, S);
if P = 0 then
ResUpdateError('Block not found');
if Copy(S, P+BlockLength, 11) <> '</assembly>' then
ResUpdateError('Block too short (BlockLength should be '+string(IntToStr(Pos('</assembly>', string(S))-P)+'): '+string(Copy(S, P+BlockLength, 11))));
if TestBlockOnly then
Exit;
Inc64(Offset, P-1);
F.Seek64(Offset);
F.WriteAnsiString(AnsiString(Format('%*s', [BlockLength, ' '])));
end;
procedure PreventCOMCTL32Sideloading(const F: TCustomFile);
const
DependencyStartTag: AnsiString = '<dependency>';

51
Projects/CompForm.pas
View File

@ -511,17 +511,13 @@ type
procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
{$IFDEF IS_D4}
protected
procedure WndProc(var Message: TMessage); override;
{$ENDIF}
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{$IFDEF IS_D5}
function IsShortCut(var Message: TWMKey): Boolean; override;
{$ENDIF}
end;
var
@ -759,13 +755,6 @@ begin
editor's autocompletion list }
SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
{$IFNDEF IS_D103RIO}
{ TStatusBar needs manual scaling before Delphi 10.3 Rio }
StatusBar.Height := ToPPI(StatusBar.Height);
for I := 0 to StatusBar.Panels.Count-1 do
StatusBar.Panels[I].Width := ToPPI(StatusBar.Panels[I].Width);
{$ENDIF}
PopupMenu := TCompileFormMemoPopupMenu.Create(Self);
FMemosStyler := TInnoSetupStyler.Create(Self);
@ -951,7 +940,6 @@ begin
UpdateStatusPanelHeight(StatusPanel.Height);
end;
{$IFDEF IS_D4}
procedure TCompileForm.WndProc(var Message: TMessage);
begin
{ Without this, the status bar's owner drawn panels sometimes get corrupted and show
@ -964,11 +952,9 @@ begin
if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
CtlType := ODT_STATIC;
end;
inherited
inherited
end;
{$ENDIF}
{$IFDEF IS_D5}
function TCompileForm.IsShortCut(var Message: TWMKey): Boolean;
begin
{ Key messages are forwarded by the VCL to the main form for ShortCut
@ -980,7 +966,6 @@ begin
else
Result := False;
end;
{$ENDIF}
procedure TCompileForm.UpdateCaption;
var
@ -1720,8 +1705,8 @@ begin
ElapsedTime := GetTickCount - StartTime;
ElapsedSeconds := ElapsedTime div 1000;
StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
ElapsedSeconds mod 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator, ElapsedTime mod 1000])]));
Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
finally
AppData.Lines.Free;
FCompiling := False;
@ -3889,11 +3874,10 @@ procedure TCompileForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
S: TScintRawString;
U: String;
begin
{ On the Unicode build, [Code] lines get converted from the editor's
UTF-8 to UTF-16 Strings when passed to the compiler. This can lead to
column number discrepancies between Scintilla and ROPS. This code
simulates the conversion to try to find out where ROPS thinks a Pos
resides. }
{ [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
passed to the compiler. This can lead to column number discrepancies
between Scintilla and ROPS. This code simulates the conversion to try to
find out where ROPS thinks a Pos resides. }
LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
S := FActiveMemo.GetRawTextRange(LinePos, Pos);
U := FActiveMemo.ConvertRawStringToString(S);
@ -4636,21 +4620,18 @@ begin
Info.lpDirectory := PChar(WorkingDir);
Info.nShow := SW_SHOWNORMAL;
{ Disable windows so that the user can't click other things while a "Run as"
dialog is up on Windows 2000/XP (they aren't system modal like on Vista) }
dialog is up but is not system modal (which it is currently) }
SaveFocusWindow := GetFocus;
WindowList := DisableTaskWindows(0);
try
{ Also temporarily remove the focus since a disabled window's children can
still receive keystrokes. This is needed on Vista if the UAC dialog
doesn't come to the foreground for some reason (e.g. if the following
SetActiveWindow call is removed). }
still receive keystrokes. This is needed if the UAC dialog doesn't come to
the foreground for some reason (e.g. if the following SetActiveWindow call
is removed). }
Windows.SetFocus(0);
{ On Vista, when disabling windows, we have to make the application window
the active window, otherwise the UAC dialog doesn't come to the
foreground automatically. Note: This isn't done on older versions simply
to avoid unnecessary title bar flicker. }
if Win32MajorVersion >= 6 then
SetActiveWindow(Application.Handle);
{ We have to make the application window the active window, otherwise the
UAC dialog doesn't come to the foreground automatically. }
SetActiveWindow(Application.Handle);
ShellExecuteResult := ShellExecuteEx(@Info);
ErrorCode := GetLastError;
finally
@ -5043,8 +5024,8 @@ begin
if ASecondsRemaining >= 0 then
StatusBar.Panels[spExtraStatus].Text := Format(
' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
[(ASecondsRemaining div 60) div 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
(ASecondsRemaining div 60) mod 60, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
[(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
(ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
else
StatusBar.Panels[spExtraStatus].Text := '';

11
Projects/CompFunc.pas
View File

@ -119,7 +119,7 @@ begin
end;
procedure AddFileToRecentDocs(const Filename: String);
{ Notifies the shell that a document has been opened. On Windows 7, this will
{ Notifies the shell that a document has been opened. This will
add the file to the Recent section of the app's Jump List.
It is only necessary to call this function when the shell is unaware that
a file is being opened. Files opened through Explorer or common dialogs get
@ -354,8 +354,8 @@ var
begin
if LineNumber = 0 then begin
{ Don't forget about ListBox's DrawItem if you change the format of the following timestamp. }
Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u] ', [ST.wHour, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator,
ST.wMinute, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator, ST.wSecond, {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DecimalSeparator,
Insert(Format('[%.2u%s%.2u%s%.2u%s%.3u] ', [ST.wHour, FormatSettings.TimeSeparator,
ST.wMinute, FormatSettings.TimeSeparator, ST.wSecond, FormatSettings.DecimalSeparator,
ST.wMilliseconds]), S, 1);
end else begin
Insert(#9, S, 1); { Not actually painted - just for Ctrl+C }
@ -466,10 +466,7 @@ var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
Dir := GetSystemDir
else
Dir := GetWinDir;
Dir := GetSystemDir;
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);

14
Projects/CompMsgs.pas
View File

@ -2,7 +2,7 @@ unit CompMsgs;
{
Inno Setup
Copyright (C) 1997-2021 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -184,15 +184,13 @@ const
SCompilerEntryInvalid2 = 'Value of [%s] section directive "%s" is invalid';
SCompilerEntryAlreadySpecified = '[%s] section directive "%s" already specified';
SCompilerAppVersionOrAppVerNameRequired = 'The [Setup] section must include an AppVersion or AppVerName directive';
SCompilerMinVersionWinMustBeZero = 'Minimum Windows version specified by MinVersion must be 0. (Windows 95/98/Me are no longer supported.)';
SCompilerMinVersionNTTooLow = 'Minimum NT version specified by MinVersion must be at least %s. (Windows 2000/XP/Server 2003 are no longer supported.)';
SCompilerMinVersionRecommendation = 'Minimum NT version is set to %s but using %s instead (which is the default) is recommended.';
SCompilerMinVersionWinMustBeZero = 'Minimum non NT version specified by MinVersion must be 0. (Windows 95/98/Me are no longer supported.)';
SCompilerMinVersionNTTooLow = 'Minimum version specified by MinVersion must be at least %s. (Windows Vista/Server 2008 are no longer supported.)';
SCompilerMinVersionRecommendation = 'Minimum version is set to %s but using %s instead (which is the default) is recommended.';
SCompilerDiskSliceSizeInvalid = 'DiskSliceSize must be between %d and %d, or "max"';
SCompilerDiskClusterSizeInvalid = 'DiskClusterSize must be between 1 and 32768';
SCompilerInstallModeObsolete = 'The [%s] section directive "%s" is obsolete and ignored in this version of Inno Setup. Use command line parameters instead.';
SCompilerMessagesFileObsolete = 'The MessagesFile directive is obsolete and no longer supported. Use the [Languages] section instead.';
SCompilerDirectiveIsNTOnly = 'The [%s] section directive "%s" may not be used when compiling on Windows 95/98/Me';
SCompilerDirectiveRequiresWindows2000 = 'The [%s] section directive "%s" may not be used when compiling on Windows 95/98/Me/NT4';
SCompilerMustUseDisableStartupPrompt = 'DisableStartupPrompt must be set to "yes" when AppName includes constants';
SCompilerMustNotUsePreviousLanguage = 'UsePreviousLanguage must be set to "no" when AppId includes constants';
SCompilerMustNotUsePreviousPrivileges = 'UsePreviousPrivileges must be set to "no" when AppId includes constants and PrivilegesRequiredOverridesAllowed allows "dialog"';
@ -200,8 +198,6 @@ const
SCompilerDirectiveNotUsingPreferredDefault = 'The [Setup] section directive "%s" is defaulting to %s because %s includes constants.';
SCompilerDirectivePatternTooLong = 'The [Setup] section directive "%s" contains a pattern that is too long';
SCompilerOutputBaseFileNameSetup = 'Setting the [Setup] section directive "OutputBaseFileName" to "setup" is not recommended: all executables named "setup.exe" are shimmed by Windows application compatibility to load additional DLLs, such as version.dll.' + ' These DLLs are loaded unsafely by Windows and can be hijacked. Use a different name, for example "mysetup".';
SCompilerRemoveManifestDllHijackProtection = 'Setting the [Setup] section directive "MinVersion" below %s is not recommended: Windows Vista doesn''t support some of Setup''s security measures against potential DLL preloading attacks so these have been' + ' removed by the compiler making your installer less secure on all versions of Windows.';
SCompilerDidntRemoveManifestDllHijackProtection = 'Setup will not run on Windows Vista: MinVersion must be below %s.';
SCompilerWizImageRenamed = 'Wizard image "%s" has been renamed. Use "%s" instead or consider removing the directive to use modern built-in wizard images.';
{ Signing }
@ -355,8 +351,6 @@ const
SCompilerFilesCantHaveNonExternalExternalSize = 'Parameter "ExternalSize" may only be used when ' +
'the "external" flag is used';
SCompilerFilesExcludeTooLong = 'Parameter "Excludes" contains a pattern that is too long';
SCompilerFilesCantReadVersionInfoOn64BitImage = 'In order for it to be able to read version info on 64-bit images, ' +
'the compiler must be run under Windows 2000 or later';
SCompilerFilesUnsafeFile = 'Unsafe file detected: %s.' + SNewLine2 +
'See the "Unsafe Files" topic in the help file for more information';
SCompilerFilesSystemDirUsed = 'Attempt to deploy DLL file from own Windows System directory.' + SNewLine2 +

2
Projects/CompOptions.dfm
View File

@ -89,7 +89,7 @@ object OptionsForm: TOptionsForm
Top = 196
Width = 265
Height = 17
Caption = '*'
Caption = 'Always &launch Setup/Uninstall as administrator'
TabOrder = 9
end
object ColorizeCompilerOutputCheck: TCheckBox

12
Projects/CompOptions.pas
View File

@ -2,7 +2,7 @@ unit CompOptions;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -72,16 +72,6 @@ procedure TOptionsForm.FormCreate(Sender: TObject);
begin
InitFormFont(Self);
{ On Windows Vista, you can only select administrator accounts in a "Run as"
dialog. On Windows 2000/XP/2003, you can select any account. Earlier
versions of Windows don't support "Run as" at all, so disable the check
box there. }
if Win32MajorVersion >= 6 then
RunAsDifferentUserCheck.Caption := 'Always &launch Setup/Uninstall as administrator'
else
RunAsDifferentUserCheck.Caption := 'Always &launch Setup/Uninstall as different user';
RunAsDifferentUserCheck.Enabled := (Win32MajorVersion >= 5);
{ Order must match TThemeType. }
ThemeComboBox.Items.Add('Light');
ThemeComboBox.Items.Add('Dark');

16
Projects/Compil32.dpr
View File

@ -2,7 +2,7 @@ program Compil32;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -46,11 +46,13 @@ uses
BidiUtils in '..\Components\BidiUtils.pas',
DropListBox in '..\Components\DropListBox.pas',
NewCheckListBox in '..\Components\NewCheckListBox.pas',
NewNotebook in '..\Components\NewNotebook.pas';
NewNotebook in '..\Components\NewNotebook.pas',
TaskbarProgressFunc in 'TaskbarProgressFunc.pas',
HtmlHelpFunc in 'HtmlHelpFunc.pas';
{$SetPEFlags IMAGE_FILE_RELOCS_STRIPPED}
{$SETPEOSVERSION 6.0}
{$SETPESUBSYSVERSION 6.0}
{$SETPEOSVERSION 6.1}
{$SETPESUBSYSVERSION 6.1}
{$WEAKLINKRTTI ON}
{$R Compil32.docicon.res}
@ -61,9 +63,9 @@ procedure SetAppUserModelID;
var
Func: function(AppID: PWideChar): HRESULT; stdcall;
begin
{ On Windows 7, for the IDE to be pinnable and show a Jump List, it is
necessary to explicitly assign an AppUserModelID because by default the
taskbar excludes applications that have "Setup" in their name. }
{ For the IDE to be pinnable and show a Jump List, it is necessary to
explicitly assign an AppUserModelID because by default the taskbar excludes
applications that have "Setup" in their name. }
Func := GetProcAddress(GetModuleHandle('shell32.dll'),
'SetCurrentProcessExplicitAppUserModelID');
if Assigned(Func) then

3
Projects/Compil32.dproj
View File

@ -78,6 +78,7 @@
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="SafeDLLPath.pas"/>
<DCCReference Include="..\Components\PathFunc.pas"/>
<DCCReference Include="CompForm.pas">
<Form>CompileForm</Form>
</DCCReference>
@ -127,6 +128,8 @@
<DCCReference Include="..\Components\DropListBox.pas"/>
<DCCReference Include="..\Components\NewCheckListBox.pas"/>
<DCCReference Include="..\Components\NewNotebook.pas"/>
<DCCReference Include="TaskbarProgressFunc.pas"/>
<DCCReference Include="HtmlHelpFunc.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

281
Projects/Compile.pas
View File

@ -62,13 +62,11 @@ type
FileLineNumber: Integer;
end;
{$IFDEF UNICODE}
TPreLangData = class
public
Name: String;
LanguageCodePage: Integer;
end;
{$ENDIF}
TLangData = class
public
@ -193,7 +191,7 @@ type
PreprocOutput: String;
DefaultLangData: TLangData;
{$IFDEF UNICODE} PreLangDataList, {$ENDIF} LangDataList: TList;
PreLangDataList, LangDataList: TList;
SignToolList: TList;
SignTools, SignToolsParams: TStringList;
SignToolRetryCount, SignToolRetryDelay, SignToolMinimumTimeBetween: Integer;
@ -283,13 +281,9 @@ type
procedure EnumDirsProc(const Line: PChar; const Ext: Integer);
procedure EnumIconsProc(const Line: PChar; const Ext: Integer);
procedure EnumINIProc(const Line: PChar; const Ext: Integer);
{$IFDEF UNICODE}
procedure EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
{$ENDIF}
procedure EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
{$IFDEF UNICODE}
procedure EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
{$ENDIF}
procedure EnumLanguagesProc(const Line: PChar; const Ext: Integer);
procedure EnumRegistryProc(const Line: PChar; const Ext: Integer);
procedure EnumDeleteProc(const Line: PChar; const Ext: Integer);
@ -305,9 +299,7 @@ type
function GetLZMAExeFilename(const Allow64Bit: Boolean): String;
procedure InitBzipDLL;
procedure InitCryptDLL;
{$IFDEF UNICODE}
procedure InitPreLangData(const APreLangData: TPreLangData);
{$ENDIF}
procedure InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
procedure InitLZMADLL;
procedure InitPreprocessor;
@ -331,13 +323,9 @@ type
procedure ProcessWildcardsParameter(const ParamData: String;
const AWildcards: TStringList; const TooLongMsg: String);
procedure ReadDefaultMessages;
{$IFDEF UNICODE}
procedure ReadMessagesFromFilesPre(const AFiles: String; const ALangIndex: Integer);
{$ENDIF}
procedure ReadMessagesFromFiles(const AFiles: String; const ALangIndex: Integer);
{$IFDEF UNICODE}
procedure ReadMessagesFromScriptPre;
{$ENDIF}
procedure ReadMessagesFromScript;
function ReadScriptFile(const Filename: String; const UseCache: Boolean;
const AnsiConvertCodePage: Cardinal): TScriptFileLines;
@ -372,9 +360,6 @@ type
end;
var
{$IFNDEF UNICODE}
CompilerLeadBytes: TLeadByteSet;
{$ENDIF}
ZipInitialized, BzipInitialized, LZMAInitialized, CryptInitialized: Boolean;
PreprocessorInitialized: Boolean;
PreprocessScriptProc: TPreprocessScriptProc;
@ -714,41 +699,6 @@ begin
F.Seek(0);
end;
function Is64BitPEImage(const Filename: String): Boolean;
{ Returns True if the specified file is a non-32-bit PE image, False
otherwise. }
var
F: TFile;
DosHeader: packed record
Sig: array[0..1] of AnsiChar;
Other: array[0..57] of Byte;
PEHeaderOffset: LongWord;
end;
PESigAndHeader: packed record
Sig: DWORD;
Header: TImageFileHeader;
OptHeaderMagic: Word;
end;
begin
Result := False;
F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
try
if F.Read(DosHeader, SizeOf(DosHeader)) = SizeOf(DosHeader) then begin
if (DosHeader.Sig[0] = 'M') and (DosHeader.Sig[1] = 'Z') and
(DosHeader.PEHeaderOffset <> 0) then begin
F.Seek(DosHeader.PEHeaderOffset);
if F.Read(PESigAndHeader, SizeOf(PESigAndHeader)) = SizeOf(PESigAndHeader) then begin
if (PESigAndHeader.Sig = IMAGE_NT_SIGNATURE) and
(PESigAndHeader.OptHeaderMagic <> IMAGE_NT_OPTIONAL_HDR32_MAGIC) then
Result := True;
end;
end;
end;
finally
F.Free;
end;
end;
function CountChars(const S: String; C: Char): Integer;
var
I: Integer;
@ -817,13 +767,8 @@ begin
if Result[I] = '{' then
Delete(Result, I, 1);
end
else begin
{$IFNDEF UNICODE}
if Result[I] in CompilerLeadBytes then
Inc(I);
{$ENDIF}
else
Inc(I);
end;
end;
end;
@ -1556,9 +1501,7 @@ begin
UsedUserAreas.Duplicates := dupIgnore;
PreprocIncludedFilenames := TStringList.Create;
DefaultLangData := TLangData.Create;
{$IFDEF UNICODE}
PreLangDataList := TLowFragList.Create;
{$ENDIF}
LangDataList := TLowFragList.Create;
SignToolList := TLowFragList.Create;
SignTools := TStringList.Create;
@ -1591,9 +1534,7 @@ begin
SignToolList.Free;
end;
LangDataList.Free;
{$IFDEF UNICODE}
PreLangDataList.Free;
{$ENDIF}
DefaultLangData.Free;
PreprocIncludedFilenames.Free;
UsedUserAreas.Free;
@ -1622,8 +1563,6 @@ end;
procedure TSetupCompiler.InitPreprocessor;
{$IFNDEF STATICPREPROC}
const
FuncNameSuffix = {$IFDEF UNICODE} 'W' {$ELSE} 'A' {$ENDIF};
var
Filename: String;
Attr: DWORD;
@ -1643,8 +1582,7 @@ begin
if M = 0 then
AbortCompileFmt('Failed to load preprocessor DLL "%s" (%d)',
[Filename, GetLastError]);
PreprocessScriptProc := GetProcAddress(M,
PAnsiChar('ISPreprocessScript' + FuncNameSuffix));
PreprocessScriptProc := GetProcAddress(M, 'ISPreprocessScriptW');
if not Assigned(PreprocessScriptProc) then
AbortCompileFmt('Failed to get address of functions in "%s"', [Filename]);
end;
@ -2203,7 +2141,6 @@ var
UseCache := not (LangSection and LangSectionPre);
AnsiConvertCodePage := 0;
{$IFDEF UNICODE}
if LangSection then begin
{ During a Pre pass on an .isl file, use code page 1252 for translation.
Previously, the system code page was used, but on DBCS that resulted in
@ -2219,7 +2156,6 @@ var
AnsiConvertCodePage := TPreLangData(PreLangDataList[Ext]).LanguageCodePage;
end;
end;
{$ENDIF}
Lines := ReadScriptFile(Filename, UseCache, AnsiConvertCodePage);
try
@ -2822,13 +2758,7 @@ begin
1:{ Constant is OK }
end;
{$IFDEF UNICODE}
end;
{$ELSE}
end
else if S[I] in CompilerLeadBytes then
Inc(I);
{$ENDIF}
Inc(I);
end;
end;
@ -2848,7 +2778,7 @@ begin
Decl := '0';
for I := Low(Parameters) to High(Parameters) do begin
if Parameters[I].VType = {$IFDEF UNICODE} vtUnicodeString {$ELSE} vtAnsiString {$ENDIF} then
if Parameters[I].VType = vtUnicodeString then
Decl := Decl + ' @String'
else if Parameters[I].VType = vtInteger then
Decl := Decl + ' @LongInt'
@ -3251,18 +3181,15 @@ procedure TSetupCompiler.ReadTextFile(const Filename: String; const LangIndex: I
var
F: TFile;
Size: Cardinal;
{$IFDEF UNICODE}
UnicodeFile, RTFFile: Boolean;
AnsiConvertCodePage: Integer;
S: RawByteString;
U: String;
{$ENDIF}
begin
try
F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
try
Size := F.Size.Lo;
{$IFDEF UNICODE}
SetLength(S, Size);
F.ReadBuffer(S[1], Size);
@ -3291,10 +3218,6 @@ begin
Text := S;
end else
Text := S;
{$ELSE}
SetLength(Text, Size);
F.ReadBuffer(Text[1], Size);
{$ENDIF}
finally
F.Free;
end;
@ -3926,10 +3849,6 @@ begin
CompressProps.WorkerProcessFilename := GetLZMAExeFilename(True)
else
CompressProps.WorkerProcessFilename := '';
if (CompressProps.WorkerProcessFilename <> '') and
(Byte(GetVersion()) < 5) then
AbortCompileOnLineFmt(SCompilerDirectiveRequiresWindows2000,
['Setup', KeyName]);
end;
ssMergeDuplicateFiles: begin
DontMergeDuplicateFiles := not StrToBool(Value);
@ -3942,8 +3861,8 @@ begin
Invalid;
if SetupHeader.MinVersion.WinVersion <> 0 then
AbortCompileOnLine(SCompilerMinVersionWinMustBeZero);
if SetupHeader.MinVersion.NTVersion < $06000000 then
AbortCompileOnLineFmt(SCompilerMinVersionNTTooLow, ['6.0']);
if SetupHeader.MinVersion.NTVersion < $06010000 then
AbortCompileOnLineFmt(SCompilerMinVersionNTTooLow, ['6.1']);
end;
ssMissingMessagesWarning: begin
MissingMessagesWarning := StrToBool(Value);
@ -4005,8 +3924,6 @@ begin
SetSetupHeaderOption(shRestartIfNeededByRun);
end;
ssSetupIconFile: begin
if (Value <> '') and (Win32Platform <> VER_PLATFORM_WIN32_NT) then
AbortCompileOnLineFmt(SCompilerDirectiveIsNTOnly, ['Setup', KeyName]);
SetupIconFilename := Value;
end;
ssSetupLogging: begin
@ -4030,11 +3947,7 @@ begin
SetSetupHeaderOption(shShowTasksTreeLines);
end;
ssShowUndisplayableLanguages: begin
{$IFDEF UNICODE}
WarningsList.Add(Format(SCompilerEntryObsolete, ['Setup', KeyName]));
{$ELSE}
SetSetupHeaderOption(shShowUndisplayableLanguages);
{$ENDIF}
end;
ssSignedUninstaller: begin
SetSetupHeaderOption(shSignedUninstaller);
@ -4278,7 +4191,6 @@ function TSetupCompiler.FindLangEntryIndexByName(const AName: String;
var
I: Integer;
begin
{$IFDEF UNICODE}
if Pre then begin
for I := 0 to PreLangDataList.Count-1 do begin
if TPreLangData(PreLangDataList[I]).Name = AName then begin
@ -4288,7 +4200,6 @@ begin
end;
AbortCompileOnLineFmt(SCompilerUnknownLanguage, [AName]);
end;
{$ENDIF}
for I := 0 to LanguageEntries.Count-1 do begin
if PSetupLanguageEntry(LanguageEntries[I]).Name = AName then begin
@ -4313,7 +4224,6 @@ begin
Result := -1;
end;
{$IFDEF UNICODE}
procedure TSetupCompiler.EnumLangOptionsPreProc(const Line: PChar; const Ext: Integer);
procedure ApplyToLangEntryPre(const KeyName, Value: String;
@ -4366,7 +4276,6 @@ begin
end else
ApplyToLangEntryPre(KeyName, Value, TPreLangData(PreLangDataList[LangIndex]), False);
end;
{$ENDIF}
procedure TSetupCompiler.EnumLangOptionsProc(const Line: PChar; const Ext: Integer);
@ -4445,7 +4354,7 @@ procedure TSetupCompiler.EnumLangOptionsProc(const Line: PChar; const Ext: Integ
lsLanguageCodePage: begin
if AffectsMultipleLangs then
AbortCompileOnLineFmt(SCompilerCantSpecifyLangOption, [KeyName]);
{$IFNDEF UNICODE}LangOptions.LanguageCodePage := {$ENDIF}StrToIntCheck(Value);
StrToIntCheck(Value);
end;
lsLanguageID: begin
if AffectsMultipleLangs then
@ -4881,35 +4790,14 @@ type
mkcPgDn, mkcEnd, mkcHome, mkcLeft, mkcUp, mkcRight, mkcDown, mkcIns,
mkcDel, mkcShift, mkcCtrl, mkcAlt);
{$IFDEF Delphi3OrHigher}
var
MenuKeyCaps: array[TMenuKeyCap] of string = (
SmkcBkSp, SmkcTab, SmkcEsc, SmkcEnter, SmkcSpace, SmkcPgUp,
SmkcPgDn, SmkcEnd, SmkcHome, SmkcLeft, SmkcUp, SmkcRight,
SmkcDown, SmkcIns, SmkcDel, SmkcShift, SmkcCtrl, SmkcAlt);
{$ELSE}
var
MenuKeyCaps: array[TMenuKeyCap] of string;
const
MenuKeyCapIDs: array[TMenuKeyCap] of Word = (
SmkcBkSp, SmkcTab, SmkcEsc, SmkcEnter, SmkcSpace, SmkcPgUp,
SmkcPgDn, SmkcEnd, SmkcHome, SmkcLeft, SmkcUp, SmkcRight,
SmkcDown, SmkcIns, SmkcDel, SmkcShift, SmkcCtrl, SmkcAlt);
{$ENDIF}
procedure TSetupCompiler.EnumIconsProc(const Line: PChar; const Ext: Integer);
{$IFNDEF Delphi3OrHigher}
procedure LoadStrings;
var
I: TMenuKeyCap;
begin
for I := Low(TMenuKeyCap) to High(TMenuKeyCap) do
MenuKeyCaps[I] := LoadStr(MenuKeyCapIDs[I]);
end;
{$ENDIF}
function HotKeyToText(HotKey: Word): string;
function GetSpecialName(HotKey: Word): string;
@ -5028,19 +4916,15 @@ const
(Name: ParamCommonAfterInstall; Flags: []),
(Name: ParamCommonMinVersion; Flags: []),
(Name: ParamCommonOnlyBelowVersion; Flags: []));
Flags: array[0..9] of PChar = (
Flags: array[0..8] of PChar = (
'uninsneveruninstall', 'runminimized', 'createonlyiffileexists',
'useapppaths', 'closeonexit', 'dontcloseonexit', 'runmaximized',
'foldershortcut', 'excludefromshowinnewinstall', 'preventpinning');
'excludefromshowinnewinstall', 'preventpinning');
var
Values: array[TParam] of TParamValue;
NewIconEntry: PSetupIconEntry;
S: String;
begin
{$IFNDEF Delphi3OrHigher}
LoadStrings;
{$ENDIF}
ExtractParameters(Line, ParamInfo, Values);
NewIconEntry := AllocMem(SizeOf(TSetupIconEntry));
@ -5061,9 +4945,8 @@ begin
4: CloseOnExit := icYes;
5: CloseOnExit := icNo;
6: ShowCmd := SW_SHOWMAXIMIZED;
7: Include(Options, ioFolderShortcut);
8: Include(Options, ioExcludeFromShowInNewInstall);
9: Include(Options, ioPreventPinning);
7: Include(Options, ioExcludeFromShowInNewInstall);
8: Include(Options, ioPreventPinning);
end;
{ Name }
@ -5613,13 +5496,7 @@ procedure TSetupCompiler.EnumFilesProc(const Line: PChar; const Ext: Integer);
if Result[I] = '{' then begin
Insert('{', Result, I);
Inc(I);
{$IFDEF UNICODE}
end;
{$ELSE}
end
else if Result[I] in CompilerLeadBytes then
Inc(I);
{$ENDIF}
Inc(I);
end;
end;
@ -6009,12 +5886,6 @@ type
if not ExternalFile and not(foIgnoreVersion in NewFileEntry^.Options) and
(NewFileLocationEntry^.Flags * [foVersionInfoValid, foVersionInfoNotValid] = []) then begin
AddStatus(Format(SCompilerStatusFilesVerInfo, [SourceFile]));
{ Windows versions prior to 2000 cannot read version info on 64-bit
images. Throw an error rather than silently failing to read the
version info (which could be dangerous). }
if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Byte(GetVersion) < 5) then
if Is64BitPEImage(SourceFile) then
AbortCompileOnLine(SCompilerFilesCantReadVersionInfoOn64BitImage);
if GetVersionNumbers(SourceFile, VersionNumbers) then begin
NewFileLocationEntry^.FileVersionMS := VersionNumbers.MS;
NewFileLocationEntry^.FileVersionLS := VersionNumbers.LS;
@ -6078,32 +5949,20 @@ type
function ComparePathStr(P1, P2: PChar): Integer;
{ Like CompareStr, but sorts backslashes correctly ('A\B' < 'AB\B') }
var
{$IFNDEF UNICODE}
LastWasLeadByte: BOOL;
{$ENDIF}
C1, C2: Char;
begin
{$IFNDEF UNICODE}
LastWasLeadByte := False;
{$ENDIF}
repeat
C1 := P1^;
if (C1 = '\') {$IFNDEF UNICODE} and not LastWasLeadByte {$ENDIF} then
if C1 = '\' then
C1 := #1;
C2 := P2^;
if (C2 = '\') {$IFNDEF UNICODE} and not LastWasLeadByte {$ENDIF} then
if C2 = '\' then
C2 := #1;
Result := Ord(C1) - Ord(C2);
if Result <> 0 then
Break;
if C1 = #0 then
Break;
{$IFNDEF UNICODE}
if LastWasLeadByte then
LastWasLeadByte := False
else
LastWasLeadByte := IsDBCSLeadByte(Ord(C1));
{$ENDIF}
Inc(P1);
Inc(P2);
until False;
@ -6755,7 +6614,6 @@ const
(Name: ParamLanguagesInfoBeforeFile; Flags: [piNoEmpty]),
(Name: ParamLanguagesInfoAfterFile; Flags: [piNoEmpty]));
{$IFDEF UNICODE}
procedure TSetupCompiler.EnumLanguagesPreProc(const Line: PChar; const Ext: Integer);
var
Values: array[TLanguagesParam] of TParamValue;
@ -6786,7 +6644,6 @@ begin
ReadMessagesFromFilesPre(Filename, PreLangDataList.Count-1);
end;
{$ENDIF}
procedure TSetupCompiler.EnumLanguagesProc(const Line: PChar; const Ext: Integer);
var
@ -7032,7 +6889,6 @@ begin
end;
end;
{$IFDEF UNICODE}
procedure TSetupCompiler.InitPreLangData(const APreLangData: TPreLangData);
{ Initializes a TPreLangData object with the default settings }
begin
@ -7041,7 +6897,6 @@ begin
LanguageCodePage := 0;
end;
end;
{$ENDIF}
procedure TSetupCompiler.InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
{ Initializes a TSetupLanguageEntry record with the default settings }
@ -7050,9 +6905,6 @@ begin
Name := 'default';
LanguageName := 'English';
LanguageID := $0409; { U.S. English }
{$IFNDEF UNICODE}
LanguageCodePage := 0;
{$ENDIF}
DialogFontName := DefaultDialogFontName;
DialogFontSize := 8;
TitleFontName := 'Arial';
@ -7067,7 +6919,6 @@ begin
end;
end;
{$IFDEF UNICODE}
procedure TSetupCompiler.ReadMessagesFromFilesPre(const AFiles: String;
const ALangIndex: Integer);
var
@ -7084,7 +6935,6 @@ begin
CallIdleProc;
end;
end;
{$ENDIF}
procedure TSetupCompiler.ReadMessagesFromFiles(const AFiles: String;
const ALangIndex: Integer);
@ -7123,7 +6973,6 @@ begin
{ ^ Copy(..., 4, Maxint) is to skip past "msg" }
end;
{$IFDEF UNICODE}
procedure TSetupCompiler.ReadMessagesFromScriptPre;
procedure CreateDefaultLanguageEntryPre;
@ -7157,7 +7006,6 @@ begin
EnumIniSection(EnumLangOptionsPreProc, 'LangOptions', -1, False, True, '', True, False);
CallIdleProc;
end;
{$ENDIF}
procedure TSetupCompiler.ReadMessagesFromScript;
@ -7645,7 +7493,6 @@ procedure TSetupCompiler.Compile;
end;
end;
{$IFDEF UNICODE}
procedure FreePreLangData;
var
I: Integer;
@ -7655,7 +7502,6 @@ procedure TSetupCompiler.Compile;
PreLangDataList.Delete(I);
end;
end;
{$ENDIF}
procedure FreeLangData;
var
@ -7724,9 +7570,6 @@ var
F.WriteBuffer(SetupID, SizeOf(SetupID));
{$IFNDEF UNICODE}
SetupHeader.LeadBytes := CompilerLeadBytes;
{$ENDIF}
SetupHeader.NumLanguageEntries := LanguageEntries.Count;
SetupHeader.NumCustomMessageEntries := CustomMessageEntries.Count;
SetupHeader.NumPermissionEntries := PermissionEntries.Count;
@ -8232,7 +8075,7 @@ var
end;
end;
procedure PrepareSetupE32(var M: TMemoryFile; const RemoveManifestDllHijackProtection: Boolean);
procedure PrepareSetupE32(var M: TMemoryFile);
var
TempFilename, E32Filename, ConvertFilename: String;
ConvertFile: TFile;
@ -8258,21 +8101,11 @@ var
UpdateVersionInfo(ConvertFile, TFileVersionNumbers(nil^), VersionInfoProductVersion, VersionInfoCompany,
'', '', VersionInfoCopyright, VersionInfoProductName, VersionInfoProductTextVersion, VersionInfoOriginalFileName,
False);
if RemoveManifestDllHijackProtection then begin
AddStatus(Format(SCompilerStatusUpdatingManifest, ['SETUP.E32']));
CompExeUpdate.RemoveManifestDllHijackProtection(ConvertFile, False);
end else begin
{ Use the opportunity to check that the manifest is correctly prepared for removing the
protection, without actually removing it. Doing this only once per compile since there's
only one source manifest. }
CompExeUpdate.RemoveManifestDllHijackProtection(ConvertFile, True);
end;
finally
ConvertFile.Free;
end;
M := TMemoryFile.Create(ConvertFilename);
UpdateSetupPEHeaderFields(M, RemoveManifestDllHijackProtection, TerminalServicesAware,
DEPCompatible, ASLRCompatible);
UpdateSetupPEHeaderFields(M, TerminalServicesAware, DEPCompatible, ASLRCompatible);
if shSignedUninstaller in SetupHeader.Options then
SignSetupE32(M);
finally
@ -8408,10 +8241,8 @@ var
SetupE32: TMemoryFile;
I: Integer;
AppNameHasConsts, AppVersionHasConsts, AppPublisherHasConsts,
AppCopyrightHasConsts, AppIdHasConsts, Uninstallable, RemoveManifestDllHijackProtection: Boolean;
AppCopyrightHasConsts, AppIdHasConsts, Uninstallable: Boolean;
PrivilegesRequiredValue: String;
OSVersionInfo: TOSVersionInfo;
WindowsVersion: Cardinal;
begin
{ Sanity check: A single TSetupCompiler instance cannot be used to do
multiple compiles. A separate instance must be used for each compile,
@ -8758,28 +8589,28 @@ begin
{ Prepare Setup executable & signed uninstaller data }
if Output then begin
AddStatus(SCompilerStatusPreparingSetupExe);
{ The manifest block protecting special DLLs breaks Vista compatibility }
RemoveManifestDllHijackProtection := SetupHeader.MinVersion.NTVersion < $06010000;
if RemoveManifestDllHijackProtection then
WarningsList.Add(Format(SCompilerRemoveManifestDllHijackProtection, ['6.1']))
else begin
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
WindowsVersion := (Byte(OSVersionInfo.dwMajorVersion) shl 24) or
(Byte(OSVersionInfo.dwMinorVersion) shl 16) or Word(OSVersionInfo.dwBuildNumber);
if WindowsVersion < Cardinal($06010000) then
WarningsList.Add(Format(SCompilerDidntRemoveManifestDllHijackProtection, ['6.1']))
end;
end;
PrepareSetupE32(SetupE32, RemoveManifestDllHijackProtection);
end else begin
PrepareSetupE32(SetupE32);
end else
AddStatus(SCompilerStatusSkippingPreparingSetupExe);
RemoveManifestDllHijackProtection := False; { silence compiler }
end;
{ Read languages:
Non Unicode:
0. Determine final code pages:
Unicode Setup uses Unicode text and does not depend on the system code page. To
provide Setup with Unicode text without requiring Unicode .isl files (but still
supporting Unicode .iss, license and info files), the compiler converts the .isl
files to Unicode during compilation. It also does this if it finds ANSI plain text
license and info files. To be able to do this it needs to know the language's code
page but as seen above it can't simply take this from the current .isl. And license
and info files do not even have a language code page setting.
This means the Unicode compiler has to do an extra phase: following the logic above
it first determines the final language code page for each language, storing these
into an extra list called PreDataList, and then it continues as normal while using
the final language code page for any conversions needed.
Note: it must avoid caching the .isl files while determining the code pages, since
the conversion is done *before* the caching.
1. Read Default.isl messages:
@ -8835,35 +8666,8 @@ begin
4. Check 'language completeness' of custom message constants:
CheckCustomMessageDefinitions is used to check for missing custom messages and
where necessary it 'promotes' a custom message by resetting its LangIndex property
to -1.
to -1. }
5. Display the language at run time:
Setup checks if the system code page matches the language code page, and only shows
the language if it does. The system code page is then used to display all text, this
does not only include messages and custom messages, but also any readme and info files.
Unicode:
Unicode works exactly like above with one exception:
0. Determine final code pages:
Unicode Setup uses Unicode text and does not depend on the system code page. To
provide Setup with Unicode text without requiring Unicode .isl files (but still
supporting Unicode .iss, license and info files), the compiler converts the .isl
files to Unicode during compilation. It also does this if it finds ANSI plain text
license and info files. To be able to do this it needs to know the language's code
page but as seen above it can't simply take this from the current .isl. And license
and info files do not even have a language code page setting.
This means the Unicode compiler has to do an extra phase: following the logic above
it first determines the final language code page for each language, storing these
into an extra list called PreDataList, and then it continues as normal while using
the final language code page for any conversions needed.
Note: it must avoid caching the .isl files while determining the code pages, since
the conversion is done *before* the caching. }
{$IFDEF UNICODE}
{ 0. Determine final language code pages }
AddStatus(SCompilerStatusDeterminingCodePages);
@ -8874,7 +8678,6 @@ begin
{ 0.2. Read [LangOptions] in the script }
ReadMessagesFromScriptPre;
{$ENDIF}
{ 1. Read Default.isl messages }
AddStatus(SCompilerStatusReadingDefaultMessages);
@ -9046,8 +8849,7 @@ begin
end;
SetupFile := TFile.Create(ExeFilename, fdOpenExisting, faReadWrite, fsNone);
try
UpdateSetupPEHeaderFields(SetupFile, RemoveManifestDllHijackProtection,
TerminalServicesAware, DEPCompatible, ASLRCompatible);
UpdateSetupPEHeaderFields(SetupFile, TerminalServicesAware, DEPCompatible, ASLRCompatible);
SizeOfExe := SetupFile.Size.Lo;
finally
SetupFile.Free;
@ -9107,10 +8909,7 @@ begin
True);
{ Update manifest if needed }
if RemoveManifestDllHijackProtection then begin
AddStatus(Format(SCompilerStatusUpdatingManifest, ['SETUP.EXE']));
CompExeUpdate.RemoveManifestDllHijackProtection(ExeFile, False);
end else if UseSetupLdr then begin
if UseSetupLdr then begin
AddStatus(Format(SCompilerStatusUpdatingManifest, ['SETUP.EXE']));
CompExeUpdate.PreventCOMCTL32Sideloading(ExeFile);
end;
@ -9186,9 +8985,7 @@ begin
FileLocationEntryFilenames.Clear;
FreeLineInfoList(ExpectedCustomMessageNames);
FreeLangData;
{$IFDEF UNICODE}
FreePreLangData;
{$ENDIF}
FreeScriptFiles;
FreeLineInfoList(CodeText);
FreeAndNil(CompressProps);
@ -9360,10 +9157,6 @@ begin
end;
initialization
{$IFNDEF UNICODE}
GetLeadBytes(CompilerLeadBytes);
ConstLeadBytes := @CompilerLeadBytes;
{$ENDIF}
finalization
if CryptProv <> 0 then begin
CryptReleaseContext(CryptProv, 0);

7
Projects/DebugClient.pas
View File

@ -2,7 +2,7 @@ unit DebugClient;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -71,9 +71,8 @@ begin
if DebugClientWnd = 0 then
InternalError('Failed to create DebugClientWnd');
{ On Vista, unprivileged processes can't send messages to elevated processes
by default. Allow the debugger (which normally runs unprivileged) to send
messages to us. }
{ Unprivileged processes can't send messages to elevated processes by default.
Allow the debugger (which normally runs unprivileged) to send messages to us. }
for I := Low(DebugClientMessages) to High(DebugClientMessages) do
AddToWindowMessageFilterEx(DebugClientWnd, DebugClientMessages[I]);

20
Projects/DebugStruct.pas
View File

@ -2,7 +2,7 @@ unit DebugStruct;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -101,11 +101,9 @@ function GetThreadTopWindow: HWND;
function SendCopyDataMessage(DestWnd, SourceWnd: HWND; CopyDataMsg: DWORD;
Data: Pointer; Size: Cardinal): LRESULT;
function SendCopyDataMessageStr(DestWnd, SourceWnd: HWND; CopyDataMsg: DWORD;
Data: AnsiString): LRESULT;{$IFDEF UNICODE} overload;{$ENDIF}
{$IFDEF UNICODE}
Data: AnsiString): LRESULT; overload;
function SendCopyDataMessageStr(DestWnd, SourceWnd: HWND; CopyDataMsg: DWORD;
Data: UnicodeString): LRESULT; overload;
{$ENDIF}
implementation
@ -140,29 +138,15 @@ end;
function SendCopyDataMessageStr(DestWnd, SourceWnd: HWND; CopyDataMsg: DWORD;
Data: AnsiString): LRESULT;
begin
{ Windows 95/98/Me bug workaround: Call UniqueString to ensure the string is
in writable memory. Amazingly enough, sending a WM_COPYDATA message with a
read-only buffer causes a fatal page fault error. }
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
IsBadWritePtr(Pointer(Data), Length(Data)*SizeOf(Data[1])) then
UniqueString(Data);
Result := SendCopyDataMessage(DestWnd, SourceWnd, CopyDataMsg,
Pointer(Data), Length(Data)*SizeOf(Data[1]));
end;
{$IFDEF UNICODE}
function SendCopyDataMessageStr(DestWnd, SourceWnd: HWND; CopyDataMsg: DWORD;
Data: UnicodeString): LRESULT;
begin
{ Windows 95/98/Me bug workaround: Call UniqueString to ensure the string is
in writable memory. Amazingly enough, sending a WM_COPYDATA message with a
read-only buffer causes a fatal page fault error. }
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
IsBadWritePtr(Pointer(Data), Length(Data)*SizeOf(Data[1])) then
UniqueString(Data);
Result := SendCopyDataMessage(DestWnd, SourceWnd, CopyDataMsg,
Pointer(Data), Length(Data)*SizeOf(Data[1]));
end;
{$ENDIF}
end.

50
Projects/FileClass.pas
View File

@ -96,18 +96,14 @@ type
FBufferOffset, FBufferSize: Cardinal;
FEof: Boolean;
FBuffer: array[0..4095] of AnsiChar;
{$IFDEF UNICODE}
FSawFirstLine: Boolean;
FCodePage: Cardinal;
{$ENDIF}
function DoReadLine{$IFDEF UNICODE}(const UTF8: Boolean){$ENDIF}: AnsiString;
function DoReadLine(const UTF8: Boolean): AnsiString;
function GetEof: Boolean;
procedure FillBuffer;
public
function ReadLine: String;
{$IFDEF UNICODE}
function ReadAnsiLine: AnsiString;
{$ENDIF}
property CodePage: Cardinal write FCodePage;
property Eof: Boolean read GetEof;
end;
@ -116,7 +112,7 @@ type
private
FSeekedToEnd: Boolean;
FUTF8NoPreamble: Boolean;
procedure DoWrite(const S: AnsiString{$IFDEF UNICODE}; const UTF8: Boolean{$ENDIF});
procedure DoWrite(const S: AnsiString; const UTF8: Boolean);
protected
function CreateHandle(const AFilename: String;
ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
@ -125,10 +121,8 @@ type
property UTF8NoPreamble: Boolean read FUTF8NoPreamble write FUTF8NoPreamble;
procedure Write(const S: String);
procedure WriteLine(const S: String);
{$IFDEF UNICODE}
procedure WriteAnsi(const S: AnsiString);
procedure WriteAnsiLine(const S: AnsiString);
{$ENDIF}
end;
TFileMapping = class
@ -438,29 +432,21 @@ begin
end;
function TTextFileReader.ReadLine: String;
{$IFDEF UNICODE}
var
S: RawByteString;
{$ENDIF}
begin
{$IFDEF UNICODE}
S := DoReadLine(True);
if FCodePage <> 0 then
SetCodePage(S, FCodePage, False);
Result := String(S);
{$ELSE}
Result := DoReadLine;
{$ENDIF}
end;
{$IFDEF UNICODE}
function TTextFileReader.ReadAnsiLine: AnsiString;
begin
Result := DoReadLine(False);
end;
{$ENDIF}
function TTextFileReader.DoReadLine{$IFDEF UNICODE}(const UTF8: Boolean){$ENDIF}: AnsiString;
function TTextFileReader.DoReadLine(const UTF8: Boolean): AnsiString;
var
I, L: Cardinal;
S: AnsiString;
@ -502,7 +488,7 @@ begin
Break;
end;
end;
{$IFDEF UNICODE}
if not FSawFirstLine then begin
if UTF8 then begin
{ Handle UTF8 as requested: check for a BOM at the start and if not found then check entire file }
@ -526,7 +512,7 @@ begin
end;
FSawFirstLine := True;
end;
{$ENDIF}
Result := S;
end;
@ -545,17 +531,11 @@ begin
ASharing);
end;
{$IFDEF UNICODE}
procedure TTextFileWriter.DoWrite(const S: AnsiString; const UTF8: Boolean);
{$ELSE}
procedure TTextFileWriter.DoWrite(const S: String);
{$ENDIF}
{ Writes a string to the file, seeking to the end first if necessary }
const
CRLF: array[0..1] of AnsiChar = (#13, #10);
{$IFDEF UNICODE}
UTF8Preamble: array[0..2] of AnsiChar = (#$EF, #$BB, #$BF);
{$ENDIF}
var
I: Integer64;
C: AnsiChar;
@ -578,12 +558,8 @@ begin
{ Otherwise, append CRLF }
WriteBuffer(CRLF, SizeOf(CRLF));
end;
{$IFDEF UNICODE}
end else if UTF8 and not FUTF8NoPreamble then
WriteBuffer(UTF8Preamble, SizeOf(UTF8Preamble));
{$ELSE}
end;
{$ENDIF}
FSeekedToEnd := True;
end;
WriteBuffer(Pointer(S)^, Length(S));
@ -591,11 +567,7 @@ end;
procedure TTextFileWriter.Write(const S: String);
begin
{$IFDEF UNICODE}
DoWrite(UTF8Encode(S), True);
{$ELSE}
DoWrite(S);
{$ENDIF}
end;
procedure TTextFileWriter.WriteLine(const S: String);
@ -603,7 +575,6 @@ begin
Write(S + #13#10);
end;
{$IFDEF UNICODE}
procedure TTextFileWriter.WriteAnsi(const S: AnsiString);
begin
DoWrite(S, False);
@ -613,7 +584,6 @@ procedure TTextFileWriter.WriteAnsiLine(const S: AnsiString);
begin
WriteAnsi(S + #13#10);
end;
{$ENDIF}
{ TFileMapping }
@ -629,9 +599,7 @@ const
begin
inherited Create;
{ Dynamically import RtlNtStatusToDosError since Windows 95 doesn't have it }
if not Assigned(_RtlNtStatusToDosError) and
(Win32Platform = VER_PLATFORM_WIN32_NT) then
if not Assigned(_RtlNtStatusToDosError) then
_RtlNtStatusToDosError := GetProcAddress(GetModuleHandle('ntdll.dll'),
'RtlNtStatusToDosError');
@ -684,16 +652,14 @@ begin
(Cardinal(EExternalException(E).ExceptionRecord.NumberParameters) >= Cardinal(2)) and
(Cardinal(EExternalException(E).ExceptionRecord.ExceptionInformation[1]) >= Cardinal(FMemory)) and
(Cardinal(EExternalException(E).ExceptionRecord.ExceptionInformation[1]) < Cardinal(Cardinal(FMemory) + FMapSize)) then begin
{ NT has a third parameter containing the NT status code of the error
{ There should be a third parameter containing the NT status code of the error
condition that caused the exception. Convert that into a Win32 error code
and use it to generate our error message. }
if (Cardinal(EExternalException(E).ExceptionRecord.NumberParameters) >= Cardinal(3)) and
Assigned(_RtlNtStatusToDosError) then
TFile.RaiseError(_RtlNtStatusToDosError(EExternalException(E).ExceptionRecord.ExceptionInformation[2]))
else begin
{ Windows 9x/Me doesn't have a third parameter, and 95 doesn't have
RtlNtStatusToDosError, so use generic "The system cannot [read|write]
to the specified device" errors }
{ Use generic "The system cannot [read|write] to the specified device" errors }
if EExternalException(E).ExceptionRecord.ExceptionInformation[0] = 0 then
TFile.RaiseError(ERROR_READ_FAULT)
else

22
Projects/Helper.pas
View File

@ -2,7 +2,7 @@ unit Helper;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -10,8 +10,6 @@ unit Helper;
NOTE: These functions are NOT thread-safe. Do not call them from multiple
threads simultaneously.
$jrsoftware: issrc/Projects/Helper.pas,v 1.14 2010/10/20 02:43:26 jr Exp $
}
interface
@ -146,7 +144,6 @@ begin
end;
procedure FillWideCharBuffer(var Buf: array of WideChar; const S: String);
{$IFDEF UNICODE}
begin
if High(Buf) <= 0 then
InternalError('FillWideCharBuffer: Invalid Buf');
@ -154,23 +151,6 @@ begin
InternalError('FillWideCharBuffer: String too long');
StrPLCopy(Buf, S, High(Buf));
end;
{$ELSE}
var
SourceLen, DestLen: Integer;
begin
if High(Buf) <= 0 then
InternalError('FillWideCharBuffer: Invalid Buf');
SourceLen := Length(S);
if SourceLen = 0 then
DestLen := 0
else begin
DestLen := MultiByteToWideChar(CP_ACP, 0, PChar(S), SourceLen, Buf, High(Buf));
if DestLen <= 0 then
InternalError('FillWideCharBuffer: MultiByteToWideChar failed');
end;
Buf[DestLen] := #0;
end;
{$ENDIF}
{ THelper }

6
Projects/HtmlHelpFunc.pas
View File

@ -2,13 +2,11 @@ unit HtmlHelpFunc;
{
Inno Setup
Copyright (C) 1997-2006 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Functions for HTML Help
$jrsoftware: issrc/Projects/HtmlHelpFunc.pas,v 1.6 2009/03/23 23:16:44 mlaan Exp $
}
interface
@ -56,7 +54,7 @@ begin
if HHCtrl = 0 then begin
HHCtrl := LoadLibrary(PChar(AddBackslash(GetSystemDir) + 'hhctrl.ocx'));
if HHCtrl <> 0 then
HtmlHelp := GetProcAddress(HHCtrl, {$IFDEF UNICODE}'HtmlHelpW'{$ELSE}'HtmlHelpA'{$ENDIF})
HtmlHelp := GetProcAddress(HHCtrl, 'HtmlHelpW')
else
HtmlHelp := nil;
end;

4
Projects/ISCC.dpr
View File

@ -27,8 +27,8 @@ uses
CompTypes in 'CompTypes.pas';
{$SetPEFlags IMAGE_FILE_RELOCS_STRIPPED}
{$SETPEOSVERSION 6.0}
{$SETPESUBSYSVERSION 6.0}
{$SETPEOSVERSION 6.1}
{$SETPESUBSYSVERSION 6.1}
{$WEAKLINKRTTI ON}
{$R ISCC.manifest.res}

4
Projects/ISCmplr.dpr
View File

@ -33,8 +33,8 @@ uses
PathFunc in '..\Components\PathFunc.pas';
{$IMAGEBASE $00800000}
{$SETPEOSVERSION 6.0}
{$SETPESUBSYSVERSION 6.0}
{$SETPEOSVERSION 6.1}
{$SETPESUBSYSVERSION 6.1}
{$WEAKLINKRTTI ON}
{$R ISCmplr.images.res}

6
Projects/ISPP/ISPP.dpr
View File

@ -3,7 +3,7 @@
Copyright (C) 2001-2002 Alex Yackimoff
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
}
@ -36,8 +36,8 @@ uses
Struct in '..\Struct.pas';
{$IMAGEBASE $01800000}
{$SETPEOSVERSION 6.0}
{$SETPESUBSYSVERSION 6.0}
{$SETPEOSVERSION 6.1}
{$SETPESUBSYSVERSION 6.1}
{$WEAKLINKRTTI ON}
{$R ISPP.version.res}

40
Projects/ISPP/IsppFuncs.pas
View File

@ -3,7 +3,7 @@
Copyright (C) 2001-2002 Alex Yackimoff
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
}
@ -1500,19 +1500,19 @@ begin
try
with IInternalFuncParams(Params) do
begin
OldDateSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator;
OldTimeSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator;
OldDateSeparator := FormatSettings.DateSeparator;
OldTimeSeparator := FormatSettings.TimeSeparator;
try
NewDateSeparatorString := Get(1).AsStr;
NewTimeSeparatorString := Get(2).AsStr;
if NewDateSeparatorString <> '' then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := NewDateSeparatorString[1];
FormatSettings.DateSeparator := NewDateSeparatorString[1];
if NewTimeSeparatorString <> '' then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := NewTimeSeparatorString[1];
FormatSettings.TimeSeparator := NewTimeSeparatorString[1];
MakeStr(ResPtr^, FormatDateTime(Get(0).AsStr, Now()));
finally
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := OldTimeSeparator;
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := OldDateSeparator;
FormatSettings.TimeSeparator := OldTimeSeparator;
FormatSettings.DateSeparator := OldDateSeparator;
end;
end;
except
@ -1535,23 +1535,23 @@ begin
try
with IInternalFuncParams(Params) do
begin
OldDateSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator;
OldTimeSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator;
OldDateSeparator := FormatSettings.DateSeparator;
OldTimeSeparator := FormatSettings.TimeSeparator;
try
NewDateSeparatorString := Get(2).AsStr;
NewTimeSeparatorString := Get(3).AsStr;
if NewDateSeparatorString <> '' then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := NewDateSeparatorString[1];
FormatSettings.DateSeparator := NewDateSeparatorString[1];
if NewTimeSeparatorString <> '' then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := NewTimeSeparatorString[1];
FormatSettings.TimeSeparator := NewTimeSeparatorString[1];
if not FileAge(PrependPath(Ext, Get(0).AsStr), Age) then begin
FuncResult.Error('Invalid file name');
Result.Error := ISPPFUNC_FAIL
end else
MakeStr(ResPtr^, FormatDateTime(Get(1).AsStr, Age));
finally
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := OldTimeSeparator;
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := OldDateSeparator;
FormatSettings.TimeSeparator := OldTimeSeparator;
FormatSettings.DateSeparator := OldDateSeparator;
end;
end;
except
@ -1620,7 +1620,6 @@ end;
function GetMD5OfUnicodeString(Ext: Longint; const Params: IIsppFuncParams;
const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
{$IFDEF UNICODE}
var
S: UnicodeString;
begin
@ -1639,12 +1638,6 @@ begin
end;
end;
end;
{$ELSE}
begin
FuncResult.Error('Cannot call "GetMD5OfUnicodeString" function during non Unicode compilation');
Result.Error := ISPPFUNC_FAIL
end;
{$ENDIF}
function GetSHA1OfFile(Ext: Longint; const Params: IIsppFuncParams;
const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
@ -1703,7 +1696,6 @@ end;
function GetSHA1OfUnicodeString(Ext: Longint; const Params: IIsppFuncParams;
const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
{$IFDEF UNICODE}
var
S: UnicodeString;
begin
@ -1722,12 +1714,6 @@ begin
end;
end;
end;
{$ELSE}
begin
FuncResult.Error('Cannot call "GetSHA1OfUnicodeString" function during non Unicode compilation');
Result.Error := ISPPFUNC_FAIL
end;
{$ENDIF}
function TrimFunc(Ext: Longint; const Params: IIsppFuncParams;
const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;

19
Projects/ISPP/IsppPreprocessor.pas
View File

@ -3,7 +3,7 @@
Copyright (C) 2001-2002 Alex Yackimoff
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
}
@ -859,11 +859,7 @@ function TPreprocessor.ProcessPreprocCommand(Command: TPreprocessorCommand;
if Windows.GetTempFileName(PChar(Path), PChar(UpperCase(Original)), 0, PChar(Result)) <> 0 then
SetLength(Result, StrLen(PChar(Result)))
else
{$IFDEF IS_D7}
RaiseLastOSError
{$ELSE}
RaiseLastWin32Error;
{$ENDIF}
RaiseLastOSError;
end;
var
@ -1079,20 +1075,14 @@ begin
end;
procedure TPreprocessor.SaveToFile(const FileName: string);
{$IFDEF UNICODE}
var
S: String;
{$ENDIF}
begin
{$IFDEF UNICODE}
S := FOutput.Text;
if SameText(S, String(AnsiString(S))) then
FOutput.SaveToFile(FileName)
else
FOutput.SaveToFile(FileName, TEncoding.UTF8);
{$ELSE}
FOutput.SaveToFile(FileName)
{$ENDIF}
end;
function TPreprocessor.CheckFile(const FileName: string): Boolean;
@ -1408,13 +1398,8 @@ end;
function LookupAlwaysDefined(const Name: string): Boolean;
const
{$IFDEF UNICODE}
AlwaysDefined: array[0..3] of string =
('ISPP_INVOKED', 'WINDOWS', '__WIN32__', 'UNICODE');
{$ELSE}
AlwaysDefined: array[0..2] of string =
('ISPP_INVOKED', 'WINDOWS', '__WIN32__');
{$ENDIF}
var
I: Integer;
begin

4
Projects/ISPP/IsppSessions.pas
View File

@ -3,7 +3,7 @@
Copyright (C) 2001-2002 Alex Yackimoff
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
}
@ -25,7 +25,7 @@ implementation
{$I ..\Version.inc}
uses SysUtils, Classes, IsppStack {$IFDEF IS_D12}, Windows{$ENDIF};
uses SysUtils, Classes, IsppStack, Windows;
procedure WarningMsg(const Msg: string; const Args: array of const);
var

350
Projects/InstFnc2.pas
View File

@ -2,7 +2,7 @@ unit InstFnc2;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -15,7 +15,7 @@ interface
function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
WorkingDir: String; IconFilename: String; const IconIndex, ShowCmd: Integer;
const HotKey: Word; FolderShortcut: Boolean; const AppUserModelID: String;
const HotKey: Word; const AppUserModelID: String;
const AppUserModelToastActivatorCLSID: PGUID;
const ExcludeFromShowInNewInstall, PreventPinning: Boolean): String;
procedure RegisterTypeLibrary(const Filename: String);
@ -26,27 +26,7 @@ implementation
uses
Windows, SysUtils, PathFunc, CmnFunc2, InstFunc, Main, Msgs, MsgIDs,
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
{$IFDEF IS_D14} PropSys, {$ENDIF}
ShellAPI, ShlObj;
function IsWindowsXP: Boolean;
{ Returns True if running Windows XP or later }
begin
Result := (WindowsVersion >= Cardinal($05010000));
end;
function IsWindowsVista: Boolean;
{ Returns True if running Windows Vista or later }
begin
Result := (WindowsVersion >= Cardinal($06000000));
end;
function IsWindows7: Boolean;
{ Returns True if running Windows 7 or later }
begin
Result := (WindowsVersion >= Cardinal($06010000));
end;
ActiveX, ComObj, PropSys, ShellAPI, ShlObj;
function IsWindows8: Boolean;
{ Returns True if running Windows 8 or later }
@ -100,15 +80,12 @@ begin
Result := '';
CurFilename := nil;
OleResult := PF.GetCurFile(CurFilename);
{ Note: Prior to Windows 2000/Me, GetCurFile succeeds but returns a NULL
pointer }
if SUCCEEDED(OleResult) and Assigned(CurFilename) then begin
if OleResult = S_OK then
Result := WideCharToString(CurFilename);
CoTaskMemFree(CurFilename);
end;
{ If GetCurFile didn't work (e.g. not running Windows 2000/Me or later), we
have no choice but to try to guess the filename }
{ If GetCurFile didn't work, we have no choice but to try to guess the filename }
if Result = '' then begin
if NewFileExists(OriginalFilename) then
Result := OriginalFilename
@ -121,48 +98,9 @@ begin
end;
end;
{$IFNDEF UNICODE}
type
TPropertyKey = packed record
fmtid: TGUID;
pid: DWORD;
end;
{$IFNDEF IS_D4}
TPropVariant = TVariantArg;
{$ENDIF}
{$IFNDEF Delphi3orHigher}
const
IID_IPropertyStore: TGUID = (
D1:$886d8eeb; D2:$8cf2; D3:$4446; D4:($8d,$02,$cd,$ba,$1d,$bd,$cf,$99));
type
IPropertyStore = class(IUnknown)
function GetCount(var cProps: DWORD): HResult; virtual; stdcall; abstract;
function GetAt(iProp: DWORD; var pkey: TPropertyKey): HResult; virtual; stdcall; abstract;
function GetValue(const key: TPropertyKey; var pv: TPropVariant): HResult; virtual; stdcall; abstract;
function SetValue(const key: TPropertyKey; const propvar: TPropVariant): HResult; virtual; stdcall; abstract;
function Commit: HResult; virtual; stdcall; abstract;
end;
{$ELSE}
{$IFNDEF IS_D14}
type
IPropertyStore = interface(IUnknown)
['{886d8eeb-8cf2-4446-8d02-cdba1dbdcf99}']
function GetCount(var cProps: DWORD): HResult; stdcall;
function GetAt(iProp: DWORD; var pkey: TPropertyKey): HResult; stdcall;
function GetValue(const key: TPropertyKey; var pv: TPropVariant): HResult; stdcall;
function SetValue(const key: TPropertyKey; const propvar: TPropVariant): HResult; stdcall;
function Commit: HResult; stdcall;
end;
{$ENDIF}
{$ENDIF}
{$ENDIF}
function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
WorkingDir: String; IconFilename: String; const IconIndex, ShowCmd: Integer;
const HotKey: Word; FolderShortcut: Boolean; const AppUserModelID: String;
const HotKey: Word; const AppUserModelID: String;
const AppUserModelToastActivatorCLSID: PGUID;
const ExcludeFromShowInNewInstall, PreventPinning: Boolean): String;
{ Creates a lnk file named Filename, with a description of Description, with a
@ -173,8 +111,6 @@ function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
is not necessary if you are using Delphi 3 and your project already 'uses'
the ComObj RTL unit. }
const
CLSID_FolderShortcut: TGUID = (
D1:$0AFACED1; D2:$E828; D3:$11D1; D4:($91,$87,$B5,$32,$F1,$E9,$57,$5D));
PKEY_AppUserModel_ID: TPropertyKey = (
fmtid: (D1:$9F4C2855; D2:$9F79; D3:$4B39; D4:($A8,$D0,$E1,$D4,$2D,$E1,$D5,$F3));
pid: 5);
@ -192,163 +128,20 @@ const
pid: 26);
APPUSERMODEL_STARTPINOPTION_NOPINONINSTALL = 1;
{$IFNDEF Delphi3OrHigher}
var
OleResult: HRESULT;
SL: IShellLink;
PS: IPropertyStore;
PV: TPropVariant;
PF: IPersistFile;
WideFilename: PWideChar;
begin
if FolderShortcut then
OleResult := CoCreateInstance(CLSID_FolderShortcut, nil, CLSCTX_INPROC_SERVER,
IID_IShellLink, SL)
else
OleResult := E_FAIL;
{ If a folder shortcut wasn't requested, or if CoCreateInstance failed
because the user isn't running Windows 2000/Me or later, create a normal
shell link instead }
if OleResult <> S_OK then begin
FolderShortcut := False;
OleResult := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
IID_IShellLink, SL);
if OleResult <> S_OK then
RaiseOleError('CoCreateInstance', OleResult);
end;
PF := nil;
PS := nil;
WideFilename := nil;
try
SL.SetPath(PChar(ShortcutTo));
SL.SetArguments(PChar(Parameters));
if not FolderShortcut then
AssignWorkingDir(SL, WorkingDir);
if IconFilename <> '' then begin
{ Work around a 64-bit Windows bug. It replaces pf32 with %ProgramFiles%
which is wrong. This causes an error when the user tries to change the
icon of the installed shortcut. Note that the icon does actually display
fine because it *also* stores the original 'non replaced' path in the
shortcut. }
if IsWin64 then
StringChangeEx(IconFileName, ExpandConst('{commonpf32}\'), '%ProgramFiles(x86)%\', True);
SL.SetIconLocation(PChar(IconFilename), IconIndex);
end;
SL.SetShowCmd(ShowCmd);
if Description <> '' then
SL.SetDescription(PChar(Description));
if HotKey <> 0 then
SL.SetHotKey(HotKey);
{ Note: Vista and newer support IPropertyStore but Vista errors if you try to
commit a PKEY_AppUserModel_ID, so avoid setting the property on Vista. }
if IsWindows7 and ((AppUserModelID <> '') or (AppUserModelToastActivatorCLSID <> nil) or ExcludeFromShowInNewInstall or PreventPinning) then begin
OleResult := SL.QueryInterface(IID_IPropertyStore, PS);
if OleResult <> S_OK then
RaiseOleError('IShellLink::QueryInterface(IID_IPropertyStore)', OleResult);
{ According to MSDN the PreventPinning property should be set before the ID property. In practice
this doesn't seem to matter - at least not for shortcuts - but do it first anyway. }
if PreventPinning then begin
PV.vt := VT_BOOL;
Smallint(PV.vbool) := -1;
OleResult := PS.SetValue(PKEY_AppUserModel_PreventPinning, PV);
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_PreventPinning)', OleResult);
end;
if AppUserModelID <> '' then begin
PV.vt := VT_BSTR;
PV.bstrVal := StringToOleStr(AppUserModelID);
if PV.bstrVal = nil then
OutOfMemoryError;
try
OleResult := PS.SetValue(PKEY_AppUserModel_ID, PV);
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_ID)', OleResult);
finally
SysFreeString(PV.bstrVal);
end;
end;
if IsWindows10 and (AppUserModelToastActivatorCLSID <> nil) then begin
PV.vt := VT_CLSID;
PV.puuid := AppUserModelToastActivatorCLSID;
OleResult := PS.SetValue(PKEY_AppUserModel_ToastActivatorCLSID, PV);
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_ToastActivatorCLSID)', OleResult);
end;
if ExcludeFromShowInNewInstall then begin
PV.vt := VT_BOOL;
Smallint(PV.vbool) := -1;
OleResult := PS.SetValue(PKEY_AppUserModel_ExcludeFromShowInNewInstall, PV);
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_ExcludeFromShowInNewInstall)', OleResult);
if IsWindows8 then begin
PV.vt := VT_UI4;
PV.lVal := APPUSERMODEL_STARTPINOPTION_NOPINONINSTALL;
OleResult := PS.SetValue(PKEY_AppUserModel_StartPinOption, PV);
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::SetValue(PKEY_AppUserModel_StartPinOption)', OleResult);
end;
end;
OleResult := PS.Commit;
if OleResult <> S_OK then
RaiseOleError('IPropertyStore::Commit', OleResult);
end;
OleResult := SL.QueryInterface(IID_IPersistFile, PF);
if OleResult <> S_OK then
RaiseOleError('IShellLink::QueryInterface(IID_IPersistFile)', OleResult);
{ When creating a folder shortcut on 2000/Me, IPersistFile::Save will strip
off everything past the last '.' in the filename, so we keep the .lnk
extension on to give it something harmless to strip off. XP doesn't do
that, so we must remove the .lnk extension ourself. }
if FolderShortcut and IsWindowsXP then
WideFilename := StringToOleStr(PathChangeExt(Filename, ''))
else
WideFilename := StringToOleStr(Filename);
if WideFilename = nil then
OutOfMemoryError;
OleResult := PF.Save(WideFilename, True);
if OleResult <> S_OK then
RaiseOleError('IPersistFile::Save', OleResult);
Result := GetResultingFilename(PF, Filename);
finally
if Assigned(WideFilename) then
SysFreeString(WideFilename);
if Assigned(PS) then
PS.Release;
if Assigned(PF) then
PF.Release;
SL.Release;
end;
{$ELSE}
var
OleResult: HRESULT;
Obj: IUnknown;
SL: IShellLink;
PS: {$IFDEF IS_D14}PropSys.{$ENDIF}IPropertyStore;
PS: PropSys.IPropertyStore;
PV: TPropVariant;
PF: IPersistFile;
WideAppUserModelID, WideFilename: WideString;
begin
if FolderShortcut then begin
try
Obj := CreateComObject(CLSID_FolderShortcut);
except
{ Folder shortcuts aren't supported prior to Windows 2000/Me. Fall back
to creating a normal shell link. }
Obj := nil;
end;
end;
if Obj = nil then begin
FolderShortcut := False;
Obj := CreateComObject(CLSID_ShellLink);
end;
Obj := CreateComObject(CLSID_ShellLink);
SL := Obj as IShellLink;
SL.SetPath(PChar(ShortcutTo));
SL.SetArguments(PChar(Parameters));
if not FolderShortcut then
AssignWorkingDir(SL, WorkingDir);
AssignWorkingDir(SL, WorkingDir);
if IconFilename <> '' then begin
{ Work around a 64-bit Windows bug. It replaces pf32 with %ProgramFiles%
which is wrong. This causes an error when the user tries to change the
@ -365,10 +158,8 @@ begin
if HotKey <> 0 then
SL.SetHotKey(HotKey);
{ Note: Vista and newer support IPropertyStore but Vista errors if you try to
commit a PKEY_AppUserModel_ID, so avoid setting the property on Vista. }
if IsWindows7 and ((AppUserModelID <> '') or (AppUserModelToastActivatorCLSID <> nil) or ExcludeFromShowInNewInstall or PreventPinning) then begin
PS := Obj as {$IFDEF IS_D14}PropSys.{$ENDIF}IPropertyStore;
if (AppUserModelID <> '') or (AppUserModelToastActivatorCLSID <> nil) or ExcludeFromShowInNewInstall or PreventPinning then begin
PS := Obj as PropSys.IPropertyStore;
{ According to MSDN the PreventPinning property should be set before the ID property. In practice
this doesn't seem to matter - at least not for shortcuts - but do it first anyway. }
if PreventPinning then begin
@ -413,49 +204,15 @@ begin
end;
PF := SL as IPersistFile;
{ When creating a folder shortcut on 2000/Me, IPersistFile::Save will strip
off everything past the last '.' in the filename, so we keep the .lnk
extension on to give it something harmless to strip off. XP doesn't do
that, so we must remove the .lnk extension ourself. }
if FolderShortcut and IsWindowsXP then
WideFilename := PathChangeExt(Filename, '')
else
WideFilename := Filename;
WideFilename := Filename;
OleResult := PF.Save(PWideChar(WideFilename), True);
if OleResult <> S_OK then
RaiseOleError('IPersistFile::Save', OleResult);
Result := GetResultingFilename(PF, Filename);
{ Delphi 3 automatically releases COM objects when they go out of scope }
{$ENDIF}
end;
procedure RegisterTypeLibrary(const Filename: String);
{$IFNDEF Delphi3OrHigher}
var
WideFilename: PWideChar;
OleResult: HRESULT;
TypeLib: ITypeLib;
begin
WideFilename := StringToOleStr(PathExpand(Filename));
if WideFilename = nil then
OutOfMemoryError;
try
OleResult := LoadTypeLib(WideFilename, TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
try
OleResult := RegisterTypeLib(TypeLib, WideFilename, nil);
if OleResult <> S_OK then
RaiseOleError('RegisterTypeLib', OleResult);
finally
TypeLib.Release;
end;
finally
SysFreeString(WideFilename);
end;
end;
{$ELSE}
var
WideFilename: WideString;
OleResult: HRESULT;
@ -469,53 +226,11 @@ begin
if OleResult <> S_OK then
RaiseOleError('RegisterTypeLib', OleResult);
end;
{$ENDIF}
procedure UnregisterTypeLibrary(const Filename: String);
type
TUnRegTlbProc = function(const libID: TGUID; wVerMajor, wVerMinor: Word;
lcid: TLCID; syskind: TSysKind): HResult; stdcall;
{$IFNDEF Delphi3OrHigher}
var
UnRegTlbProc: TUnRegTlbProc;
WideFilename: PWideChar;
OleResult: HRESULT;
TypeLib: ITypeLib;
LibAttr: PTLibAttr;
begin
{ Dynamically import UnRegisterTypeLib since older OLEAUT32.DLL versions
don't have this function }
@UnRegTlbProc := GetProcAddress(GetModuleHandle('OLEAUT32.DLL'),
'UnRegisterTypeLib');
if @UnRegTlbProc = nil then
Win32ErrorMsg('GetProcAddress');
WideFilename := StringToOleStr(PathExpand(Filename));
if WideFilename = nil then
OutOfMemoryError;
try
OleResult := LoadTypeLib(WideFilename, TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
try
OleResult := TypeLib.GetLibAttr(LibAttr);
if OleResult <> S_OK then
RaiseOleError('ITypeLib::GetLibAttr', OleResult);
try
with LibAttr^ do
OleResult := UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind);
if OleResult <> S_OK then
RaiseOleError('UnRegisterTypeLib', OleResult);
finally
TypeLib.ReleaseTLibAttr(LibAttr);
end;
finally
TypeLib.Release;
end;
finally
SysFreeString(WideFilename);
end;
end;
{$ELSE}
var
UnRegTlbProc: TUnRegTlbProc;
WideFilename: WideString;
@ -545,7 +260,6 @@ begin
TypeLib.ReleaseTLibAttr(LibAttr);
end;
end;
{$ENDIF}
const
CLSID_StartMenuPin: TGUID = (
@ -557,28 +271,11 @@ const
IID_ShellItem: TGUID = (
D1:$43826D1E; D2:$E718; D3:$42EE; D4:($BC,$55,$A1,$E2,$61,$C3,$7B,$FE));
{$IFNDEF Delphi3OrHigher}
type
IShellItem = class(IUnknown)
function BindToHandler(const pbc: IBindCtx; const bhid: TGUID;
const riid: TIID; var ppv): HResult; virtual; stdcall; abstract;
function GetParent(var ppsi: IShellItem): HResult; virtual; stdcall; abstract;
function GetDisplayName(sigdnName: DWORD; var ppszName: LPWSTR): HResult; virtual; stdcall; abstract;
function GetAttributes(sfgaoMask: DWORD; var psfgaoAttribs: DWORD): HResult; virtual; stdcall; abstract;
function Compare(const psi: IShellItem; hint: DWORD;
var piOrder: Integer): HResult; virtual; stdcall; abstract;
end;
IStartMenuPinnedList = class(IUnknown)
function RemoveFromList(const pitem: IShellItem): HRESULT; virtual; stdcall; abstract;
end;
{$ELSE}
type
IStartMenuPinnedList = interface(IUnknown)
['{4CD19ADA-25A5-4A32-B3B7-347BEE5BE36B}']
function RemoveFromList(const pitem: IShellItem): HRESULT; stdcall;
end;
{$ENDIF}
var
SHCreateItemFromParsingNameFunc: function(pszPath: LPCWSTR; const pbc: IBindCtx;
@ -589,40 +286,17 @@ var
was not pinned at all. http://msdn.microsoft.com/en-us/library/bb774817.aspx }
function UnpinShellLink(const Filename: String): Boolean;
var
{$IFNDEF Delphi3OrHigher}
WideFileName: PWideChar;
{$ELSE}
WideFileName: WideString;
{$ENDIF}
ShellItem: IShellItem;
StartMenuPinnedList: IStartMenuPinnedList;
begin
{$IFNDEF Delphi3OrHigher}
ShellItem := nil;
StartMenuPinnedList := nil;
WideFilename := StringToOleStr(PathExpand(Filename));
if WideFilename = nil then
OutOfMemoryError;
try
{$ELSE}
WideFilename := PathExpand(Filename);
{$ENDIF}
if IsWindowsVista and //only attempt on Windows Vista and newer just to be sure
Assigned(SHCreateItemFromParsingNameFunc) and
if Assigned(SHCreateItemFromParsingNameFunc) and
SUCCEEDED(SHCreateItemFromParsingNameFunc(PWideChar(WideFilename), nil, IID_ShellItem, ShellItem)) and
SUCCEEDED(CoCreateInstance(CLSID_StartMenuPin, nil, CLSCTX_INPROC_SERVER, IID_StartMenuPinnedList, StartMenuPinnedList)) then
Result := StartMenuPinnedList.RemoveFromList(ShellItem) = S_OK
else
Result := True;
{$IFNDEF Delphi3OrHigher}
finally
SysFreeString(WideFilename);
if StartMenuPinnedList <> nil then
StartMenuPinnedList.Release;
if ShellItem <> nil then
ShellItem.Release;
end;
{$ENDIF}
end;
procedure InitOle;

375
Projects/InstFunc.pas
View File

@ -2,7 +2,7 @@ unit InstFunc;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -72,19 +72,13 @@ function GetFileDateTime(const DisableFsRedir: Boolean; const Filename: String;
var DateTime: TFileTime): Boolean;
function GetMD5OfFile(const DisableFsRedir: Boolean; const Filename: String): TMD5Digest;
function GetMD5OfAnsiString(const S: AnsiString): TMD5Digest;
{$IFDEF UNICODE}
function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest;
{$ENDIF}
function GetSHA1OfFile(const DisableFsRedir: Boolean; const Filename: String): TSHA1Digest;
function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest;
{$IFDEF UNICODE}
function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest;
{$ENDIF}
function GetSHA256OfFile(const DisableFsRedir: Boolean; const Filename: String): String;
function GetSHA256OfAnsiString(const S: AnsiString): String;
{$IFDEF UNICODE}
function GetSHA256OfUnicodeString(const S: UnicodeString): String;
{$ENDIF}
function GetRegRootKeyName(const RootKey: HKEY): String;
function GetSpaceOnDisk(const DisableFsRedir: Boolean; const DriveRoot: String;
var FreeBytes, TotalBytes: Integer64): Boolean;
@ -122,7 +116,8 @@ function ForceDirectories(const DisableFsRedir: Boolean; Dir: String): Boolean;
implementation
uses
Messages, ShellApi, PathFunc, Msgs, MsgIDs, FileClass, RedirFunc, SetupTypes, Hash, Classes;
Messages, ShellApi, PathFunc, Msgs, MsgIDs, FileClass, RedirFunc, SetupTypes,
Hash, Classes, RegStr;
procedure InternalError(const Id: String);
begin
@ -347,8 +342,7 @@ begin
end;
function ReplaceSystemDirWithSysNative(Path: String; const IsWin64: Boolean): String;
{ If the user is running 64-bit Windows Vista or newer and Path
begins with 'x:\windows\system32\' it replaces it with
{ If Path begins with 'x:\windows\system32\' it replaces it with
'x:\windows\sysnative\' and if Path equals 'x:\windows\system32'
it replaces it with 'x:\windows\sysnative'. Otherwise, Path is
returned unchanged. }
@ -384,93 +378,23 @@ end;
procedure RestartReplace(const DisableFsRedir: Boolean; TempFile, DestFile: String);
{ Renames TempFile to DestFile the next time Windows is started. If DestFile
already existed, it will be overwritten. If DestFile is '' then TempFile
will be deleted, however this is only supported by 95/98 and NT, not
Windows 3.1x. }
var
WinDir, WinInitFile, TempWinInitFile: String;
OldF: TTextFileReader;
NewF: TTextFileWriter;
L, L2: String;
RenameSectionFound, WriteLastLine: Boolean;
will be deleted.. }
begin
TempFile := PathExpand(TempFile);
if DestFile <> '' then
DestFile := PathExpand(DestFile);
if not UsingWinNT then begin
{ Because WININIT.INI allows multiple entries with the same name,
it must manually parse the file instead of using
WritePrivateProfileString }
WinDir := GetWinDir;
WinInitFile := AddBackslash(WinDir) + 'WININIT.INI';
TempWinInitFile := GenerateUniqueName(False, WinDir, '.tmp');
try
OldF := nil;
NewF := nil;
try
{ Flush Windows' cache for the file first }
WritePrivateProfileString(nil, nil, nil, PChar(WinInitFile));
OldF := TTextFileReader.Create(WinInitFile, fdOpenAlways, faRead,
fsRead);
NewF := TTextFileWriter.Create(TempWinInitFile, fdCreateAlways,
faWrite, fsNone);
RenameSectionFound := False;
WriteLastLine := False;
while not OldF.Eof do begin
L := OldF.ReadLine;
WriteLastLine := True;
L2 := Trim(L);
if (L2 <> '') and (L2[1] = '[') then begin
if CompareText(L2, '[rename]') = 0 then
RenameSectionFound := True
else
if RenameSectionFound then
Break;
end;
NewF.WriteLine(L);
WriteLastLine := False;
end;
if not RenameSectionFound then
NewF.WriteLine('[rename]');
if DestFile <> '' then
L2 := GetShortName(DestFile)
else
L2 := 'NUL';
NewF.WriteLine(L2 + '=' + GetShortName(TempFile));
if WriteLastLine then
NewF.WriteLine(L);
while not OldF.Eof do begin
L := OldF.ReadLine;
NewF.WriteLine(L);
end;
finally
NewF.Free;
OldF.Free;
end;
{ Strip any read-only attribute }
SetFileAttributes(PChar(WinInitFile), FILE_ATTRIBUTE_ARCHIVE);
if not DeleteFile(WinInitFile) then
Win32ErrorMsg('DeleteFile');
if not MoveFile(PChar(TempWinInitFile), PChar(WinInitFile)) then
Win32ErrorMsg('MoveFile');
except
DeleteFile(TempWinInitFile);
raise;
end;
end
else begin
if not DisableFsRedir then begin
{ Work around WOW64 bug present in the IA64 and x64 editions of Windows
XP (3790) and Server 2003 prior to SP1 RC2: MoveFileEx writes filenames
to the registry verbatim without mapping system32->syswow64. }
TempFile := ReplaceSystemDirWithSysWow64(TempFile);
if DestFile <> '' then
DestFile := ReplaceSystemDirWithSysWow64(DestFile);
end;
if not MoveFileExRedir(DisableFsRedir, TempFile, DestFile,
MOVEFILE_DELAY_UNTIL_REBOOT or MOVEFILE_REPLACE_EXISTING) then
Win32ErrorMsg('MoveFileEx');
if not DisableFsRedir then begin
{ Work around WOW64 bug present in the IA64 and x64 editions of Windows
XP (3790) and Server 2003 prior to SP1 RC2: MoveFileEx writes filenames
to the registry verbatim without mapping system32->syswow64. }
TempFile := ReplaceSystemDirWithSysWow64(TempFile);
if DestFile <> '' then
DestFile := ReplaceSystemDirWithSysWow64(DestFile);
end;
if not MoveFileExRedir(DisableFsRedir, TempFile, DestFile,
MOVEFILE_DELAY_UNTIL_REBOOT or MOVEFILE_REPLACE_EXISTING) then
Win32ErrorMsg('MoveFileEx');
end;
function DelTree(const DisableFsRedir: Boolean; const Path: String;
@ -593,7 +517,7 @@ end;
procedure IncrementSharedCount(const RegView: TRegView; const Filename: String;
const AlreadyExisted: Boolean);
const
SharedDLLsKey = NEWREGSTR_PATH_SETUP + '\SharedDLLs'; {don't localize}
SharedDLLsKey = REGSTR_PATH_SETUP + '\SharedDLLs'; {don't localize}
var
ErrorCode: Longint;
K: HKEY;
@ -656,7 +580,7 @@ function DecrementSharedCount(const RegView: TRegView;
{ Attempts to decrement the shared file reference count of Filename. Returns
True if the count reached zero (meaning it's OK to delete the file). }
const
SharedDLLsKey = NEWREGSTR_PATH_SETUP + '\SharedDLLs'; {don't localize}
SharedDLLsKey = REGSTR_PATH_SETUP + '\SharedDLLs'; {don't localize}
var
ErrorCode: Longint;
K: HKEY;
@ -815,24 +739,20 @@ begin
Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1]));
end;
{$IFDEF UNICODE}
function GetMD5OfUnicodeString(const S: UnicodeString): TMD5Digest;
begin
Result := MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1]));
end;
{$ENDIF}
function GetSHA1OfAnsiString(const S: AnsiString): TSHA1Digest;
begin
Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1]));
end;
{$IFDEF UNICODE}
function GetSHA1OfUnicodeString(const S: UnicodeString): TSHA1Digest;
begin
Result := SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1]));
end;
{$ENDIF}
function GetSHA256OfAnsiString(const S: AnsiString): String;
var
@ -848,7 +768,6 @@ begin
end;
end;
{$IFDEF UNICODE}
function GetSHA256OfUnicodeString(const S: UnicodeString): String;
var
M: TMemoryStream;
@ -862,7 +781,6 @@ begin
M.Free;
end;
end;
{$ENDIF}
var
SFCInitialized: Boolean;
@ -875,9 +793,6 @@ function IsProtectedSystemFile(const DisableFsRedir: Boolean;
var
M: HMODULE;
FN: String;
{$IFNDEF UNICODE}
Buf: array[0..4095] of WideChar;
{$ENDIF}
begin
if not SFCInitialized then begin
M := SafeLoadLibrary(PChar(AddBackslash(GetSystemDir) + 'sfc.dll'),
@ -893,18 +808,10 @@ begin
FN := PathExpand(Filename);
if not DisableFsRedir then
FN := ReplaceSystemDirWithSysWow64(FN);
{$IFDEF UNICODE}
Result := SfcIsFileProtectedFunc(0, PChar(FN));
{$ELSE}
Buf[MultiByteToWideChar(CP_ACP, 0, PChar(FN), Length(FN), Buf,
(SizeOf(Buf) div SizeOf(Buf[0])) - 1)] := #0;
Result := (Buf[0] <> #0) and SfcIsFileProtectedFunc(0, Buf);
{$ENDIF}
end
else begin
{ Windows File Protection doesn't exist on Windows 95/98/NT4 }
Result := False;
end;
else
Result := False; { Should never happen }
end;
procedure HandleProcessWait(ProcessHandle: THandle; const Wait: TExecWait;
@ -960,16 +867,13 @@ begin
Filename: "c:\batch.bat"; Parameters: """abc"""
And other Windows versions might have unknown quirks too, since
CreateProcess isn't documented to accept .bat files in the first place. }
if UsingWinNT then
{ With cmd.exe, the whole command line must be quoted for quoted
parameters to work. For example, this fails:
cmd.exe /c "z:\blah.bat" "test"
But this works:
cmd.exe /c ""z:\blah.bat" "test""
}
CmdLine := '"' + AddBackslash(GetSystemDir) + 'cmd.exe" /C "' + CmdLine + '"'
else
CmdLine := '"' + AddBackslash(GetWinDir) + 'COMMAND.COM" /C ' + CmdLine;
{ With cmd.exe, the whole command line must be quoted for quoted
parameters to work. For example, this fails:
cmd.exe /c "z:\blah.bat" "test"
But this works:
cmd.exe /c ""z:\blah.bat" "test""
}
CmdLine := '"' + AddBackslash(GetSystemDir) + 'cmd.exe" /C "' + CmdLine + '"'
end;
if WorkingDir = '' then
WorkingDir := PathExtractDir(Filename);
@ -1141,44 +1045,35 @@ function NewAdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BO
external advapi32 name 'AdjustTokenPrivileges';
function RestartComputer: Boolean;
{ Restarts the computer. On Windows 9x/Me, the function will NOT return if it
is successful. }
{ Restarts the computer. }
var
Token: THandle;
TokenPriv: TTokenPrivileges;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; { don't localize }
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
{$IFNDEF Delphi3orHigher} @Token {$ELSE} Token {$ENDIF}) then begin
Result := False;
Exit;
end;
if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
Token) then begin
Result := False;
Exit;
end;
LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TokenPriv.Privileges[0].Luid);
LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TokenPriv.Privileges[0].Luid);
TokenPriv.PrivilegeCount := 1;
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1;
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
NewAdjustTokenPrivileges(Token, False, TokenPriv, 0, nil, nil);
NewAdjustTokenPrivileges(Token, False, TokenPriv, 0, nil, nil);
{ Cannot test the return value of AdjustTokenPrivileges. }
if GetLastError <> ERROR_SUCCESS then begin
Result := False;
Exit;
end;
{ Cannot test the return value of AdjustTokenPrivileges. }
if GetLastError <> ERROR_SUCCESS then begin
Result := False;
Exit;
end;
Result := ExitWindowsEx(EWX_REBOOT, 0);
{ On Windows 9x/Me:
ExitWindowsEx synchronously sends WM_QUERYENDSESSION messages to all
processes except the current process. If any WM_QUERYENDSESSION handler
blocks the shutdown, it returns False. Otherwise, it kills the current
process and does not return.
On NT platforms:
ExitWindowsEx returns True immediately. The system then asynchronously
{ ExitWindowsEx returns True immediately. The system then asynchronously
sends WM_QUERYENDSESSION messages to all processes, including the current
process. The current process is not killed until it has received
WM_QUERYENDSESSION and WM_ENDSESSION messages. }
@ -1206,48 +1101,24 @@ end;
function MakePendingFileRenameOperationsChecksum: TMD5Digest;
{ Calculates a checksum of the current PendingFileRenameOperations registry
value (on NT 4+ platforms) or of the current WININIT.INI file (on non-NT
platforms). The caller can use this checksum to determine if
PendingFileRenameOperations or WININIT.INI was changed (perhaps by another
program). }
value The caller can use this checksum to determine if
PendingFileRenameOperations was changed (perhaps by another program). }
var
Context: TMD5Context;
K: HKEY;
S: String;
WinInitFile: String;
F: TFile;
Buf: array[0..4095] of Byte;
BytesRead: Cardinal;
begin
MD5Init(Context);
try
if UsingWinNT then begin
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
if RegQueryMultiStringValue(K, 'PendingFileRenameOperations', S) then
MD5Update(Context, S[1], Length(S)*SizeOf(S[1]));
{ When "PendingFileRenameOperations" is full, it spills over into
"PendingFileRenameOperations2" }
if RegQueryMultiStringValue(K, 'PendingFileRenameOperations2', S) then
MD5Update(Context, S[1], Length(S)*SizeOf(S[1]));
RegCloseKey(K);
end;
end
else begin
WinInitFile := AddBackslash(GetWinDir) + 'WININIT.INI';
if NewFileExists(WinInitFile) then begin
F := TFile.Create(WinInitFile, fdOpenExisting, faRead, fsRead);
try
while True do begin
BytesRead := F.Read(Buf, SizeOf(Buf));
if BytesRead = 0 then
Break;
MD5Update(Context, Buf, BytesRead);
end;
finally
F.Free;
end;
end;
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
if RegQueryMultiStringValue(K, 'PendingFileRenameOperations', S) then
MD5Update(Context, S[1], Length(S)*SizeOf(S[1]));
{ When "PendingFileRenameOperations" is full, it spills over into
"PendingFileRenameOperations2" }
if RegQueryMultiStringValue(K, 'PendingFileRenameOperations2', S) then
MD5Update(Context, S[1], Length(S)*SizeOf(S[1]));
RegCloseKey(K);
end;
except
{ don't propagate exceptions }
@ -1261,101 +1132,46 @@ procedure EnumFileReplaceOperationsFilenames(const EnumFunc: TEnumFROFilenamesPr
registry value or WININIT.INI file. The function does not distinguish between
source and destination filenames; it enumerates both. }
procedure DoNT;
procedure DoValue(const K: HKEY; const ValueName: PChar);
var
S: String;
P, PEnd: PChar;
begin
if not RegQueryMultiStringValue(K, ValueName, S) then
Exit;
P := PChar(S);
PEnd := P + Length(S);
while P < PEnd do begin
if P[0] = '!' then
{ Note: '!' means that MoveFileEx was called with the
MOVEFILE_REPLACE_EXISTING flag }
Inc(P);
if StrLComp(P, '\??\', 4) = 0 then begin
Inc(P, 4);
if P[0] <> #0 then
EnumFunc(P, Param);
end;
Inc(P, StrLen(P) + 1);
end;
end;
procedure DoValue(const K: HKEY; const ValueName: PChar);
var
K: HKEY;
S: String;
P, PEnd: PChar;
begin
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
try
DoValue(K, 'PendingFileRenameOperations');
{ When "PendingFileRenameOperations" is full, it spills over into
"PendingFileRenameOperations2" }
DoValue(K, 'PendingFileRenameOperations2');
finally
RegCloseKey(K);
end;
end;
end;
procedure DoNonNT;
var
WinInitFile: String;
F: TTextFileReader;
Line, Filename: String;
InRenameSection: Boolean;
P: Integer;
begin
WinInitFile := AddBackslash(GetWinDir) + 'WININIT.INI';
if not NewFileExists(WinInitFile) then
if not RegQueryMultiStringValue(K, ValueName, S) then
Exit;
try
F := TTextFileReader.Create(WinInitFile, fdOpenExisting, faRead, fsRead);
try
InRenameSection := False;
while not F.Eof do begin
Line := Trim(F.ReadLine);
if (Line = '') or (Line[1] = ';') then
Continue;
if Line[1] = '[' then begin
InRenameSection := (CompareText(Line, '[rename]') = 0);
end
else if InRenameSection then begin
P := Pos('=', Line);
if P > 0 then begin
Filename := Copy(Line, 1, P-1);
if (Filename <> '') and (CompareText(Filename, 'NUL') <> 0) then
EnumFunc(Filename, Param);
Filename := Copy(Line, P+1, Maxint);
if (Filename <> '') and (CompareText(Filename, 'NUL') <> 0) then
EnumFunc(Filename, Param);
end;
end;
end;
finally
F.Free;
P := PChar(S);
PEnd := P + Length(S);
while P < PEnd do begin
if P[0] = '!' then
{ Note: '!' means that MoveFileEx was called with the
MOVEFILE_REPLACE_EXISTING flag }
Inc(P);
if StrLComp(P, '\??\', 4) = 0 then begin
Inc(P, 4);
if P[0] <> #0 then
EnumFunc(P, Param);
end;
except
{ ignore exceptions }
Inc(P, StrLen(P) + 1);
end;
end;
var
K: HKEY;
begin
if UsingWinNT then
DoNT
else
DoNonNT;
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Control\Session Manager',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
try
DoValue(K, 'PendingFileRenameOperations');
{ When "PendingFileRenameOperations" is full, it spills over into
"PendingFileRenameOperations2" }
DoValue(K, 'PendingFileRenameOperations2');
finally
RegCloseKey(K);
end;
end;
end;
procedure UnregisterFont(const FontName, FontFilename: String; const PerUserFont: Boolean);
const
FontsKeys: array[Boolean] of PChar =
(NEWREGSTR_PATH_SETUP + '\Fonts',
'Software\Microsoft\Windows NT\CurrentVersion\Fonts');
var
RootKey, K: HKEY;
begin
@ -1364,7 +1180,7 @@ begin
else
RootKey := HKEY_LOCAL_MACHINE;
if RegOpenKeyExView(rvDefault, RootKey, FontsKeys[UsingWinNT],
if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts',
0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
RegDeleteValue(K, PChar(FontName));
RegCloseKey(K);
@ -1388,7 +1204,7 @@ begin
GetDiskFreeSpaceEx, however, *does* succeed with UNC paths, so use it
if available. }
GetDiskFreeSpaceExFunc := GetProcAddress(GetModuleHandle(kernel32),
{$IFDEF UNICODE}'GetDiskFreeSpaceExW'{$ELSE}'GetDiskFreeSpaceExA'{$ENDIF});
'GetDiskFreeSpaceExW');
if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
Result := False;
Exit;
@ -1403,9 +1219,8 @@ begin
DWORD(SectorsPerCluster), DWORD(BytesPerSector), DWORD(FreeClusters),
DWORD(TotalClusters));
if Result then begin
{ Windows 95/98 cap the result of GetDiskFreeSpace at 2GB, but NT 4.0
does not, so we must use a 64-bit multiply operation to avoid an
overflow. }
{ The result of GetDiskFreeSpace does not cap at 2GB, so we must use a
64-bit multiply operation to avoid an overflow. }
Multiply32x32to64(BytesPerSector * SectorsPerCluster, FreeClusters,
FreeBytes);
Multiply32x32to64(BytesPerSector * SectorsPerCluster, TotalClusters,
@ -1442,8 +1257,7 @@ end;
procedure RefreshEnvironment;
{ Notifies other applications (Explorer) that environment variables have
changed. Based on code from KB article 104011.
Note: Win9x's Explorer ignores this message. }
changed. Based on code from KB article 104011. }
var
MsgResult: DWORD_PTR;
begin
@ -1484,7 +1298,6 @@ function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryP
{ Finds the index of the language entry that most closely matches the user's
UI language / locale. If no match is found, ResultIndex is set to 0. }
{$IFDEF UNICODE}
function GetCodePageFromLangID(const ALangID: LANGID): Integer;
const
LOCALE_RETURN_NUMBER = $20000000;
@ -1497,7 +1310,6 @@ function DetermineDefaultLanguage(const GetLanguageEntryProc: TGetLanguageEntryP
else
Result := -1;
end;
{$ENDIF}
var
I: Integer;
@ -1532,14 +1344,9 @@ begin
I := 0;
while GetLanguageEntryProc(I, LangEntry) do begin
if LangEntry.LanguageID = UILang then begin
{$IFNDEF UNICODE}
if (LangEntry.LanguageCodePage = 0) or (LangEntry.LanguageCodePage = GetACP) then
{$ENDIF}
begin
ResultIndex := I;
Result := ddMatch;
Exit;
end;
ResultIndex := I;
Result := ddMatch;
Exit;
end;
Inc(I);
end;
@ -1547,9 +1354,6 @@ begin
I := 0;
while GetLanguageEntryProc(I, LangEntry) do begin
if (LangEntry.LanguageID and $3FF) = (UILang and $3FF) then begin
{$IFNDEF UNICODE}
if (LangEntry.LanguageCodePage = 0) or (LangEntry.LanguageCodePage = GetACP) then
{$ELSE}
{ On Unicode, there is no LanguageCodePage filter, so we have to check
the language IDs to ensure we don't return Simplified Chinese on a
Traditional Chinese system, or vice versa.
@ -1559,7 +1363,6 @@ begin
Traditional Chinese LANGIDs ($0404, $0C04, $1404) use CP 950 }
if ((UILang and $3FF) <> LANG_CHINESE) or
(GetCodePageFromLangID(LangEntry.LanguageID) = GetCodePageFromLangID(UILang)) then
{$ENDIF}
begin
ResultIndex := I;
Result := ddMatch;

161
Projects/Install.pas
View File

@ -2,7 +2,7 @@ unit Install;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -35,7 +35,7 @@ uses
Compress, SHA1, PathFunc, CmnFunc, CmnFunc2, RedirFunc, Int64Em, MsgIDs,
Wizard, DebugStruct, DebugClient, VerInfo, ScriptRunner, RegDLL, Helper,
ResUpdate, DotNet, TaskbarProgressFunc, NewProgressBar, RestartManager,
Net.HTTPClient, Net.URLClient, NetEncoding;
Net.HTTPClient, Net.URLClient, NetEncoding, RegStr;
type
TSetupUninstallLog = class(TUninstallLog)
@ -395,7 +395,6 @@ var
end;
function PackCompiledCodeTextIntoString(const CompiledCodeText: AnsiString): String;
{$IFDEF UNICODE}
var
N: Integer;
begin
@ -404,21 +403,12 @@ var
Inc(N); { This will lead to 1 extra byte being moved but that's ok since it is the #0 }
N := N div 2;
SetString(Result, PChar(Pointer(CompiledCodeText)), N);
{$ELSE}
begin
Result := CompiledCodeText;
{$ENDIF}
end;
procedure RecordCompiledCode;
var
LeadBytesStr, ExpandedApp, ExpandedGroup, CustomMessagesStr: String;
begin
{$IFNDEF UNICODE}
SetString(LeadBytesStr, PChar(@SetupHeader.LeadBytes),
SizeOf(SetupHeader.LeadBytes));
{$ENDIF}
{ Only use app if Setup creates one }
if shCreateAppDir in SetupHeader.Options then
ExpandedApp := ExpandConst('{app}')
@ -438,7 +428,7 @@ var
{ Record [Code] even if empty to 'overwrite' old versions }
UninstLog.Add(utCompiledCode, [PackCompiledCodeTextIntoString(SetupHeader.CompiledCodeText),
LeadBytesStr, ExpandedApp, ExpandedGroup, WizardGroupValue,
ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion {$IFDEF UNICODE} or Longint($80000000) {$ENDIF});
ExpandConst('{language}'), CustomMessagesStr], SetupBinVersion or Longint($80000000));
end;
type
@ -683,13 +673,9 @@ var
else
Z := ExpandedAppVerName;
HandleDuplicateDisplayNames(Z);
{ For the entry to appear in ARP, DisplayName cannot exceed 63 characters
on Windows 9x/NT 4.0, or 259 characters on Windows 2000 and later. }
if WindowsVersionAtLeast(5, 0) then
I := 259
else
I := 63;
SetStringValue(H2, 'DisplayName', Copy(Z, 1, I));
{ For the entry to appear in ARP, DisplayName cannot exceed 259 characters
on Windows 2000 and later. }
SetStringValue(H2, 'DisplayName', Copy(Z, 1, 259));
SetStringValueUnlessEmpty(H2, 'DisplayIcon', ExpandConst(SetupHeader.UninstallDisplayIcon));
var ExtraUninstallString: String;
if shUninstallLogging in SetupHeader.Options then
@ -721,29 +707,25 @@ var
SetDWordValue(H2, 'VersionMajor', MajorVersion);
SetDWordValue(H2, 'VersionMinor', MinorVersion);
end;
{ Note: Windows 7 doesn't automatically calculate sizes so set EstimatedSize ourselves. Do not set it
on earlier Windows versions since calculated sizes are cached and clearing the cache would require
updating an undocumented key at HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Management\ARPCache\<id>. }
if WindowsVersion shr 16 >= $0601 then begin
if (SetupHeader.UninstallDisplaySize.Hi = 0) and (SetupHeader.UninstallDisplaySize.Lo = 0) then begin
{ Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
EstimatedSize := AfterInstallFilesSize;
Inc6464(EstimatedSize, SetupHeader.ExtraDiskSpaceRequired);
for I := 0 to Entries[seComponent].Count-1 do begin
with PSetupComponentEntry(Entries[seComponent][I])^ do begin
if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
Inc6464(EstimatedSize, ExtraDiskSpaceRequired);
end;
{ Note: Windows 7 (and later?) doesn't automatically calculate sizes so set EstimatedSize ourselves. }
if (SetupHeader.UninstallDisplaySize.Hi = 0) and (SetupHeader.UninstallDisplaySize.Lo = 0) then begin
{ Estimate the size by taking the size of all files and adding any ExtraDiskSpaceRequired. }
EstimatedSize := AfterInstallFilesSize;
Inc6464(EstimatedSize, SetupHeader.ExtraDiskSpaceRequired);
for I := 0 to Entries[seComponent].Count-1 do begin
with PSetupComponentEntry(Entries[seComponent][I])^ do begin
if ShouldProcessEntry(WizardComponents, nil, Name, '', Languages, '') then
Inc6464(EstimatedSize, ExtraDiskSpaceRequired);
end;
end else
EstimatedSize := SetupHeader.UninstallDisplaySize;
{ ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
So we need to check for this. Already checked this is Windows 7 or newer above. }
if (Hi(NTServicePackLevel) > 0) or (WindowsVersion shr 16 > $0601) or (EstimatedSize.Hi = 0) then begin
Div64(EstimatedSize, 1024);
SetDWordValue(H2, 'EstimatedSize', EstimatedSize.Lo)
end;
end else
EstimatedSize := SetupHeader.UninstallDisplaySize;
{ ARP on Windows 7 without SP1 only pays attention to the lower 6 bytes of EstimatedSize and
throws away the rest. For example putting in $4000001 (=4GB + 1KB) displays as 1 KB.
So we need to check for this. }
if (Hi(NTServicePackLevel) > 0) or (WindowsVersion shr 16 > $0601) or (EstimatedSize.Hi = 0) then begin
Div64(EstimatedSize, 1024);
SetDWordValue(H2, 'EstimatedSize', EstimatedSize.Lo)
end;
{ Also see SetPreviousData in ScriptFunc.pas }
@ -906,11 +888,7 @@ var
anti-spyware programs that catch all unins*.exe files with certain MD5
sums just because some piece of spyware was deployed with Inno Setup and
had the unins*.exe file in its directory. }
{$IFDEF UNICODE}
UniqueValue := GetSHA1OfUnicodeString(ExpandedAppId);
{$ELSE}
UniqueValue := GetSHA1OfAnsiString(ExpandedAppId);
{$ENDIF}
F.WriteBuffer(UniqueValue, SizeOf(UniqueValue));
UninstallerMsgTail.ID := UninstallerMsgTailID;
@ -930,10 +908,6 @@ var
procedure InstallFont(const Filename, FontName: String;
const PerUserFont, AddToFontTableNow: Boolean; var WarnedPerUserFonts: Boolean);
const
FontsKeys: array[Boolean] of PChar =
(NEWREGSTR_PATH_SETUP + '\Fonts',
'Software\Microsoft\Windows NT\CurrentVersion\Fonts');
var
RootKey, K: HKEY;
begin
@ -956,7 +930,7 @@ var
RootKey := HKEY_CURRENT_USER
else
RootKey := HKEY_LOCAL_MACHINE;
if RegOpenKeyExView(rvDefault, RootKey, FontsKeys[IsNT], 0,
if RegOpenKeyExView(rvDefault, RootKey, 'Software\Microsoft\Windows NT\CurrentVersion\Fonts', 0,
KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
if RegSetValueEx(K, PChar(FontName), 0, REG_SZ, PChar(Filename),
(Length(Filename)+1)*SizeOf(Filename[1])) <> ERROR_SUCCESS then
@ -1183,19 +1157,12 @@ var
Log('Non-default bitness: 32-bit');
end;
{ See if it's a protected system file.
Note: We don't call IsProtectedSystemFile anymore on Windows Me
even though it supports WFP. Two users reported that installs ran
very slowly on 4.2.1, and with the help of one of the users, the
cause was narrowed down to this call. For him, it was taking 6
seconds per call. I have no idea what would cause it to be so
slow; it only took a few milliseconds in my tests on Windows Me. }
IsProtectedFile := False;
if IsNT and (WindowsVersion >= Cardinal($05000000)) then
if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
Log('Dest file is protected by Windows File Protection.');
IsProtectedFile := (CurFile^.FileType = ftUserFile);
end;
{ See if it's a protected system file. }
if IsProtectedSystemFile(DisableFsRedir, DestFile) then begin
Log('Dest file is protected by Windows File Protection.');
IsProtectedFile := (CurFile^.FileType = ftUserFile);
end else
IsProtectedFile := False;
DestFileExists := NewFileExistsRedir(DisableFsRedir, DestFile);
if not CheckedDestFileExistedBefore then begin
@ -1972,14 +1939,10 @@ var
'IconIndex=' + IntToStr(IconIndex) + SNewLine;
F := TTextFileWriter.Create(Filename, fdCreateAlways, faWrite, fsNone);
try
{$IFDEF UNICODE}
if SameText(S, String(AnsiString(S))) then
F.WriteAnsi(AnsiString(S))
else
F.Write(S);
{$ELSE}
F.Write(S);
{$ENDIF}
finally
F.Free;
end;
@ -2008,15 +1971,15 @@ var
procedure CreateAnIcon(Name: String; const Description, Path, Parameters,
WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
const NeverUninstall: Boolean; const CloseOnExit: TSetupIconCloseOnExit;
const HotKey: Word; FolderShortcut: Boolean;
const AppUserModelID: String; const AppUserModelToastActivatorCLSID: PGUID;
const HotKey: Word; const AppUserModelID: String;
const AppUserModelToastActivatorCLSID: PGUID;
const ExcludeFromShowInNewInstall, PreventPinning: Boolean);
var
BeginsWithGroup: Boolean;
LinkFilename, PifFilename, UrlFilename, DirFilename, ProbableFilename,
ResultingFilename: String;
Flags: TMakeDirFlags;
URLShortcut, FolderShortcutCreated: Boolean;
URLShortcut: Boolean;
begin
BeginsWithGroup := Copy(Name, 1, 8) = '{group}\';
{ Note: PathExpand removes trailing spaces, so it can't be called on
@ -2033,12 +1996,6 @@ var
else if BeginsWithGroup then
Include(Flags, mdAlwaysUninstall);
{ On Windows 7, folder shortcuts don't expand properly on the Start Menu
(they just show "target"), so ignore the foldershortcut flag.
(Windows Vista works fine.) }
if FolderShortcut and WindowsVersionAtLeast(6, 1) then
FolderShortcut := False;
URLShortcut := IsPathURL(Path);
if URLShortcut then
ProbableFilename := UrlFilename
@ -2066,12 +2023,11 @@ var
environment-variable strings (e.g. %SystemRoot%\...) }
ResultingFilename := CreateShellLink(LinkFilename, Description, Path,
Parameters, WorkingDir, IconFilename, IconIndex, ShowCmd, HotKey,
FolderShortcut, AppUserModelID, AppUserModelToastActivatorCLSID,
AppUserModelID, AppUserModelToastActivatorCLSID,
ExcludeFromShowInNewInstall, PreventPinning);
FolderShortcutCreated := FolderShortcut and DirExists(ResultingFilename);
{ If a .pif file was created, apply the "Close on exit" setting }
if (CloseOnExit <> icNoSetting) and not FolderShortcutCreated and
if (CloseOnExit <> icNoSetting) and
(CompareText(PathExtractExt(ResultingFilename), '.pif') = 0) then begin
try
ModifyPifFile(ResultingFilename, CloseOnExit = icYes);
@ -2084,7 +2040,6 @@ var
{ Create an Internet Shortcut (.url) file }
CreateURLFile(UrlFilename, Path, IconFilename, IconIndex);
ResultingFilename := UrlFilename;
FolderShortcutCreated := False;
end;
Log('Successfully created the icon.');
@ -2093,24 +2048,14 @@ var
CreatedIcon := True;
{ Notify shell of the change }
if FolderShortcutCreated then
SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(ResultingFilename), nil)
else
SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
SHChangeNotify(SHCNE_CREATE, SHCNF_PATH, PChar(ResultingFilename), nil);
SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
PChar(PathExtractDir(ResultingFilename)), nil);
{ Add uninstall log entries }
if not NeverUninstall then begin
if FolderShortcutCreated then begin
UninstLog.Add(utDeleteDirOrFiles, [ResultingFilename],
utDeleteDirOrFiles_IsDir or utDeleteDirOrFiles_CallChangeNotify);
UninstLog.Add(utDeleteFile, [AddBackslash(ResultingFilename) + 'target.lnk'], 0);
UninstLog.Add(utDeleteFile, [AddBackslash(ResultingFilename) + 'Desktop.ini'], 0);
end
else if URLShortcut then begin
UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify);
end
if URLShortcut then
UninstLog.Add(utDeleteFile, [ResultingFilename], utDeleteFile_CallChangeNotify)
else begin
{ Even though we only created one file, go ahead and try deleting
both a .lnk and .pif file at uninstall time, in case the user
@ -2122,14 +2067,12 @@ var
end;
function ExpandAppPath(const Filename: String): String;
const
AppPathsBaseKey = NEWREGSTR_PATH_SETUP + '\App Paths\';
var
K: HKEY;
Found: Boolean;
begin
if RegOpenKeyExView(InstallDefaultRegView, HKEY_LOCAL_MACHINE,
PChar(AppPathsBaseKey + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
PChar(REGSTR_PATH_APPPATHS + '\' + Filename), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
Found := RegQueryStringValue(K, '', Result);
RegCloseKey(K);
if Found then
@ -2164,7 +2107,7 @@ var
ExpandConst(Parameters), ExpandConst(WorkingDir),
ExpandConst(IconFilename), IconIndex, ShowCmd,
ioUninsNeverUninstall in Options, CloseOnExit, HotKey,
ioFolderShortcut in Options, ExpandConst(AppUserModelID), TACLSID,
ExpandConst(AppUserModelID), TACLSID,
ioExcludeFromShowInNewInstall in Options,
ioPreventPinning in Options)
end else
@ -2320,10 +2263,8 @@ var
NeedToRetry, DidDeleteKey: Boolean;
ErrorCode: Longint;
QV: Integer64;
{$IFDEF UNICODE}
I: Integer;
AnsiS: AnsiString;
{$ENDIF}
begin
for CurRegNumber := 0 to Entries[seRegistry].Count-1 do begin
with PSetupRegistryEntry(Entries[seRegistry][CurRegNumber])^ do begin
@ -2495,16 +2436,11 @@ var
RegError(reRegSetValueEx, RK, S, ErrorCode);
end;
rtBinary: begin
{$IFDEF UNICODE}
AnsiS := '';
for I := 1 to Length(ValueData) do
AnsiS := AnsiS + AnsiChar(Ord(ValueData[I]));
ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
PAnsiChar(AnsiS), Length(AnsiS));
{$ELSE}
ErrorCode := RegSetValueEx(K, PChar(N), 0, REG_BINARY,
PChar(ValueData), Length(ValueData));
{$ENDIF}
if (ErrorCode <> ERROR_SUCCESS) and
not(roNoError in Options) then
RegError(reRegSetValueEx, RK, S, ErrorCode);
@ -2607,7 +2543,6 @@ var
const
Chars: array[Boolean, Boolean] of Char = (('s', 't'), ('S', 'T'));
RunOnceKey = NEWREGSTR_PATH_SETUP + '\RunOnce';
var
RegSvrExeFilename: String;
F: TTextFileWriter;
@ -2627,8 +2562,8 @@ var
{ In case Windows directory is write protected, try the Temp directory.
Windows directory is our first choice since some people (ignorantly)
put things like "DELTREE C:\WINDOWS\TEMP\*.*" in their AUTOEXEC.BAT.
Also on Windows 2000 and later, each user has his own personal Temp
directory which may not be accessible by other users. }
Also, each user has his own personal Temp directory which may not
be accessible by other users. }
RegSvrExeFilename := CreateRegSvrExe(GetTempDir);
end;
end
@ -2666,11 +2601,11 @@ var
RootKey := HKEY_LOCAL_MACHINE
else
RootKey := HKEY_CURRENT_USER;
ErrorCode := RegCreateKeyExView(rvDefault, RootKey, RunOnceKey, 0, nil,
ErrorCode := RegCreateKeyExView(rvDefault, RootKey, REGSTR_PATH_RUNONCE, 0, nil,
REG_OPTION_NON_VOLATILE, KEY_SET_VALUE or KEY_QUERY_VALUE,
nil, H, @Disp);
if ErrorCode <> ERROR_SUCCESS then
RegError(reRegCreateKeyEx, RootKey, RunOnceKey, ErrorCode);
RegError(reRegCreateKeyEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
try
J := 0;
while True do begin
@ -2688,7 +2623,7 @@ var
ErrorCode := RegSetValueEx(H, PChar(ValueName), 0, REG_SZ, PChar(Data),
(Length(Data)+1)*SizeOf(Data[1]));
if ErrorCode <> ERROR_SUCCESS then
RegError(reRegSetValueEx, RootKey, RunOnceKey, ErrorCode);
RegError(reRegSetValueEx, RootKey, REGSTR_PATH_RUNONCE, ErrorCode);
Break;
end;
end;
@ -3391,13 +3326,7 @@ procedure ExtractTemporaryFile(const BaseName: String);
if Result[I] = '{' then begin
Insert('{', Result, I);
Inc(I);
{$IFDEF UNICODE}
end;
{$ELSE}
end
else if Result[I] in ConstLeadBytes^ then
Inc(I);
{$ENDIF}
Inc(I);
end;
end;

8
Projects/Int64em.pas → Projects/Int64Em.pas
View File

@ -2,7 +2,7 @@ unit Int64Em;
{
Inno Setup
Copyright (C) 1997-2008 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -10,8 +10,6 @@ unit Int64Em;
integer value - and functions for manipulating Integer64's.
(We can't use the Int64 type since it's only available in Delphi 4 and
later.)
$jrsoftware: issrc/Projects/Int64Em.pas,v 1.14 2008/10/03 19:53:57 jr Exp $
}
interface
@ -19,10 +17,6 @@ interface
{$I VERSION.INC}
type
{$IFNDEF IS_D4}
LongWord = Cardinal;
{$ENDIF}
Integer64 = record
Lo, Hi: LongWord;
end;

8
Projects/LZMA.pas
View File

@ -2,7 +2,7 @@ unit LZMA;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -15,12 +15,8 @@ interface
{$I VERSION.INC}
uses
Windows, SysUtils, {$IFNDEF Delphi3orHigher} Ole2, {$ENDIF}
Windows, SysUtils,
Compress, Int64Em;
{ Note: Ole2 must be included in the 'uses' clause on D2, and after Windows,
because it redefines E_* constants in Windows that are incorrect.
E_OUTOFMEMORY, for example, is defined as $80000002 in Windows, instead
of $8007000E. }
function LZMAInitCompressFunctions(Module: HMODULE): Boolean;
function LZMAGetLevel(const Value: String; var Level: Integer): Boolean;

17
Projects/MD5.pas
View File

@ -3,9 +3,6 @@ unit MD5;
{
MD5.pas: Translated from C to Delphi by Jordan Russell on 2004-03-16.
Still in the public domain. The original C code was taken from dpkg.
$jrsoftware: issrc/Projects/MD5.pas,v 1.2 2004/03/16 17:58:14 jr Exp $
(based on revision 1.15 from local 'md5' repository)
}
(*
@ -32,20 +29,8 @@ unit MD5;
interface
{$IFNDEF VER80}
{$IFNDEF VER90}
{$IFNDEF VER93}
{$IFNDEF VER100}
{$IFNDEF VER110}
{$DEFINE MD5_D4PLUS}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
type
TMD5Word = {$IFDEF MD5_D4PLUS} LongWord {$ELSE} Cardinal {$ENDIF};
TMD5Word = LongWord;
TMD5Buf = array[0..3] of TMD5Word;
TMD5In = array[0..15] of TMD5Word;
TMD5Context = record

254
Projects/Main.pas
View File

@ -167,7 +167,7 @@ var
{ Other }
ShowLanguageDialog, MatchedLangParameter: Boolean;
InstallMode: (imNormal, imSilent, imVerySilent);
HasIcons, IsNT, IsWin64, Is64BitInstallMode, IsAdmin, IsPowerUserOrAdmin, IsAdminInstallMode,
HasIcons, IsWin64, Is64BitInstallMode, IsAdmin, IsPowerUserOrAdmin, IsAdminInstallMode,
NeedPassword, NeedSerial, NeedsRestart, RestartSystem,
IsUninstaller, AllowUninstallerShutdown, AcceptedQueryEndSessionInProgress: Boolean;
InstallDefaultDisableFsRedir, ScriptFuncDisableFsRedir: Boolean;
@ -185,9 +185,7 @@ var
SetupExitCode: Integer;
CreatedIcon: Boolean;
RestartInitiatedByThisProcess, DownloadTemporaryFileProcessMessages: Boolean;
{$IFDEF IS_D12}
TaskbarButtonHidden: Boolean;
{$ENDIF}
InstallModeRootKey: HKEY;
CodeRunner: TScriptRunner;
@ -268,10 +266,9 @@ uses
ShellAPI, ShlObj,
Msgs, MsgIDs, Install, InstFunc, InstFnc2, RedirFunc, PathFunc,
Compress, CompressZlib, bzlib, LZMADecomp, ArcFour, SetupEnt, SelLangForm,
Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1,
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, {$ENDIF}
Wizard, DebugClient, VerInfo, Extract, FileClass, Logging, MD5, SHA1, ActiveX,
SimpleExpression, Helper, SpawnClient, SpawnServer, DotNet, BitmapImage,
TaskDialog;
TaskDialog, RegStr;
{$R *.DFM}
@ -310,12 +307,10 @@ begin
end;
function GetUninstallRegKeyBaseName(const ExpandedAppId: String): String;
{$IFDEF UNICODE}
var
UseAnsiCRC32: Boolean;
S: AnsiString;
I: Integer;
{$ENDIF}
begin
{ Set uninstall registry key base name }
Result := ExpandedAppId;
@ -327,7 +322,6 @@ begin
resulting string is 57 characters long. On Unicode, only do this if we
can get a CRC32 compatible with ANSI versions, else there's no point
in shortening since Unicode doesn't run on Win95. }
{$IFDEF UNICODE}
UseAnsiCRC32 := True;
for I := 1 to Length(Result) do begin
if Ord(Result[I]) > 126 then begin
@ -339,15 +333,12 @@ begin
S := AnsiString(Result);
FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(S[1], Length(S)*SizeOf(S[1]))]);
end;
{$ELSE}
FmtStr(Result, '%.48s~%.8x', [Result, GetCRC32(Result[1], Length(Result)*SizeOf(Result[1]))]);
{$ENDIF}
end;
end;
function GetUninstallRegSubkeyName(const UninstallRegKeyBaseName: String): String;
begin
Result := Format('%s\%s_is1', [NEWREGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName]);
Result := Format('%s\%s_is1', [REGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName]);
end;
{ Based on FindPreviousData in Wizard.pas }
@ -1267,13 +1258,8 @@ begin
Inc(I); { Skip closing brace }
end;
end
else begin
{$IFNDEF UNICODE}
if Result[I] in ConstLeadBytes^ then
Inc(I);
{$ENDIF}
else
Inc(I);
end;
end;
end;
@ -1299,7 +1285,7 @@ procedure InitMainNonSHFolderConsts;
var
H: HKEY;
begin
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, NEWREGSTR_PATH_SETUP, 0,
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, REGSTR_PATH_SETUP, 0,
KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
if not RegQueryStringValue(H, Name, Result) then
Result := '';
@ -1310,14 +1296,11 @@ procedure InitMainNonSHFolderConsts;
end;
procedure ReadSysUserInfo;
const
Paths: array[Boolean] of PChar = (NEWREGSTR_PATH_SETUP,
'SOFTWARE\Microsoft\Windows NT\CurrentVersion');
var
RegView: TRegView;
K: HKEY;
begin
{ Windows Vista and Server 2008 x64 are bugged: the owner and organization
{ Windows 7 x64 (and later?) is bugged: the owner and organization
are set to "Microsoft" on the 32-bit key. So on 64-bit Windows, read
from the 64-bit key. (The bug doesn't exist on 64-bit XP or Server 2003,
but it's safe to read the 64-bit key on those versions too.) }
@ -1325,8 +1308,8 @@ procedure InitMainNonSHFolderConsts;
RegView := rv64Bit
else
RegView := rvDefault;
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, Paths[IsNT], 0, KEY_QUERY_VALUE,
K) = ERROR_SUCCESS then begin
if RegOpenKeyExView(RegView, HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
RegQueryStringValue(K, 'RegisteredOwner', SysUserInfoName);
RegQueryStringValue(K, 'RegisteredOrganization', SysUserInfoOrg);
RegCloseKey(K);
@ -1341,10 +1324,7 @@ begin
WinSysNativeDir := GetSysNativeDir(IsWin64);
{ Get system drive }
if Win32Platform = VER_PLATFORM_WIN32_NT then
SystemDrive := GetEnv('SystemDrive') {don't localize}
else
SystemDrive := '';
SystemDrive := GetEnv('SystemDrive'); {don't localize}
if SystemDrive = '' then begin
SystemDrive := PathExtractDrive(WinDir);
if SystemDrive = '' then
@ -1371,10 +1351,7 @@ begin
end;
{ Get path of command interpreter }
if IsNT then
CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe'
else
CmdFilename := AddBackslash(WinDir) + 'COMMAND.COM';
CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe';
{ Get user info from system }
ReadSysUserInfo;
@ -1501,7 +1478,7 @@ begin
SHFolderDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
if SHFolderDLLHandle = 0 then
InternalError(Format('Failed to load DLL "%s"', [Filename]));
@SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, {$IFDEF UNICODE}'SHGetFolderPathW'{$ELSE}'SHGetFolderPathA'{$ENDIF});
@SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, 'SHGetFolderPathW');
if @SHGetFolderPathFunc = nil then
InternalError('Failed to get address of SHGetFolderPath function');
end;
@ -1528,17 +1505,16 @@ begin
if Create then
Folder := Folder or CSIDL_FLAG_CREATE;
{ Work around a nasty bug in Windows Vista (still present in SP1) and
Windows Server 2008: When a folder ID resolves to the root directory of a
{ Work around a nasty bug in Windows Vista and Windows Server 2008 and maybe
later versions also: When a folder ID resolves to the root directory of a
drive ('X:\') and the CSIDL_FLAG_CREATE flag is passed, SHGetFolderPath
fails with code 0x80070005.
So on Vista only, first try calling the function without CSIDL_FLAG_CREATE.
So, first try calling the function without CSIDL_FLAG_CREATE.
If and only if that fails, call it again with the flag.
Note: The calls *must* be issued in this order; if it's called with the
flag first, it seems to permanently cache the failure code, causing future
calls that don't include the flag to fail as well. }
if (WindowsVersion shr 16 >= $0600) and
(Folder and CSIDL_FLAG_CREATE <> 0) then
if Folder and CSIDL_FLAG_CREATE <> 0 then
Res := SHGetFolderPathFunc(0, Folder and not CSIDL_FLAG_CREATE, 0,
SHGFP_TYPE_CURRENT, Buf)
else
@ -1557,7 +1533,7 @@ end;
function GetShellFolderByGUID(Folder: TGUID; const Create: Boolean): String;
begin
if Assigned(SHGetKnownFolderPathFunc) and (WindowsVersion shr 16 >= $0600) then begin
if Assigned(SHGetKnownFolderPathFunc) then begin
var dwFlags: DWORD := 0;
if Create then
dwFlags := dwFlags or KF_FLAG_CREATE;
@ -1605,16 +1581,12 @@ var
ShellFolder: String;
begin
if not ShellFoldersRead[Common, ID] then begin
if ID = sfUserProgramFiles then begin
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles {Windows 7+}, True);
if ShellFolder = '' then
ShellFolder := ExpandConst('{localappdata}\Programs'); { supply default, same as Window 7 and newer }
end else if ID = sfUserCommonFiles then begin
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon {Windows 7+}, True);
if ShellFolder = '' then
ShellFolder := ExpandConst('{localappdata}\Programs\Common'); { supply default, same as Window 7 and newer }
end else if ID = sfUserSavedGames then
ShellFolder := GetShellFolderByGUID(FOLDERID_SavedGames {Vista+}, True)
if ID = sfUserProgramFiles then
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFiles, True)
else if ID = sfUserCommonFiles then
ShellFolder := GetShellFolderByGUID(FOLDERID_UserProgramFilesCommon, True)
else if ID = sfUserSavedGames then
ShellFolder := GetShellFolderByGUID(FOLDERID_SavedGames, True)
else
ShellFolder := GetShellFolderByCSIDL(FolderIDs[Common, ID], True);
ShellFolders[Common, ID] := ShellFolder;
@ -1629,22 +1601,16 @@ var
Ver, Ver2, MinVer, OnlyBelowVer: Cardinal;
begin
Ver := WindowsVersion;
if IsNT then begin
MinVer := MinVersion.NTVersion;
OnlyBelowVer := OnlyBelowVersion.NTVersion;
end
else begin
MinVer := 0;
OnlyBelowVer := 0;
end;
MinVer := MinVersion.NTVersion;
OnlyBelowVer := OnlyBelowVersion.NTVersion;
Result := irInstall;
if MinVer = 0 then
Result := irNotOnThisPlatform
else begin
if Ver < MinVer then
Result := irVersionTooLow
else if (IsNT and (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
(NTServicePackLevel < MinVersion.NTServicePack)) then
else if (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
(NTServicePackLevel < MinVersion.NTServicePack) then
Result := irServicePackTooLow
else begin
if OnlyBelowVer <> 0 then begin
@ -1652,23 +1618,17 @@ begin
{ A build number of 0 on OnlyBelowVersion means 'match any build' }
if LongRec(OnlyBelowVer).Lo = 0 then
Ver2 := Ver2 and $FFFF0000; { set build number to zero on Ver2 also }
if not IsNT then begin
if Ver2 >= OnlyBelowVer then
Result := irVerTooHigh;
end
else begin
{ Note: When OnlyBelowVersion includes a service pack level, the
version number test changes from a "<" to "<=" operation. Thus,
on Windows 2000 SP4, 5.0 and 5.0.2195 will fail, but 5.0sp5 and
5.0.2195sp5 will pass. }
if (Ver2 > OnlyBelowVer) or
((Ver2 = OnlyBelowVer) and
(OnlyBelowVersion.NTServicePack = 0)) or
((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
(OnlyBelowVersion.NTServicePack <> 0) and
(NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
Result := irVerTooHigh;
end;
{ Note: When OnlyBelowVersion includes a service pack level, the
version number test changes from a "<" to "<=" operation. Thus,
on Windows 2000 SP4, 5.0 and 5.0.2195 will fail, but 5.0sp5 and
5.0.2195sp5 will pass. }
if (Ver2 > OnlyBelowVer) or
((Ver2 = OnlyBelowVer) and
(OnlyBelowVersion.NTServicePack = 0)) or
((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
(OnlyBelowVersion.NTServicePack <> 0) and
(NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
Result := irVerTooHigh;
end;
end;
end;
@ -1884,12 +1844,8 @@ var
J: Integer;
begin
Filename := AFilename;
if IsNT then begin
if not DisableFsRedir then
Filename := ReplaceSystemDirWithSysWow64(Filename);
end
else
Filename := GetShortName(Filename);
if not DisableFsRedir then
Filename := ReplaceSystemDirWithSysWow64(Filename);
Filename := PathLowercase(Filename);
for J := 0 to CheckForFileSL.Count-1 do begin
if CheckForFileSL[J] = Filename then begin
@ -1979,8 +1935,7 @@ begin
{ From MSDN: "Installers should not disable file system redirection before calling
the Restart Manager API. This means that a 32-bit installer run on 64-bit Windows
is unable register a file in the %windir%\system32 directory." This is incorrect,
we can register such files by using the Sysnative alias. Note: the Sysnative alias
is only available on Windows Vista and newer, but so is Restart Manager. }
we can register such files by using the Sysnative alias. }
if DisableFsRedir then
Filename := ReplaceSystemDirWithSysNative(Filename, IsWin64);
@ -1989,11 +1944,7 @@ begin
Len := Length(Filename);
GetMem(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], (Len + 1) * SizeOf(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount][0]));
{$IFNDEF UNICODE}
RegisterFileFilenames[RegisterFileFilenamesCount][MultiByteToWideChar(CP_ACP, 0, PChar(Filename), Len, RegisterFileFilenames[RegisterFileFilenamesCount], Len)] := #0;
{$ELSE}
StrPCopy(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], Filename);
{$ENDIF}
StrPCopy(RegisterFileBatchFilenames[RegisterFileFilenamesBatchCount], Filename);
Inc(RegisterFileFilenamesBatchCount);
Inc(RmRegisteredFilesCount);
@ -2164,14 +2115,6 @@ end;
procedure SetActiveLanguage(const I: Integer);
{ Activates the specified language }
const
{$IFDEF UNICODE}
{ UNICODE requires 2000+, so we can just use the English name }
SMSPGothic = 'MS PGothic';
{$ELSE}
{ "MS PGothic" in Japanese (CP 932) }
SMSPGothic = #$82'l'#$82'r '#$82'o'#$83'S'#$83'V'#$83'b'#$83'N';
{$ENDIF}
var
LangEntry: PSetupLanguageEntry;
J: Integer;
@ -2191,30 +2134,6 @@ begin
Finalize(LangOptions); { prevent leak on D2 }
LangOptions := LangEntry^;
{ Hack for Japanese: Override the default fonts on older versions of Windows
that don't (fully) support font linking }
if (LangOptions.LanguageID = $0411) and
{$IFNDEF UNICODE}
(GetACP = 932) and
{$ENDIF}
(WindowsVersion < Cardinal($05010000)) and
FontExists(SMSPGothic) then begin
{ Windows <= 2000: Verdana can't display Japanese }
LangOptions.WelcomeFontName := SMSPGothic;
LangOptions.WelcomeFontSize := 12;
{$IFNDEF UNICODE}
if WindowsVersion < Cardinal($05000000) then begin
{ Windows 9x/Me/NT 4.0: MS Sans Serif can't display Japanese }
LangOptions.DialogFontName := SMSPGothic;
LangOptions.DialogFontSize := 9;
LangOptions.TitleFontName := SMSPGothic;
LangOptions.TitleFontSize := 29;
LangOptions.CopyrightFontName := SMSPGothic;
LangOptions.CopyrightFontSize := 9;
end;
{$ENDIF}
end;
if LangEntry.LicenseText <> '' then
ActiveLicenseText := LangEntry.LicenseText
else
@ -2293,9 +2212,7 @@ begin
application window. We can't simply hide the window because on D3+ the VCL
would just show it again in TApplication.UpdateVisible when the first form
is shown. }
{$IFDEF IS_D12}
TaskbarButtonHidden := not AVisible; { see WM_STYLECHANGING hook in Setup.dpr }
{$ENDIF}
if (GetWindowLong(Application.Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0) <> AVisible then begin
SetWindowPos(Application.Handle, 0, 0, 0, 0, 0, SWP_NOSIZE or
SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW);
@ -2333,18 +2250,16 @@ begin
SP := SP + '.' + IntToStr(Lo(NTServicePackLevel));
end;
LogFmt('Windows version: %u.%u.%u%s (NT platform: %s)', [WindowsVersion shr 24,
(WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF, SP, SYesNo[IsNT]]);
(WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF, SP, SYesNo[True]]);
LogFmt('64-bit Windows: %s', [SYesNo[IsWin64]]);
LogFmt('Processor architecture: %s', [SetupProcessorArchitectureNames[ProcessorArchitecture]]);
if IsNT then begin
if IsAdmin then
Log('User privileges: Administrative')
else if IsPowerUserOrAdmin then
Log('User privileges: Power User')
else
Log('User privileges: None');
end;
if IsAdmin then
Log('User privileges: Administrative')
else if IsPowerUserOrAdmin then
Log('User privileges: Power User')
else
Log('User privileges: None');
end;
function GetMessageBoxResultText(const AResult: Integer): String;
@ -3658,8 +3573,8 @@ begin
BorderStyle := bsSingle;
{ Make the main window full-screen. If the window is resizable, limit it
to just the work area because on recent versions of Windows (e.g. 2000)
full-screen resizable windows don't cover over the taskbar. }
to just the work area because full-screen resizable windows don't cover
over the taskbar. }
BoundsRect := GetRectOfPrimaryMonitor(BorderStyle = bsSizeable);
{ Before maximizing the window, ensure Handle is created now so the correct
'restored' position is saved properly }
@ -3816,9 +3731,7 @@ begin
S := S + SNewLine2 + SetupMessages[msgAboutSetupNote];
if SetupMessages[msgTranslatorNote] <> '' then
S := S + SNewLine2 + SetupMessages[msgTranslatorNote];
{$IFDEF UNICODE}
StringChangeEx(S, '(C)', #$00A9, True);
{$ENDIF}
LoggedMsgBox(S, SetupMessages[msgAboutSetupTitle], mbInformation, MB_OK, False, 0);
end;
@ -4478,45 +4391,6 @@ end;
procedure InitWindowsVersion;
procedure ReadServicePackFromRegistry;
var
K: HKEY;
Size, Typ, SP: DWORD;
begin
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\Windows',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
Size := SizeOf(SP);
if (RegQueryValueEx(K, 'CSDVersion', nil, @Typ, @SP, @Size) = ERROR_SUCCESS) and
(Typ = REG_DWORD) and (Size = SizeOf(SP)) then
NTServicePackLevel := Word(SP);
RegCloseKey(K);
end;
end;
procedure ReadProductTypeFromRegistry;
const
VER_NT_WORKSTATION = 1;
VER_NT_DOMAIN_CONTROLLER = 2;
VER_NT_SERVER = 3;
var
K: HKEY;
S: String;
begin
if RegOpenKeyExView(rvDefault, HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\ProductOptions',
0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
{ See MS KB article 152078 for details on this key }
if RegQueryStringValue(K, 'ProductType', S) then begin
if CompareText(S, 'WinNT') = 0 then
WindowsProductType := VER_NT_WORKSTATION
else if CompareText(S, 'LanmanNT') = 0 then
WindowsProductType := VER_NT_DOMAIN_CONTROLLER
else if CompareText(S, 'ServerNT') = 0 then
WindowsProductType := VER_NT_SERVER;
end;
RegCloseKey(K);
end;
end;
type
TOSVersionInfoEx = packed record
dwOSVersionInfoSize: DWORD;
@ -4541,22 +4415,12 @@ begin
(Byte(OSVersionInfo.dwMinorVersion) shl 16) or
Word(OSVersionInfo.dwBuildNumber);
{ ^ Note: We MUST clip dwBuildNumber to 16 bits for Win9x compatibility }
if IsNT then begin
if OSVersionInfo.dwMajorVersion >= 5 then begin
{ OSVERSIONINFOEX is only available starting in Windows 2000 }
OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
if GetVersionEx(POSVersionInfo(@OSVersionInfoEx)^) then begin
NTServicePackLevel := (Byte(OSVersionInfoEx.wServicePackMajor) shl 8) or
Byte(OSVersionInfoEx.wServicePackMinor);
WindowsProductType := OSVersionInfoEx.wProductType;
WindowsSuiteMask := OSVersionInfoEx.wSuiteMask;
end;
end
else if OSVersionInfo.dwMajorVersion = 4 then begin
{ Read from the registry on NT 4 }
ReadServicePackFromRegistry;
ReadProductTypeFromRegistry;
end;
OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx);
if GetVersionEx(POSVersionInfo(@OSVersionInfoEx)^) then begin
NTServicePackLevel := (Byte(OSVersionInfoEx.wServicePackMajor) shl 8) or
Byte(OSVersionInfoEx.wServicePackMinor);
WindowsProductType := OSVersionInfoEx.wProductType;
WindowsSuiteMask := OSVersionInfoEx.wSuiteMask;
end;
end;
end;
@ -4606,12 +4470,8 @@ begin
end;
initialization
IsNT := UsingWinNT;
InitIsWin64AndProcessorArchitecture;
InitWindowsVersion;
{$IFNDEF UNICODE}
ConstLeadBytes := @SetupHeader.LeadBytes;
{$ENDIF}
InitComponents := TStringList.Create();
InitTasks := TStringList.Create();
NewParamsForCode := TStringList.Create();

10
Projects/RedirFunc.pas
View File

@ -2,7 +2,7 @@ unit RedirFunc;
{
Inno Setup
Copyright (C) 1997-2007 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -123,10 +123,8 @@ function DisableFsRedirectionIf(const Disable: Boolean;
If Disable is True, the function attempts to disable WOW64 file system
redirection, so that c:\windows\system32 goes to the 64-bit System directory
instead of the 32-bit one.
Returns True if successful, False if not (which normally indicates that
either the user is running 32-bit Windows, or a 64-bit version prior to
Windows Server 2003 SP1). For extended error information when False is
returned, call GetLastError. }
Returns True if successful, False if not. For extended error information when
False is returned, call GetLastError. }
begin
PreviousState.DidDisable := False;
if not Disable then
@ -142,7 +140,7 @@ begin
PreviousState.DidDisable := True;
end
else begin
{ The functions do not exist prior to Windows Server 2003 SP1 }
{ Should never happen }
SetLastError(ERROR_INVALID_FUNCTION);
Result := False;
end;

9
Projects/RegDLL.pas
View File

@ -2,7 +2,7 @@ unit RegDLL;
{
Inno Setup
Copyright (C) 1997-2012 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -86,11 +86,8 @@ begin
is running }
WindowDisabler := TWindowDisabler.Create;
try
{ On Windows Vista, to get the "WRP Mitigation" compatibility hack which
a lot of DLLs a require, we must use regsvr32.exe to handle the
(un)registration.
On Windows 2000/XP/2003, use regsvr32.exe as well for behavioral &
error message consistency. }
{ To get the "WRP Mitigation" compatibility hack which a lot of DLLs
require, we must use regsvr32.exe to handle the (un)registration. }
RegisterServerUsingRegSvr32(AUnregister, AIs64Bit, Filename);
finally
WindowDisabler.Free;

25
Projects/RegSvr.pas
View File

@ -2,7 +2,7 @@ unit RegSvr;
{
Inno Setup
Copyright (C) 1997-2012 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -53,8 +53,7 @@ end;
function RenameToNonRandomTempName(const Filename: String): String;
{ Renames Filename to a name in the format: isRS-nnn.tmp. Returns the new
filename if successful, or '' if not.
Note: This is an NT-only function, as it calls MoveFileEx. }
filename if successful, or '' if not. Calls MoveFileEx. }
var
Path, NewFilename: String;
Attribs: DWORD;
@ -91,18 +90,14 @@ var
SelfFilename, NewFilename: String;
begin
SelfFilename := NewParamStr(0);
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
{ On NT, RestartReplace will fail if the user doesn't have admin
privileges. We don't want to leak temporary files, so try to rename
ourself to a non-random name. This way, future runs should just keep
overwriting the same temp file. }
DeleteOldTempFiles(PathExtractPath(SelfFilename));
NewFilename := RenameToNonRandomTempName(SelfFilename);
if NewFilename <> '' then
RestartReplace(False, NewFilename, '')
else
RestartReplace(False, SelfFilename, '');
end
{ RestartReplace will fail if the user doesn't have admin
privileges. We don't want to leak temporary files, so try to rename
ourself to a non-random name. This way, future runs should just keep
overwriting the same temp file. }
DeleteOldTempFiles(PathExtractPath(SelfFilename));
NewFilename := RenameToNonRandomTempName(SelfFilename);
if NewFilename <> '' then
RestartReplace(False, NewFilename, '')
else
RestartReplace(False, SelfFilename, '');
end;

16
Projects/SHA1.pas
View File

@ -4,26 +4,12 @@ unit SHA1;
SHA1.pas: SHA-1 hash implementation, based on RFC 3174 and MD5.pas
Author: Jordan Russell, 2010-02-24
License for SHA1.pas: Public domain, no copyright claimed
$jrsoftware: issrc/Projects/SHA1.pas,v 1.1 2010/02/25 04:57:34 jr Exp $
}
interface
{$IFNDEF VER80}
{$IFNDEF VER90}
{$IFNDEF VER93}
{$IFNDEF VER100}
{$IFNDEF VER110}
{$DEFINE SHA1_D4PLUS}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
type
TSHA1Word = {$IFDEF SHA1_D4PLUS} LongWord {$ELSE} Cardinal {$ENDIF};
TSHA1Word = LongWord;
TSHA1Buf = array[0..4] of TSHA1Word;
TSHA1In = array[0..15] of TSHA1Word;
TSHA1WArray = array[0..79] of TSHA1Word;

18
Projects/SafeDLLPath.pas
View File

@ -2,7 +2,7 @@ unit SafeDLLPath;
{
Inno Setup
Copyright (C) 1997-2016 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -12,7 +12,7 @@ unit SafeDLLPath;
If SetDefaultDllDirectories is not available:
-It calls SetDllDirectory('') to prevent LoadLibrary from searching the current
directory for DLLs. (Has no effect on Windows versions prior to XP SP1.)
directory for DLLs.
-It then preloads a list of system DLLs which are known to be loaded unsafely
by older or unpatched versions of Windows.
@ -25,8 +25,6 @@ unit SafeDLLPath;
It also calls SetSearchPathMode to enable "safe search mode", which causes
SearchPath, and callers of SearchPath such as CreateProcess, to search the
current directory after the system directories (rather than before).
SetSearchPathMode is available in Windows 7 and newer, and on previous
versions that have the KB959426 update installed.
Finally, it calls SetProcessDEPPolicy (where available) to enable DEP for
the lifetime of the process. (This has nothing to do with search paths;
@ -55,7 +53,6 @@ const
var
KernelModule: HMODULE;
WinVer: WORD;
SystemDir: String;
SetDefaultDllDirectoriesFunc: function(DirectoryFlags: DWORD): BOOL; stdcall;
DidSetDefaultDllDirectories: Boolean;
@ -96,15 +93,12 @@ end;
initialization
KernelModule := GetModuleHandle(kernel32);
WinVer := Swap(Word(GetVersion()));
DidSetDefaultDllDirectories := False;
if WinVer <> $0600 then begin //see NSIS link above: CoCreateInstance(CLSID_ShellLink, ...) fails on Vista if SetDefaultDllDirectories is called
SetDefaultDllDirectoriesFunc := GetProcAddress(KernelModule, PAnsiChar('SetDefaultDllDirectories'));
if Assigned(SetDefaultDllDirectoriesFunc) then
DidSetDefaultDllDirectories := SetDefaultDllDirectoriesFunc(LOAD_LIBRARY_SEARCH_SYSTEM32);
end;
SetDefaultDllDirectoriesFunc := GetProcAddress(KernelModule, PAnsiChar('SetDefaultDllDirectories'));
if Assigned(SetDefaultDllDirectoriesFunc) then
DidSetDefaultDllDirectories := SetDefaultDllDirectoriesFunc(LOAD_LIBRARY_SEARCH_SYSTEM32);
if not DidSetDefaultDllDirectories then begin
SetDllDirectoryFunc := GetProcAddress(KernelModule, PAnsiChar('SetDllDirectoryW'));
if Assigned(SetDllDirectoryFunc) then

10
Projects/ScriptClasses_C.pas
View File

@ -571,15 +571,9 @@ end;
procedure ScriptClassesLibraryRegister_C(Cl: TPSPascalCompiler);
const
clSystemColor = {$IFDEF IS_D7} $FF000000 {$ELSE} $80000000 {$ENDIF};
clSystemColor = $FF000000;
COLOR_HOTLIGHT = 26;
begin
{$IFNDEF UNICODE}
{ Temporary: Currently used non Unicode ROPS version doesn't define the AnsiString/PAnsiChar types }
Cl.AddTypeS('AnsiString', 'String');
Cl.AddTypeS('PAnsiChar', 'PChar');
{$ENDIF}
{ Std }
SIRegister_Std_TypesAndConsts(Cl);
SIRegisterTObject(Cl);
@ -593,9 +587,7 @@ begin
SIRegisterTStringList(Cl);
SIRegisterTHandleStream(Cl);
SIRegisterTFileStream(Cl);
{$IFDEF UNICODE}
SIRegisterTStringStream(Cl);
{$ENDIF}
{ Graphics }
SIRegister_Graphics_TypesAndConsts(Cl);

10
Projects/ScriptClasses_R.pas
View File

@ -2,7 +2,7 @@ unit ScriptClasses_R;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -24,7 +24,7 @@ implementation
uses
Windows, Controls, Forms, StdCtrls, Graphics,
uPSR_std, uPSR_classes, uPSR_graphics, uPSR_controls, uPSR_forms,
uPSR_stdctrls, uPSR_extctrls, uPSR_comobj, {$IFNDEF UNICODE} uPSUtils, {$ENDIF}
uPSR_stdctrls, uPSR_extctrls, uPSR_comobj,
NewStaticText, NewCheckListBox, NewProgressBar, RichEditViewer,
ExtCtrls, UIStateForm, SetupForm, Main, Wizard, SetupTypes, PasswordEdit,
FolderTreeView, BitmapImage, NewNotebook, ScriptDlg, BidiCtrls,
@ -33,8 +33,8 @@ uses
type
TWinControlAccess = class(TWinControl);
procedure TWinControlParentBackground_R(Self: TWinControl; var T: Boolean); begin {$IFDEF IS_D7} T := TWinControlAccess(Self).ParentBackground {$ELSE} T := False {$ENDIF}; end;
procedure TWinControlParentBackground_W(Self: TWinControl; const T: Boolean); begin {$IFDEF IS_D7} TWinControlAccess(Self).ParentBackground := T; {$ENDIF} end;
procedure TWinControlParentBackground_R(Self: TWinControl; var T: Boolean); begin T := TWinControlAccess(Self).ParentBackground; end;
procedure TWinControlParentBackground_W(Self: TWinControl; const T: Boolean); begin TWinControlAccess(Self).ParentBackground := T; end;
procedure RegisterWinControl_R(Cl: TPSRuntimeClassImporter);
begin
@ -370,9 +370,7 @@ begin
RIRegisterTStringList(Cl);
RIRegisterTHandleStream(Cl);
RIRegisterTFileStream(Cl);
{$IFDEF UNICODE}
RIRegisterTStringStream(Cl);
{$ENDIF}
{ Graphics }
RIRegisterTGraphicsObject(Cl);

10
Projects/ScriptCompiler.pas
View File

@ -2,7 +2,7 @@ unit ScriptCompiler;
{
Inno Setup
Copyright (C) 1997-2018 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -363,10 +363,8 @@ begin
LineLength := FindNewLine(FScriptText, LineStartPosition);
end;
{$IFDEF UNICODE}
{ Convert Position from the UTF8 encoded ANSI string index to a UTF-16 string index }
Position := Length(UTF8ToString(Copy(FScriptText, LineStartPosition, Position - 1))) + 1;
{$ENDIF}
Col := Position;
end;
@ -465,11 +463,7 @@ var
begin
Result := False;
{$IFDEF UNICODE}
FScriptText := UTF8Encode(ScriptText);
{$ELSE}
FScriptText := ScriptText;
{$ENDIF}
for I := 0 to FExports.Count-1 do
TScriptExport(FExports[I]).Exported := False;
@ -482,10 +476,8 @@ begin
PSPascalCompiler.AllowNoBegin := True;
PSPascalCompiler.AllowNoEnd := True;
PSPascalCompiler.BooleanShortCircuit := True;
{$IFDEF UNICODE}
PSPascalCompiler.AllowDuplicateRegister := False;
PSPascalCompiler.UTF8Decode := True;
{$ENDIF}
PSPascalCompiler.AttributesOpenTokenID := CSTI_Less;
PSPascalCompiler.AttributesCloseTokenID := CSTI_Greater;

112
Projects/ScriptFunc_R.pas
View File

@ -2,7 +2,7 @@ unit ScriptFunc_R;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -22,8 +22,7 @@ implementation
uses
Windows, ScriptFunc,
Forms, uPSUtils, SysUtils, Classes, Graphics, Controls, TypInfo,
{$IFNDEF Delphi3orHigher} Ole2, {$ELSE} ActiveX, {$ENDIF}
Forms, uPSUtils, SysUtils, Classes, Graphics, Controls, TypInfo, ActiveX,
Struct, ScriptDlg, Main, PathFunc, CmnFunc, CmnFunc2, FileClass, RedirFunc,
Install, InstFunc, InstFnc2, Msgs, MsgIDs, NewDisk, BrowseFunc, Wizard, VerInfo,
SetupTypes, Int64Em, MD5, SHA1, Logging, SetupForm, RegDLL, Helper,
@ -33,17 +32,16 @@ var
ScaleBaseUnitsInitialized: Boolean;
ScaleBaseUnitX, ScaleBaseUnitY: Integer;
procedure NoSetupFuncError(const C: AnsiString);{$IFDEF UNICODE} overload;{$ENDIF}
procedure NoSetupFuncError(const C: AnsiString); overload;
begin
InternalError(Format('Cannot call "%s" function during Setup', [C]));
end;
procedure NoUninstallFuncError(const C: AnsiString);{$IFDEF UNICODE} overload;{$ENDIF}
procedure NoUninstallFuncError(const C: AnsiString); overload;
begin
InternalError(Format('Cannot call "%s" function during Uninstall', [C]));
end;
{$IFDEF UNICODE}
procedure NoSetupFuncError(const C: UnicodeString); overload;
begin
InternalError(Format('Cannot call "%s" function during Setup', [C]));
@ -53,31 +51,15 @@ procedure NoUninstallFuncError(const C: UnicodeString); overload;
begin
InternalError(Format('Cannot call "%s" function during Uninstall', [C]));
end;
{$ENDIF}
{$IFNDEF UNICODE}
procedure NoNonUnicodeFuncError(const C: String);
begin
InternalError(Format('Cannot call "%s" function during non Unicode Setup or Uninstall', [C]));
end;
{$ENDIF}
function StackGetAnsiString(Stack: TPSStack; ItemNo: LongInt): AnsiString;
begin
{$IFDEF UNICODE}
Result := Stack.GetAnsiString(ItemNo);
{$ELSE}
Result := Stack.GetString(ItemNo);
{$ENDIF}
end;
procedure StackSetAnsiString(Stack: TPSStack; ItemNo: LongInt; const Data: AnsiString);
begin
{$IFDEF UNICODE}
Stack.SetAnsiString(ItemNo, Data);
{$ELSE}
Stack.SetString(ItemNo, Data);
{$ENDIF}
end;
function GetMainForm: TMainForm;
@ -575,7 +557,7 @@ begin
Stack.SetInt(PStart, StringChangeEx(S, Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetBool(PStart-4)));
Stack.SetString(PStart-1, S);
end else if Proc.Name = 'USINGWINNT' then begin
Stack.SetBool(PStart, UsingWinNT());
Stack.SetBool(PStart, True);
end else if Proc.Name = 'FILECOPY' then begin
ExistingFilename := Stack.GetString(PStart-1);
if PathCompare(ExistingFilename, SetupLdrOriginalFilename) <> 0 then
@ -862,31 +844,19 @@ begin
end else if Proc.Name = 'GETMD5OFSTRING' then begin
Stack.SetString(PStart, MD5DigestToString(GetMD5OfAnsiString(StackGetAnsiString(Stack, PStart-1))));
end else if Proc.Name = 'GETMD5OFUNICODESTRING' then begin
{$IFDEF UNICODE}
Stack.SetString(PStart, MD5DigestToString(GetMD5OfUnicodeString(Stack.GetString(PStart-1))));
{$ELSE}
NoNonUnicodeFuncError(Proc.Name);
{$ENDIF}
end else if Proc.Name = 'GETSHA1OFFILE' then begin
Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1))));
end else if Proc.Name = 'GETSHA1OFSTRING' then begin
Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfAnsiString(StackGetAnsiString(Stack, PStart-1))));
end else if Proc.Name = 'GETSHA1OFUNICODESTRING' then begin
{$IFDEF UNICODE}
Stack.SetString(PStart, SHA1DigestToString(GetSHA1OfUnicodeString(Stack.GetString(PStart-1))));
{$ELSE}
NoNonUnicodeFuncError(Proc.Name);
{$ENDIF}
end else if Proc.Name = 'GETSHA256OFFILE' then begin
Stack.SetString(PStart, GetSHA256OfFile(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1)));
end else if Proc.Name = 'GETSHA256OFSTRING' then begin
Stack.SetString(PStart, GetSHA256OfAnsiString(StackGetAnsiString(Stack, PStart-1)));
end else if Proc.Name = 'GETSHA256OFUNICODESTRING' then begin
{$IFDEF UNICODE}
Stack.SetString(PStart, GetSHA256OfUnicodeString(Stack.GetString(PStart-1)));
{$ELSE}
NoNonUnicodeFuncError(Proc.Name);
{$ENDIF}
end else if Proc.Name = 'GETSPACEONDISK' then begin
if GetSpaceOnDisk(ScriptFuncDisableFsRedir, Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
if Stack.GetBool(PStart-2) then begin
@ -1006,7 +976,7 @@ begin
Stack.GetString(PStart-2), Stack.GetString(PStart-3),
Stack.GetString(PStart-4), Stack.GetString(PStart-5),
Stack.GetString(PStart-6), Stack.GetInt(PStart-7),
Stack.GetInt(PStart-8), 0, False, '', nil, False, False));
Stack.GetInt(PStart-8), 0, '', nil, False, False));
end else if Proc.Name = 'REGISTERTYPELIBRARY' then begin
if Stack.GetBool(PStart) then
HelperRegisterTypeLibrary(False, Stack.GetString(PStart-1))
@ -1164,7 +1134,7 @@ begin
Version.Build := WindowsVersion and $FFFF;
Version.ServicePackMajor := Hi(NTServicePackLevel);
Version.ServicePackMinor := Lo(NTServicePackLevel);
Version.NTPlatform := IsNT;
Version.NTPlatform := True;
Version.ProductType := WindowsProductType;
Version.SuiteMask := WindowsSuiteMask;
end;
@ -1413,19 +1383,19 @@ begin
end else if Proc.Name = 'SAMETEXT' then begin
Stack.SetBool(PStart, CompareText(Stack.GetString(PStart-1), Stack.GetString(PStart-2)) = 0);
end else if Proc.Name = 'GETDATETIMESTRING' then begin
OldDateSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator;
OldTimeSeparator := {$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator;
OldDateSeparator := FormatSettings.DateSeparator;
OldTimeSeparator := FormatSettings.TimeSeparator;
try
NewDateSeparator := Stack.GetString(PStart-2)[1];
NewTimeSeparator := Stack.GetString(PStart-3)[1];
if NewDateSeparator <> #0 then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := NewDateSeparator;
FormatSettings.DateSeparator := NewDateSeparator;
if NewTimeSeparator <> #0 then
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := NewTimeSeparator;
FormatSettings.TimeSeparator := NewTimeSeparator;
Stack.SetString(PStart, FormatDateTime(Stack.GetString(PStart-1), Now()));
finally
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}TimeSeparator := OldTimeSeparator;
{$IFDEF IS_DXE}FormatSettings.{$ENDIF}DateSeparator := OldDateSeparator;
FormatSettings.TimeSeparator := OldTimeSeparator;
FormatSettings.DateSeparator := OldDateSeparator;
end;
end else if Proc.Name = 'SYSERRORMESSAGE' then begin
Stack.SetString(PStart, Win32ErrorString(Stack.GetInt(PStart-1)));
@ -1480,45 +1450,6 @@ begin
end;
end;
{$IFNDEF IS_D7}
procedure _FmtStr(var Result: string; const Format: string;
const Args: array of const);
var
Len, BufLen: Integer;
Buffer: array[0..4095] of Char;
begin
BufLen := SizeOf(Buffer);
if Length(Format) < (sizeof(Buffer) - (sizeof(Buffer) div 4)) then
Len := FormatBuf(Buffer, sizeof(Buffer) - 1, Pointer(Format)^, Length(Format), Args)
else
begin
BufLen := Length(Format);
Len := BufLen;
end;
if Len >= BufLen - 1 then
begin
while Len >= BufLen - 1 do
begin
Inc(BufLen, BufLen);
Result := ''; // prevent copying of existing data, for speed
SetLength(Result, BufLen);
Len := FormatBuf(Pointer(Result)^, BufLen - 1, Pointer(Format)^,
Length(Format), Args);
end;
SetLength(Result, Len);
end
else
SetString(Result, Buffer, Len);
end;
{ We use the Format/FmtStr functions from Delphi 7 because Delphi 2's Format
raises an exception if the result is more than 4096 characters. }
function _Format(const Format: string; const Args: array of const): string;
begin
_FmtStr(Result, Format, Args);
end;
{$ENDIF}
{ VerInfo }
function VerInfoProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
@ -1694,16 +1625,15 @@ function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPS
Code: TPSError;
E: TObject;
begin
Code := Caller.{$IFDEF UNICODE} LastEx {$ELSE} ExceptionCode {$ENDIF};
Code := Caller.LastEx;
if Code = erNoError then
Result := '(There is no current exception)'
else begin
E := Caller.{$IFDEF UNICODE} LastExObject {$ELSE} ExceptionObject {$ENDIF};
E := Caller.LastExObject;
if Assigned(E) and (E is Exception) then
Result := Exception(E).Message
else
Result := String(PSErrorToString(Code, Caller.
{$IFDEF UNICODE} LastExParam {$ELSE} ExceptionString {$ENDIF}));
Result := String(PSErrorToString(Code, Caller.LastExParam));
end;
end;
@ -1799,10 +1729,6 @@ function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPS
I, N: Integer;
S: String;
begin
{$IFNDEF UNICODE}
if UTF8 then
NoNonUnicodeFuncError('SAVESTRINGSTOUTF8FILE');
{$ENDIF}
try
if Append then
F := TTextFileWriterRedir.Create(ScriptFuncDisableFsRedir, FileName, fdOpenAlways, faWrite, fsNone)
@ -1814,14 +1740,10 @@ function OtherProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPS
N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
for I := 0 to N-1 do begin
S := VNGetString(PSGetArrayField(Arr^, I));
{$IFDEF UNICODE}
if not UTF8 then
F.WriteAnsiLine(AnsiString(S))
else
F.WriteLine(S);
{$ELSE}
F.WriteLine(S);
{$ENDIF}
end;
finally
F.Free;
@ -2124,7 +2046,7 @@ begin
ScriptInterpreter.RegisterDelphiFunction(@_FindNext, 'FindNext', cdRegister);
ScriptInterpreter.RegisterDelphiFunction(@_FindClose, 'FindClose', cdRegister);
ScriptInterpreter.RegisterDelphiFunction(@_FmtMessage, 'FmtMessage', cdRegister);
ScriptInterpreter.RegisterDelphiFunction({$IFNDEF IS_D7} @_Format {$ELSE} @Format {$ENDIF}, 'Format', cdRegister);
ScriptInterpreter.RegisterDelphiFunction(@Format, 'Format', cdRegister);
ScriptInterpreter.RegisterDelphiFunction(@_GetWindowsVersionEx, 'GetWindowsVersionEx', cdRegister);
end;

39
Projects/ScriptRunner.pas
View File

@ -2,7 +2,7 @@ unit ScriptRunner;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -147,7 +147,6 @@ begin
Param := CreateHeapVariant(FPSExec.FindType2(btString));
PPSVariantAString(Param).Data := AnsiString(Parameters[I].vAnsiString);
end;
{$IFDEF UNICODE}
vtWideString:
begin
Param := CreateHeapVariant(FPSExec.FindType2(btWideString));
@ -158,7 +157,6 @@ begin
Param := CreateHeapVariant(FPSExec.FindType2(btUnicodeString));
PPSVariantUString(Param).Data := UnicodeString(Parameters[I].VUnicodeString);
end;
{$ENDIF}
vtInteger:
begin
Param := CreateHeapVariant(FPSExec.FindType2(btS32));
@ -190,7 +188,6 @@ end;
{---}
{$IFDEF UNICODE}
function EncodeDLLFilenameForROPS(const Filename: String): AnsiString;
begin
Result := '';
@ -203,7 +200,6 @@ begin
UnloadDLL(Caller, EncodeDLLFilenameForROPS(Stack.GetString(-1)));
Result := True;
end;
{$ENDIF}
function PSExecOnSpecialProcImport(Sender: TPSExec; p: TPSExternalProcRec; Tag: Pointer): Boolean;
const
@ -211,9 +207,7 @@ const
var
ScriptRunner: TScriptRunner;
S, DllName, FunctionName: AnsiString;
{$IFDEF UNICODE}
UnicodeDllName: String;
{$ENDIF}
I: Integer;
ForceDelayLoad, DelayLoad: Boolean;
ErrorCode: LongInt;
@ -248,30 +242,17 @@ begin
FunctionName := Copy(S, 1, I-1);
ScriptRunner.LogFmt('Function name: %s', [FunctionName]);
{$IFDEF UNICODE}
UnicodeDllName := UTF8ToString(DllName);
ScriptRunner.LogFmt('DLL name: %s', [UnicodeDllname]);
{$ELSE}
ScriptRunner.LogFmt('DLL name: %s', [DllName]);
{$ENDIF}
if Assigned(ScriptRunner.FOnDllImport) then begin
{$IFDEF UNICODE}
ScriptRunner.FOnDllImport(UnicodeDllName, ForceDelayLoad);
DllName := EncodeDLLFilenameForROPS(UnicodeDllName);
{$ELSE}
ScriptRunner.FOnDllImport(DllName, ForceDelayLoad);
{$ENDIF}
p.Decl := AnsiString('dll:') + DllName + Copy(p.Decl, Pos(AnsiString(#0), p.Decl), MaxInt);
end;
if DllName <> '' then begin
{$IFDEF UNICODE}
ScriptRunner.LogFmt('Dest DLL name: %s', [UnicodeDllName]);
{$ELSE}
ScriptRunner.LogFmt('Dest DLL name: %s', [DllName]);
{$ENDIF}
ScriptRunner.Log('Importing the DLL function.');
end else
ScriptRunner.Log('Skipping.'); { We're actually still going to call ProcessDllImport but this doesn't matter to the user. }
@ -341,12 +322,8 @@ begin
FPSExec.OnSourceLine := PSExecOnSourceLine;
FPSExec.OnException := PSExecOnException;
{$IFNDEF UNICODE}
RegisterDLLRuntimeEx(FPSExec, False);
{$ELSE}
RegisterDLLRuntimeEx(FPSExec, False, False);
FPSExec.RegisterFunctionName('UNLOADDLL', NewUnloadDLLProc, nil, nil);
{$ENDIF}
FClassImporter := ScriptClassesLibraryRegister_R(FPSExec);
ScriptFuncLibraryRegister_R(FPSExec);
end;
@ -391,7 +368,7 @@ begin
if Proc.Attributes.Count > 0 then begin
Attr := Proc.Attributes.FindAttribute(AnsiString(FNamingAttribute));
if (Attr <> nil) and (Attr.ValueCount = 1) and
({$IFDEF UNICODE} ((Attr.Value[0].FType.BaseType = btUnicodeString) and (CompareText(PPSVariantUString(Attr.Value[0]).Data, Name) = 0)) or {$ENDIF}
(((Attr.Value[0].FType.BaseType = btUnicodeString) and (CompareText(PPSVariantUString(Attr.Value[0]).Data, Name) = 0)) or
((Attr.Value[0].FType.BaseType = btString) and (CompareText(PPSVariantAString(Attr.Value[0]).Data, Name) = 0))) then begin
if ProcNos <> nil then
ProcNos.Add(Pointer(ProcNo));
@ -584,20 +561,12 @@ begin
Params := TPSList.Create();
try
SetPSExecParameters(Parameters, Params);
{$IFDEF UNICODE}
SetPSExecReturnValue(Params, btUnicodeString, Res);
{$ELSE}
SetPSExecReturnValue(Params, btString, Res);
{$ENDIF}
FPSExec.RunProc(Params, Cardinal(ProcNos[I]));
WriteBackParameters(Parameters, Params);
RaisePSExecException;
{$IFDEF UNICODE}
Result := PPSVariantUString(Res).Data;
{$ELSE}
Result := PPSVariantAString(Res).Data;
{$ENDIF}
if (Result <> '') and (BreakCondition = bcNonEmpty) then
Exit;
finally
@ -628,7 +597,6 @@ function TScriptRunner.EvaluateUsedVariable(const Param1, Param2, Param3: LongIn
function VariantToString(const p: TPSVariantIFC; const ClassProperties: AnsiString): String;
begin
{$IFDEF UNICODE}
//PSVariantToString isn't Unicode enabled, handle strings ourselves
//doesn't handle more complex types as records, arrays and objects
if p.Dta <> nil then begin
@ -640,7 +608,6 @@ function TScriptRunner.EvaluateUsedVariable(const Param1, Param2, Param3: LongIn
Result := PSVariantToString(p, ClassProperties);
end;
end else
{$ENDIF}
Result := PSVariantToString(p, ClassProperties);
end;

137
Projects/SecurityFunc.pas
View File

@ -2,13 +2,11 @@ unit SecurityFunc;
{
Inno Setup
Copyright (C) 1997-2008 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Functions for altering ACLs on files & registry keys
$jrsoftware: issrc/Projects/SecurityFunc.pas,v 1.6 2008/10/17 22:18:14 jr Exp $
}
interface
@ -27,39 +25,11 @@ implementation
uses
PathFunc, Msgs, InstFunc, Logging, RedirFunc, Helper;
{$IFNDEF UNICODE}
function AllocWideCharStr(const S: String): PWideChar;
{ Allocates a null-terminated Unicode copy of S on the heap. Use FreeMem to
free the returned pointer. }
var
SourceLen, DestLen: Integer;
begin
SourceLen := Length(S);
if SourceLen = 0 then
DestLen := 0
else begin
DestLen := MultiByteToWideChar(CP_ACP, 0, PChar(S), SourceLen, nil, 0);
if (DestLen <= 0) or (DestLen >= High(Integer) div SizeOf(WideChar)) then
InternalError('AllocWideCharStr: MultiByteToWideChar failed');
end;
GetMem(Result, (DestLen + 1) * SizeOf(WideChar));
try
if DestLen <> 0 then
if MultiByteToWideChar(CP_ACP, 0, PChar(S), SourceLen, Result, DestLen) <> DestLen then
InternalError('AllocWideCharStr: MultiByteToWideChar failed');
Result[DestLen] := #0;
except
FreeMem(Result);
raise;
end;
end;
{$ENDIF}
function InternalGrantPermission(const ObjectType: DWORD; const ObjectName: String;
const Entries: TGrantPermissionEntry; const EntryCount: Integer;
const Inheritance: DWORD): DWORD;
{ Grants the specified access to the specified object. Returns ERROR_SUCCESS if
successful. Always fails on Windows 9x/Me and NT 4.0. }
successful. }
type
PPSID = ^PSID;
PPACL = ^PACL;
@ -95,9 +65,6 @@ var
SetEntriesInAclW: function(cCountOfExplicitEntries: ULONG;
const pListOfExplicitEntries: TExplicitAccessW; OldAcl: PACL;
var NewAcl: PACL): DWORD; stdcall;
{$IFNDEF UNICODE}
WideObjectName: PWideChar;
{$ENDIF}
SD: PSECURITY_DESCRIPTOR;
Dacl, NewDacl: PACL;
ExplicitAccess: PArrayOfExplicitAccessW;
@ -105,13 +72,6 @@ var
I: Integer;
Sid: PSID;
begin
{ Windows 9x/Me don't support ACLs, and GetNamedSecurityInfo and
SetEntriesInACL are buggy on NT 4 }
if (Win32Platform <> VER_PLATFORM_WIN32_NT) or (Lo(GetVersion) < 5) then begin
Result := ERROR_INVALID_FUNCTION;
Exit;
end;
AdvApiHandle := GetModuleHandle(advapi32);
GetNamedSecurityInfoW := GetProcAddress(AdvApiHandle, PAnsiChar('GetNamedSecurityInfoW'));
SetNamedSecurityInfoW := GetProcAddress(AdvApiHandle, PAnsiChar('SetNamedSecurityInfoW'));
@ -122,63 +82,52 @@ begin
Exit;
end;
{$IFNDEF UNICODE}
WideObjectName := AllocWideCharStr(ObjectName);
ExplicitAccess := nil;
Result := GetNamedSecurityInfoW(PChar(ObjectName), ObjectType,
DACL_SECURITY_INFORMATION, nil, nil, @Dacl, nil, SD);
if Result <> ERROR_SUCCESS then
Exit;
try
{$ENDIF}
ExplicitAccess := nil;
Result := GetNamedSecurityInfoW(
{$IFDEF UNICODE} PChar(ObjectName) {$ELSE} WideObjectName {$ENDIF},
ObjectType, DACL_SECURITY_INFORMATION, nil, nil, @Dacl, nil, SD);
{ Note: Dacl will be nil if GetNamedSecurityInfo is called on a FAT partition.
Be careful not to dereference a nil pointer. }
ExplicitAccess := AllocMem(EntryCount * SizeOf(ExplicitAccess[0]));
E := @Entries;
for I := 0 to EntryCount-1 do begin
if not AllocateAndInitializeSid(E.Sid.Authority, E.Sid.SubAuthCount,
E.Sid.SubAuth[0], E.Sid.SubAuth[1], 0, 0, 0, 0, 0, 0, Sid) then begin
Result := GetLastError;
if Result = ERROR_SUCCESS then { just in case... }
Result := ERROR_INVALID_PARAMETER;
Exit;
end;
ExplicitAccess[I].grfAccessPermissions := E.AccessMask;
ExplicitAccess[I].grfAccessMode := GRANT_ACCESS;
ExplicitAccess[I].grfInheritance := Inheritance;
ExplicitAccess[I].Trustee.TrusteeForm := TRUSTEE_IS_SID;
ExplicitAccess[I].Trustee.TrusteeType := TRUSTEE_IS_UNKNOWN;
PSID(ExplicitAccess[I].Trustee.ptstrName) := Sid;
Inc(E);
end;
Result := SetEntriesInAclW(EntryCount, ExplicitAccess[0], Dacl, NewDacl);
if Result <> ERROR_SUCCESS then
Exit;
try
{ Note: Dacl will be nil if GetNamedSecurityInfo is called on a FAT partition.
Be careful not to dereference a nil pointer. }
ExplicitAccess := AllocMem(EntryCount * SizeOf(ExplicitAccess[0]));
E := @Entries;
for I := 0 to EntryCount-1 do begin
if not AllocateAndInitializeSid(E.Sid.Authority, E.Sid.SubAuthCount,
E.Sid.SubAuth[0], E.Sid.SubAuth[1], 0, 0, 0, 0, 0, 0, Sid) then begin
Result := GetLastError;
if Result = ERROR_SUCCESS then { just in case... }
Result := ERROR_INVALID_PARAMETER;
Exit;
end;
ExplicitAccess[I].grfAccessPermissions := E.AccessMask;
ExplicitAccess[I].grfAccessMode := GRANT_ACCESS;
ExplicitAccess[I].grfInheritance := Inheritance;
ExplicitAccess[I].Trustee.TrusteeForm := TRUSTEE_IS_SID;
ExplicitAccess[I].Trustee.TrusteeType := TRUSTEE_IS_UNKNOWN;
PSID(ExplicitAccess[I].Trustee.ptstrName) := Sid;
Inc(E);
end;
Result := SetEntriesInAclW(EntryCount, ExplicitAccess[0], Dacl, NewDacl);
if Result <> ERROR_SUCCESS then
Exit;
try
Result := SetNamedSecurityInfoW(
{$IFDEF UNICODE} PChar(ObjectName) {$ELSE} WideObjectName {$ENDIF},
ObjectType, DACL_SECURITY_INFORMATION, nil, nil, NewDacl, nil);
finally
LocalFree(HLOCAL(NewDacl));
end;
Result := SetNamedSecurityInfoW(PChar(ObjectName), ObjectType,
DACL_SECURITY_INFORMATION, nil, nil, NewDacl, nil);
finally
if Assigned(ExplicitAccess) then begin
for I := EntryCount-1 downto 0 do begin
Sid := PSID(ExplicitAccess[I].Trustee.ptstrName);
if Assigned(Sid) then
FreeSid(Sid);
end;
FreeMem(ExplicitAccess);
end;
LocalFree(HLOCAL(SD));
LocalFree(HLOCAL(NewDacl));
end;
{$IFNDEF UNICODE}
finally
FreeMem(WideObjectName);
if Assigned(ExplicitAccess) then begin
for I := EntryCount-1 downto 0 do begin
Sid := PSID(ExplicitAccess[I].Trustee.ptstrName);
if Assigned(Sid) then
FreeSid(Sid);
end;
FreeMem(ExplicitAccess);
end;
LocalFree(HLOCAL(SD));
end;
{$ENDIF}
end;
function GrantPermission(const Use64BitHelper: Boolean; const ObjectType: DWORD;
@ -210,8 +159,7 @@ const
function GrantPermissionOnFile(const DisableFsRedir: Boolean; Filename: String;
const Entries: TGrantPermissionEntry; const EntryCount: Integer): Boolean;
{ Grants the specified access to the specified file/directory. Returns True if
successful. On failure, the thread's last error code is set. Always fails on
Windows 9x/Me and NT 4.0. }
successful. On failure, the thread's last error code is set. }
const
SE_FILE_OBJECT = 1;
var
@ -239,8 +187,7 @@ function GrantPermissionOnKey(const RegView: TRegView; const RootKey: HKEY;
const Subkey: String; const Entries: TGrantPermissionEntry;
const EntryCount: Integer): Boolean;
{ Grants the specified access to the specified registry key. Returns True if
successful. On failure, the thread's last error code is set. Always fails on
Windows 9x/Me and NT 4.0. }
successful. On failure, the thread's last error code is set. }
const
SE_REGISTRY_KEY = 4;
var

16
Projects/SelFolderForm.pas
View File

@ -2,13 +2,11 @@ unit SelFolderForm;
{
Inno Setup
Copyright (C) 1997-2004 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
"Select Folder" form
$jrsoftware: issrc/Projects/SelFolderForm.pas,v 1.15 2010/10/22 10:33:26 mlaan Exp $
}
interface
@ -60,14 +58,10 @@ begin
Form.NewFolderButton.Visible := not AppendDir and (NewFolderName <> '');
if StartMenu then begin
with Form.FFolderTreeView as TStartMenuFolderTreeView do
if IsNT then
SetPaths(GetShellFolder(False, sfPrograms),
GetShellFolder(True, sfPrograms),
GetShellFolder(False, sfStartup),
GetShellFolder(True, sfStartup))
else
SetPaths(GetShellFolder(False, sfPrograms),
'', GetShellFolder(False, sfStartup), '');
SetPaths(GetShellFolder(False, sfPrograms),
GetShellFolder(True, sfPrograms),
GetShellFolder(False, sfStartup),
GetShellFolder(True, sfStartup));
TidyUpGroupName(Path);
end
else

54
Projects/SelLangForm.pas
View File

@ -42,24 +42,6 @@ uses
{$R *.DFM}
var
DefComboWndProcW, PrevComboWndProc: Pointer;
function NewComboWndProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
stdcall;
begin
case Msg of
{ CB_ADDSTRING must pass to the default Unicode combo box window procedure
since PrevWndProc is an ANSI window procedure and calling it would result
in Unicode->ANSI conversion. Do the same for CB_GETLBTEXT(LEN) so that
MSAA sees Unicode strings. }
CB_ADDSTRING, CB_GETLBTEXT, CB_GETLBTEXTLEN:
Result := CallWindowProcW(DefComboWndProcW, Wnd, Msg, wParam, lParam)
else
Result := CallWindowProcW(PrevComboWndProc, Wnd, Msg, wParam, lParam);
end;
end;
function AskForLanguage: Boolean;
{ Creates and shows the "Select Language" dialog. Returns True and activates
the selected language if the user clicks OK, or False otherwise. }
@ -67,47 +49,13 @@ var
LangForm: TSelectLanguageForm;
I, J: Integer;
LangEntry: PSetupLanguageEntry;
{$IFNDEF UNICODE}
ClassInfo: TWndClassW;
N: String;
{$ENDIF}
begin
LangForm := TSelectLanguageForm.Create(Application);
try
{$IFNDEF UNICODE}
{ On NT, make it possible to add Unicode strings to our ANSI combo box by
installing a window procedure with special CB_ADDSTRING handling.
Yeah, this is a hack; it's too hard to create a native Unicode control
in Delphi. }
if Win32Platform = VER_PLATFORM_WIN32_NT then begin
if GetClassInfoW(0, 'COMBOBOX', ClassInfo) then begin
DefComboWndProcW := ClassInfo.lpfnWndProc;
Longint(PrevComboWndProc) := SetWindowLongW(LangForm.LangCombo.Handle,
GWL_WNDPROC, Longint(@NewComboWndProc));
end;
end;
{$ENDIF}
for I := 0 to Entries[seLanguage].Count-1 do begin
LangEntry := Entries[seLanguage][I];
{$IFDEF UNICODE}
J := LangForm.LangCombo.Items.Add(LangEntry.LanguageName);
LangForm.LangCombo.Items.Objects[J] := TObject(I);
{$ELSE}
if (I = ActiveLanguage) or (LangEntry.LanguageCodePage = 0) or
(LangEntry.LanguageCodePage = GetACP) or
(shShowUndisplayableLanguages in SetupHeader.Options) then begin
{ Note: LanguageName is Unicode }
N := LangEntry.LanguageName + #0#0; { need wide null! }
if Win32Platform = VER_PLATFORM_WIN32_NT then
J := SendMessageW(LangForm.LangCombo.Handle, CB_ADDSTRING, 0,
Longint(PWideChar(Pointer(N))))
else
J := LangForm.LangCombo.Items.Add(WideCharToString(PWideChar(Pointer(N))));
if J >= 0 then
LangForm.LangCombo.Items.Objects[J] := TObject(I);
end;
{$ENDIF}
end;
{ If there's multiple languages, select the previous language, if available }
@ -150,9 +98,7 @@ constructor TSelectLanguageForm.Create(AOwner: TComponent);
begin
inherited;
{$IFDEF IS_D7}
MainPanel.ParentBackground := False;
{$ENDIF}
InitializeFont;

14
Projects/Setup.dpr
View File

@ -2,7 +2,7 @@ program Setup;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -82,7 +82,8 @@ uses
RestartManager in '..\Components\RestartManager.pas',
Resample in '..\Components\Resample.pas',
dwTaskbarList in '..\Components\dwTaskbarList.pas',
ASMInline in '..\Components\ASMInline.pas';
ASMInline in '..\Components\ASMInline.pas',
TaskbarProgressFunc in 'TaskbarProgressFunc.pas';
{$SetPEFlags IMAGE_FILE_RELOCS_STRIPPED}
{$SETPEOSVERSION 6.1}
@ -148,8 +149,7 @@ begin
end;
WM_ENDSESSION: begin
{ Should only get here if RestartInitiatedByThisProcess is set or an
Uninstaller shutdown was allowed, or if the user forced a shutdown
on Vista or newer.
Uninstaller shutdown was allowed, or if the user forced a shutdown.
Skip the default handling which calls Halt. No code of ours depends
on the Halt call to clean up, and it could theoretically result in
obscure reentrancy bugs.
@ -170,7 +170,6 @@ begin
AcceptedQueryEndSessionInProgress := False;
Result := True;
end;
{$IFDEF IS_D12}
WM_STYLECHANGING: begin
{ On Delphi 2009, we must suppress some of the VCL's manipulation of
the application window styles in order to prevent the taskbar button
@ -194,7 +193,6 @@ begin
PStyleStruct(Message.LParam).styleNew and not WS_EX_APPWINDOW;
end;
end;
{$ENDIF}
end;
end;
@ -202,8 +200,6 @@ procedure DisableWindowGhosting;
var
Proc: procedure; stdcall;
begin
{ Note: The documentation claims this function is only available in XP SP1,
but it's actually available on stock XP too. }
Proc := GetProcAddress(GetModuleHandle(user32), 'DisableProcessWindowsGhosting');
if Assigned(Proc) then
Proc;
@ -272,13 +268,11 @@ begin
end;
begin
{$IFDEF IS_D12}
{ Delphi 2009 initially sets WS_EX_TOOLWINDOW on the application window.
That will prevent our ShowWindow(Application.Handle, SW_SHOW) calls from
actually displaying the taskbar button as intended, so clear it. }
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) and not WS_EX_TOOLWINDOW);
{$ENDIF}
try
SetErrorMode(SEM_FAILCRITICALERRORS);

1
Projects/Setup.dproj
View File

@ -157,6 +157,7 @@
<DCCReference Include="..\Components\Resample.pas"/>
<DCCReference Include="..\Components\dwTaskbarList.pas"/>
<DCCReference Include="..\Components\ASMInline.pas"/>
<DCCReference Include="TaskbarProgressFunc.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

10
Projects/SetupForm.pas
View File

@ -2,7 +2,7 @@ unit SetupForm;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -42,11 +42,7 @@ type
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
{$IFNDEF IS_D4}
constructor CreateNew(AOwner: TComponent);
{$ELSE}
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
{$ENDIF}
function CalculateButtonWidth(const ButtonCaptions: array of String): Integer;
procedure InitializeFont;
function ScalePixelsX(const N: Integer): Integer;
@ -302,11 +298,7 @@ begin
Position := poDesigned;
end;
{$IFNDEF IS_D4}
constructor TSetupForm.CreateNew(AOwner: TComponent);
{$ELSE}
constructor TSetupForm.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
{$ENDIF}
begin
{ Note: On Delphi 2 and 3, CreateNew isn't virtual, so this is only reached
when TSetupForm.CreateNew is called explicitly }

18
Projects/SimpleExpression.pas
View File

@ -2,7 +2,7 @@ unit SimpleExpression;
{
Inno Setup
Copyright (C) 1997-2013 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -68,24 +68,10 @@ implementation
uses
SysUtils;
{$IFNDEF UNICODE}
type
TSysCharSet = set of AnsiChar;
function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
begin
Result := C in CharSet;
end;
{$ENDIF}
procedure AssignStringToVarRec(var VarRec: TVarRec; const S: String);
begin
{$IFDEF UNICODE}
VarRec.VType := vtUnicodeString;
UnicodeString(VarRec.VUnicodeString) := S;
{$ELSE}
VarRec.VType := vtAnsiString;
AnsiString(VarRec.VAnsiString) := S;
{$ENDIF}
end;
{---}
@ -252,7 +238,7 @@ begin
Result := True; { Lazy and in lazy branch, just return something }
finally
for I := High(Parameters) downto Low(Parameters) do
if Parameters[I].VType = {$IFDEF UNICODE} vtUnicodeString {$ELSE} vtAnsiString {$ENDIF} then
if Parameters[I].VType = vtUnicodeString then
AssignStringToVarRec(Parameters[I], '');
end
end;

12
Projects/SpawnClient.pas
View File

@ -2,7 +2,7 @@ unit SpawnClient;
{
Inno Setup
Copyright (C) 1997-2007 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -10,8 +10,6 @@ unit SpawnClient;
NOTE: These functions are NOT thread-safe. Do not call them from multiple
threads simultaneously.
$jrsoftware: issrc/Projects/SpawnClient.pas,v 1.5 2007/09/05 02:07:35 jr Exp $
}
interface
@ -60,10 +58,10 @@ procedure AllowSpawnServerToSetForegroundWindow;
normally lasts until new input is generated (a keystroke or click, not
simply mouse movement).
Note: If the spawn server process has no visible windows, it seems this
isn't needed (on 2000 & Vista); the process can set the foreground window
as it pleases. If it does have a visible window, though, it definitely is
needed (e.g. in the /DebugSpawnServer case). Let's not rely on any
undocumented behavior and call AllowSetForegroundWindow unconditionally. }
isn't needed; the process can set the foreground window as it pleases.
If it does have a visible window, though, it definitely is needed (e.g. in
the /DebugSpawnServer case). Let's not rely on any undocumented behavior and
call AllowSetForegroundWindow unconditionally. }
var
PID: DWORD;
AllowSetForegroundWindowFunc: function(dwProcessId: DWORD): BOOL; stdcall;

129
Projects/SpawnServer.pas
View File

@ -2,13 +2,11 @@ unit SpawnServer;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Spawn server
$jrsoftware: issrc/Projects/SpawnServer.pas,v 1.13 2010/04/17 19:30:25 jr Exp $
}
interface
@ -102,89 +100,6 @@ begin
end;
end;
type
TOSVersionInfoExW = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of WideChar;
wServicePackMajor: Word;
wServicePackMinor: Word;
wSuiteMask: Word;
wProductType: Byte;
wReserved: Byte;
end;
const
VER_MINORVERSION = $0000001;
VER_MAJORVERSION = $0000002;
VER_SERVICEPACKMINOR = $0000010;
VER_SERVICEPACKMAJOR = $0000020;
VER_GREATER_EQUAL = 3;
var
VerSetConditionMaskFunc, VerifyVersionInfoWFunc: Pointer;
{ These are implemented in asm because Delphi 2 doesn't support functions that
take 64-bit parameters or return a 64-bit result (in EDX:EAX) }
procedure CallVerSetConditionMask(var dwlConditionMask: Integer64;
dwTypeBitMask: DWORD; dwConditionMask: DWORD);
asm
push esi
mov esi, eax // ESI = @dwlConditionMask
push ecx // dwConditionMask
push edx // dwTypeBitMask
push dword ptr [esi+4] // dwlConditionMask.Hi
push dword ptr [esi] // dwlConditionMask.Lo
call VerSetConditionMaskFunc
mov dword ptr [esi], eax // write dwlConditionMask.Lo
mov dword ptr [esi+4], edx // write dwlConditionMask.Hi
pop esi
end;
function CallVerifyVersionInfoW(const lpVersionInfo: TOSVersionInfoExW;
dwTypeMask: DWORD; const dwlConditionMask: Integer64): BOOL;
asm
push dword ptr [ecx+4] // dwlConditionMask.Hi
push dword ptr [ecx] // dwlConditionMask.Lo
push edx // dwTypeMask
push eax // lpVersionInfo
call VerifyVersionInfoWFunc
end;
function IsReallyVista: Boolean;
{ Returns True if the OS is *really* Vista or later. VerifyVersionInfo is used
because it appears to always check the true OS version number, whereas
GetVersion(Ex) can return a fake version number (e.g. 5.x) if the program is
set to run in compatibility mode, or if it is started by a program running
in compatibility mode. }
var
ConditionMask: Integer64;
VerInfo: TOSVersionInfoExW;
begin
Result := False;
{ These functions are present on Windows 2000 and later.
NT 4.0 SP6 has VerifyVersionInfoW, but not VerSetConditionMask.
Windows 9x/Me and early versions of NT 4.0 have neither. }
if Assigned(VerSetConditionMaskFunc) and Assigned(VerifyVersionInfoWFunc) then begin
ConditionMask.Lo := 0;
ConditionMask.Hi := 0;
{ Docs say: "If you are testing the major version, you must also test the
minor version and the service pack major and minor versions." }
CallVerSetConditionMask(ConditionMask, VER_MAJORVERSION, VER_GREATER_EQUAL);
CallVerSetConditionMask(ConditionMask, VER_MINORVERSION, VER_GREATER_EQUAL);
CallVerSetConditionMask(ConditionMask, VER_SERVICEPACKMAJOR, VER_GREATER_EQUAL);
CallVerSetConditionMask(ConditionMask, VER_SERVICEPACKMINOR, VER_GREATER_EQUAL);
FillChar(VerInfo, SizeOf(VerInfo), 0);
VerInfo.dwOSVersionInfoSize := SizeOf(VerInfo);
VerInfo.dwMajorVersion := 6;
Result := CallVerifyVersionInfoW(VerInfo, VER_MAJORVERSION or
VER_MINORVERSION or VER_SERVICEPACKMAJOR or VER_SERVICEPACKMINOR,
ConditionMask);
end;
end;
const
TokenElevationTypeDefault = 1; { User does not have a split token (they're
not an admin, or UAC is turned off) }
@ -194,7 +109,7 @@ const
function GetTokenElevationType: DWORD;
{ Returns token elevation type (TokenElevationType* constant). In case of
failure (e.g. not running Vista), 0 is returned. }
failure, 0 is returned. }
const
TokenElevationType = 18;
var
@ -203,11 +118,9 @@ var
ReturnLength: DWORD;
begin
Result := 0;
if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
{$IFNDEF Delphi3orHigher} @ {$ENDIF} Token) then begin
if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token) then begin
ElevationType := 0;
if GetTokenInformation(Token,
{$IFDEF Delphi3orHigher} TTokenInformationClass {$ENDIF} (TokenElevationType),
if GetTokenInformation(Token, TTokenInformationClass(TokenElevationType),
@ElevationType, SizeOf(ElevationType), ReturnLength) then
Result := ElevationType;
CloseHandle(Token);
@ -221,7 +134,7 @@ var
ElevationType: DWORD;
begin
Result := False;
if IsReallyVista and not IsAdminLoggedOn then begin
if not IsAdminLoggedOn then begin
if ARequireAdministrator then
Result := True
else if AEmulateHighestAvailable then begin
@ -240,15 +153,14 @@ end;
{$ELSE}
begin
{ For debugging/testing only: }
Result := (Lo(GetVersion) >= 5);
Result := True;
end;
{$ENDIF}
function GetFinalFileName(const Filename: String): String;
{ Calls GetFinalPathNameByHandle (new API in Vista) to expand any SUBST'ed
drives, network drives, and symbolic links in Filename.
This is needed for elevation to succeed on Windows Vista/7 when Setup is
started from a SUBST'ed drive letter. }
{ Calls GetFinalPathNameByHandle to expand any SUBST'ed drives, network drives,
and symbolic links in Filename. This is needed for elevation to succeed when
Setup is started from a SUBST'ed drive letter. }
function ConvertToNormalPath(P: PChar): String;
begin
@ -267,8 +179,7 @@ function GetFinalFileName(const Filename: String): String;
const
FILE_SHARE_DELETE = $00000004;
var
GetFinalPathNameByHandleFunc: function(hFile: THandle;
lpszFilePath: {$IFDEF UNICODE} PWideChar {$ELSE} PAnsiChar {$ENDIF};
GetFinalPathNameByHandleFunc: function(hFile: THandle; lpszFilePath: PWideChar;
cchFilePath: DWORD; dwFlags: DWORD): DWORD; stdcall;
Attr, FlagsAndAttributes: DWORD;
H: THandle;
@ -276,11 +187,7 @@ var
Buf: array[0..4095] of Char;
begin
GetFinalPathNameByHandleFunc := GetProcAddress(GetModuleHandle(kernel32),
{$IFDEF UNICODE}
'GetFinalPathNameByHandleW'
{$ELSE}
'GetFinalPathNameByHandleA'
{$ENDIF} );
'GetFinalPathNameByHandleW');
if Assigned(GetFinalPathNameByHandleFunc) then begin
Attr := GetFileAttributes(PChar(Filename));
if Attr <> $FFFFFFFF then begin
@ -326,15 +233,13 @@ procedure RespawnSelfElevated(const AExeFilename, AParams: String;
{ Spawns a new process using the "runas" verb.
Notes:
1. Despite the function's name, the spawned process may not actually be
elevated / running as administrator on Vista. If UAC is disabled, "runas"
elevated / running as administrator. If UAC is disabled, "runas"
behaves like "open". Also, if a non-admin user is a member of a special
system group like Backup Operators, they can select their own user account
at a UAC dialog. Therefore, it is critical that the caller include some
kind of protection against respawning more than once.
2. If AExeFilename is on a network drive, Vista's ShellExecuteEx function is
smart enough to substitute it with a UNC path. XP does not do this, which
causes the function to fail with ERROR_PATH_NOT_FOUND because the new
user doesn't retain the original user's drive mappings. }
2. If AExeFilename is on a network drive, the ShellExecuteEx function is
smart enough to substitute it with a UNC path. }
const
SEE_MASK_NOZONECHECKS = $00800000;
var
@ -547,10 +452,4 @@ begin
end;
end;
var
Kernel32Handle: HMODULE;
initialization
Kernel32Handle := GetModuleHandle(kernel32);
VerSetConditionMaskFunc := GetProcAddress(Kernel32Handle, 'VerSetConditionMask');
VerifyVersionInfoWFunc := GetProcAddress(Kernel32Handle, 'VerifyVersionInfoW');
end.

19
Projects/Struct.pas
View File

@ -2,7 +2,7 @@ unit Struct;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -33,10 +33,10 @@ const
this file it's recommended you change SetupID. Any change will do (like
changing the letters or numbers), as long as your format is
unrecognizable by the standard Inno Setup. }
SetupID: TSetupID = 'Inno Setup Setup Data (6.1.0)'{$IFDEF UNICODE}+' (u)'{$ENDIF};
SetupID: TSetupID = 'Inno Setup Setup Data (6.3.0)';
UninstallLogID: array[Boolean] of TUninstallLogID =
('Inno Setup Uninstall Log (b)', 'Inno Setup Uninstall Log (b) 64-bit');
MessagesHdrID: TMessagesHdrID = 'Inno Setup Messages (6.0.0)'{$IFDEF UNICODE}+' (u)'{$ENDIF};
MessagesHdrID: TMessagesHdrID = 'Inno Setup Messages (6.0.0) (u)';
MessagesLangOptionsID: TMessagesLangOptionsID = '!mlo!001';
ZLIBID: TCompID = 'zlb'#26;
DiskSliceID: TDiskSliceID = 'idska32'#26;
@ -61,8 +61,7 @@ type
shAllowUNCPath, shUserInfoPage, shUsePreviousUserInfo,
shUninstallRestartComputer, shRestartIfNeededByRun, shShowTasksTreeLines,
shAllowCancelDuringInstall, shWizardImageStretch, shAppendDefaultDirName,
shAppendDefaultGroupName, shEncryptionUsed,
{$IFNDEF UNICODE}shShowUndisplayableLanguages, {$ENDIF}shSetupLogging,
shAppendDefaultGroupName, shEncryptionUsed, shSetupLogging,
shSignedUninstaller, shUsePreviousLanguage, shDisableWelcomePage,
shCloseApplications, shRestartApplications, shAllowNetworkDrive,
shForceCloseApplications, shAppNameHasConsts, shUsePreviousPrivileges,
@ -94,9 +93,6 @@ type
AppModifyPath, CreateUninstallRegKey, Uninstallable, CloseApplicationsFilter,
SetupMutex, ChangesEnvironment, ChangesAssociations: String;
LicenseText, InfoBeforeText, InfoAfterText, CompiledCodeText: AnsiString;
{$IFNDEF UNICODE}
LeadBytes: set of AnsiChar;
{$ENDIF}
NumLanguageEntries, NumCustomMessageEntries, NumPermissionEntries,
NumTypeEntries, NumComponentEntries, NumTaskEntries, NumDirEntries,
NumFileEntries, NumFileLocationEntries, NumIconEntries, NumIniEntries,
@ -137,13 +133,10 @@ const
type
PSetupLanguageEntry = ^TSetupLanguageEntry;
TSetupLanguageEntry = packed record
{$IFNDEF UNICODE}
{ Note: LanguageName is Unicode }
{$ENDIF}
Name, LanguageName, DialogFontName, TitleFontName, WelcomeFontName,
CopyrightFontName: String;
Data, LicenseText, InfoBeforeText, InfoAfterText: AnsiString;
LanguageID{$IFNDEF UNICODE}, LanguageCodePage{$ENDIF}: Cardinal;
LanguageID: Cardinal;
DialogFontSize: Integer;
TitleFontSize: Integer;
WelcomeFontSize: Integer;
@ -278,7 +271,7 @@ type
CloseOnExit: TSetupIconCloseOnExit;
HotKey: Word;
Options: set of (ioUninsNeverUninstall, ioCreateOnlyIfFileExists,
ioUseAppPaths, ioFolderShortcut, ioExcludeFromShowInNewInstall,
ioUseAppPaths, ioExcludeFromShowInNewInstall,
ioPreventPinning, ioHasAppUserModelToastActivatorCLSID);
end;
const

23
Projects/TaskbarProgressFunc.pas
View File

@ -2,13 +2,11 @@ unit TaskbarProgressFunc;
{
Inno Setup
Copyright (C) 1997-2010 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Wrappers for ITaskbarList3.SetProgressState & SetProgressValue
$jrsoftware: issrc/Projects/TaskbarProgressFunc.pas,v 1.1 2010/10/29 01:48:45 jr Exp $
}
interface
@ -23,7 +21,7 @@ procedure SetAppTaskbarProgressValue(const Completed, Total: Cardinal);
implementation
uses
Windows, {$IFDEF VER90} OLE2 {$ELSE} ActiveX {$ENDIF}, Forms, dwTaskbarList;
Windows, ActiveX, Forms, dwTaskbarList;
var
TaskbarListInitialized: Boolean;
@ -31,20 +29,15 @@ var
function InitializeTaskbarList: Boolean;
var
WinVer: Word;
Intf: ITaskbarList3;
begin
if not TaskbarListInitialized then begin
WinVer := Swap(Word(GetVersion()));
if WinVer >= $0601 then
if CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC_SERVER, IID_TaskbarList3, Intf) = S_OK then
if Intf.HrInit = S_OK then begin
{$IFNDEF VER90}
{ Safety: don't allow the instance to be destroyed at shutdown }
Intf._AddRef;
{$ENDIF}
TaskbarListInterface := Intf;
end;
if CoCreateInstance(CLSID_TaskbarList, nil, CLSCTX_INPROC_SERVER, IID_TaskbarList3, Intf) = S_OK then
if Intf.HrInit = S_OK then begin
{ Safety: don't allow the instance to be destroyed at shutdown }
Intf._AddRef;
TaskbarListInterface := Intf;
end;
TaskbarListInitialized := True;
end;
Result := Assigned(TaskbarListInterface);

8
Projects/UIStateForm.pas
View File

@ -2,15 +2,13 @@ unit UIStateForm;
{
Inno Setup
Copyright (C) 1997-2004 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
TUIStateForm, a TForm descendant which correctly handles the hiding of
accelerator key characters and focus rectangles on Windows 2000 and later
when the "Hide keyboard navigation indicators" option is enabled.
$jrsoftware: issrc/Projects/UIStateForm.pas,v 1.2 2004/06/26 04:36:08 jr Exp $
accelerator key characters and focus rectangles when the
"Hide keyboard navigation indicators" option is enabled.
}
interface

61
Projects/Undo.pas
View File

@ -2,7 +2,7 @@ unit Undo;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -19,16 +19,13 @@ uses
Windows, SysUtils, Int64Em, FileClass, CmnFunc2;
const
HighestSupportedVersion = 48 {$IFDEF UNICODE} + 1000{$ENDIF};
HighestSupportedVersion = 1048;
{ Each time the format of the uninstall log changes (usually a new entry type
is added), HighestSupportedVersion and the file version number of Setup
are incremented to match (51.x). Do NOT do this yourself; doing so could cause
incompatibilities with future Inno Setup releases. It's recommended that you
use the "utUserDefined" log entry type if you wish to implement your own
custom uninstall log entries; see below for more information.
Note: the non Unicode HighestSupportedVersion may never become greater than
or equal to 1000. }
custom uninstall log entries; see below for more information. }
type
TUninstallRecTyp = type Word;
@ -301,10 +298,7 @@ begin
DirsNotRemoved.AddIfDoesntExist(DirsNotRemovedPrefix[DisableFsRedir] + DirName);
end
else if Assigned(RestartDeleteDirList) and
ListContainsPathOrSubdir(RestartDeleteDirList, DirName) and
(Win32Platform = VER_PLATFORM_WIN32_NT) then begin
{ Note: This code is NT-only; I don't think it's possible to
restart-delete directories on Windows 9x. }
ListContainsPathOrSubdir(RestartDeleteDirList, DirName) then begin
LogFmt('Failed to delete directory (%d). Will delete on restart (if empty).',
[LastError]);
LoggedRestartDeleteDir(DisableFsRedir, DirName);
@ -378,39 +372,19 @@ procedure TUninstallLog.Add(const Typ: TUninstallRecTyp; const Data: array of St
var
I, L: Integer;
S, X: AnsiString;
{$IFDEF UNICODE}
AData: AnsiString;
{$ENDIF}
NewRec: PUninstallRec;
begin
for I := 0 to High(Data) do begin
L := Length(Data[I])*SizeOf(Data[I][1]);
{$IFNDEF UNICODE}
if L < $FD then
S := S + AnsiChar(L)
else if L <= $FFFF then begin
SetLength(X, SizeOf(Byte) + SizeOf(Word));
X[1] := AnsiChar($FD);
Word((@X[2])^) := Word(L);
S := S + X;
end
else begin
{$ENDIF}
SetLength(X, SizeOf(Byte) + SizeOf(Integer));
X[1] := AnsiChar($FE);
Integer((@X[2])^) := Integer({$IFDEF UNICODE}-{$ENDIF}L);
S := S + X;
{$IFNDEF UNICODE}
end;
{$ENDIF}
SetLength(X, SizeOf(Byte) + SizeOf(Integer));
X[1] := AnsiChar($FE);
Integer((@X[2])^) := Integer(-L);
S := S + X;
{$IFDEF UNICODE}
SetString(AData, PAnsiChar(Pointer(Data[I])), L);
S := S + AData;
{$ELSE}
S := S + Data[I];
{$ENDIF}
end;
S := S + AnsiChar($FF);
@ -422,12 +396,6 @@ begin
if Version < HighestSupportedVersion then
Version := HighestSupportedVersion;
{$IFNDEF UNICODE}
{ If the version is in Unicode range, bump it there too if needed. }
if (Version >= 1000) and
(Version < 1000 + HighestSupportedVersion) then
Version := 1000 + HighestSupportedVersion;
{$ENDIF}
end;
procedure TUninstallLog.AddReg(const Typ: TUninstallRecTyp;
@ -537,13 +505,8 @@ begin
$FF: Break;
end;
if L < 0 then begin
{$IFDEF UNICODE}
L := -L;
SetString(Data[I], PChar(X), L div SizeOf(Char));
{$ELSE}
{ Should not be possible to get here, but check anyway for safety. }
InternalError('ExtractRecData: Unicode data unsupported by this build');
{$ENDIF}
end else
SetString(Data[I], PAnsiChar(X), L);
Inc(X, L);
@ -1161,12 +1124,9 @@ class function TUninstallLog.WriteSafeHeaderString(Dest: PAnsiChar;
#1 marker. If MaxDestBytes = 0 it returns the amount of bytes needed. }
var
N: Integer;
{$IFDEF UNICODE}
I: Integer;
{$ENDIF}
begin
N := Length(Source);
{$IFDEF UNICODE}
{ Only UTF-8-encode when non-ASCII characters are present }
for I := 1 to N do begin
if Ord(Source[I]) > 126 then begin
@ -1179,7 +1139,6 @@ begin
Exit;
end;
end;
{$ENDIF}
if MaxDestBytes <> 0 then
AnsiStrings.StrPLCopy(Dest, AnsiString(Source), MaxDestBytes - 1);
Result := (N + 1) * SizeOf(Dest^);
@ -1187,14 +1146,10 @@ end;
class function TUninstallLog.ReadSafeHeaderString(const Source: AnsiString): String;
begin
{$IFDEF UNICODE}
if (Source <> '') and (Source[1] = #1) then
Result := UTF8ToString(Copy(Source, 2, Maxint))
else
Result := String(Source);
{$ELSE}
Result := Source;
{$ENDIF}
end;
procedure TUninstallLog.Save(const Filename: String;

4
Projects/UninstProgressForm.pas
View File

@ -2,7 +2,7 @@ unit UninstProgressForm;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -106,9 +106,7 @@ begin
InitializeFont;
{$IFDEF IS_D7}
MainPanel.ParentBackGround := False;
{$ENDIF}
PageNameLabel.Font.Style := [fsBold];
PageNameLabel.Caption := SetupMessages[msgWizardUninstalling];

21
Projects/Uninstall.pas
View File

@ -2,7 +2,7 @@ unit Uninstall;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -48,9 +48,6 @@ var
LogFilename: String;
InitialProcessWnd, FirstPhaseWnd, DebugWnd: HWND;
OldWindowProc: Pointer;
{$IFNDEF UNICODE}
UninstLeadBytes: set of Char;
{$ENDIF}
procedure ShowExceptionMsg;
var
@ -472,11 +469,7 @@ end;
function ExtractCompiledCodeText(S: String): AnsiString;
begin
{$IFDEF UNICODE}
SetString(Result, PAnsiChar(Pointer(S)), Length(S)*SizeOf(S[1]));
{$ELSE}
Result := S;
{$ENDIF}
end;
procedure RunSecondPhase;
@ -494,7 +487,7 @@ begin
SetTaskbarButtonVisibility(False);
RestartSystem := False;
AllowUninstallerShutdown := (WindowsVersion shr 16 >= $0600);
AllowUninstallerShutdown := True;
try
if DebugWnd <> 0 then
@ -552,21 +545,13 @@ begin
UninstDataFile := OpenUninstDataFile(faReadWrite);
if not UninstLog.ExtractLatestRecData(utCompiledCode,
SetupBinVersion {$IFDEF UNICODE} or Longint($80000000) {$ENDIF}, CompiledCodeData) then
SetupBinVersion or Longint($80000000), CompiledCodeData) then
InternalError('Cannot find utCompiledCode record for this version of the uninstaller');
if DebugWnd <> 0 then
CompiledCodeText := DebugClientCompiledCodeText
else
CompiledCodeText := ExtractCompiledCodeText(CompiledCodeData[0]);
{$IFNDEF UNICODE}
{ Initialize ConstLeadBytes }
if Length(CompiledCodeData[1]) <> SizeOf(UninstLeadBytes) then
InternalError('utCompiledCode[1] is invalid');
Move(Pointer(CompiledCodeData[1])^, UninstLeadBytes, SizeOf(UninstLeadBytes));
ConstLeadBytes := @UninstLeadBytes;
{$ENDIF}
InitializeAdminInstallMode(ufAdminInstallMode in UninstLog.Flags);
{ Initialize install mode }

110
Projects/VerInfo.pas Normal file
View File

@ -0,0 +1,110 @@
unit VerInfo;
{
Inno Setup
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Version info functions
}
interface
uses
Windows, SysUtils, Int64Em;
{$I VERSION.INC}
type
TFileVersionNumbers = record
MS, LS: LongWord;
end;
function GetVersionInfo(const Filename: String;
var VersionInfo: TVSFixedFileInfo): Boolean;
function GetVersionNumbers(const Filename: String;
var VersionNumbers: TFileVersionNumbers): Boolean;
function StrToVersionNumbers(const S: String;
var Version: TFileVersionNumbers): Boolean;
implementation
uses
CmnFunc2, FileClass;
function GetVersionInfo(const Filename: String;
var VersionInfo: TVSFixedFileInfo): Boolean;
var
VersionSize: Integer;
VersionHandle: DWORD;
VersionBuf: PChar;
VerInfo: PVSFixedFileInfo;
VerInfoSize: UINT;
begin
Result := False;
VersionSize := GetFileVersionInfoSize(PChar(Filename), VersionHandle);
if VersionSize > 0 then begin
GetMem(VersionBuf, VersionSize);
try
if GetFileVersionInfo(PChar(Filename), VersionHandle, VersionSize, VersionBuf) then begin
if VerQueryValue(VersionBuf, '\', Pointer(VerInfo), VerInfoSize) then begin
VersionInfo := VerInfo^;
Result := True;
end;
end;
finally
FreeMem(VersionBuf);
end;
end;
end;
function GetVersionNumbers(const Filename: String;
var VersionNumbers: TFileVersionNumbers): Boolean;
var
VerInfo: TVSFixedFileInfo;
begin
Result := GetVersionInfo(Filename, VerInfo);
if Result then begin
VersionNumbers.MS := VerInfo.dwFileVersionMS;
VersionNumbers.LS := VerInfo.dwFileVersionLS;
end;
end;
function StrToVersionNumbers(const S: String; var Version: TFileVersionNumbers): Boolean;
function SplitNextNumber(var Z: String): Word;
var
I, N: Integer;
begin
if Trim(Z) <> '' then begin
I := Pos('.', Z);
if I = 0 then
I := Length(Z)+1;
N := StrToInt(Trim(Copy(Z, 1, I-1)));
if (N < Low(Word)) or (N > High(Word)) then
Abort;
Result := N;
Z := Copy(Z, I+1, Maxint);
end else
Result := 0;
end;
var
Z: String;
W: Word;
begin
try
Z := S;
W := SplitNextNumber(Z);
Version.MS := (DWord(W) shl 16) or SplitNextNumber(Z);
W := SplitNextNumber(Z);
Version.LS := (DWord(W) shl 16) or SplitNextNumber(Z);
Result := True;
except
Result := False;
end;
end;
end.

250
Projects/Verinfo.pas
View File

@ -1,250 +0,0 @@
unit VerInfo;
{
Inno Setup
Copyright (C) 1997-2020 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Version info functions
}
interface
uses
Windows, SysUtils, Int64Em;
{$I VERSION.INC}
type
TFileVersionNumbers = record
MS, LS: LongWord;
end;
function GetVersionInfo(const Filename: String;
var VersionInfo: TVSFixedFileInfo): Boolean;
function GetVersionNumbers(const Filename: String;
var VersionNumbers: TFileVersionNumbers): Boolean;
function StrToVersionNumbers(const S: String;
var Version: TFileVersionNumbers): Boolean;
implementation
uses
CmnFunc2, FileClass;
function GetVXDVersionInfo(const Filename: String;
var VersionInfo: TVSFixedFileInfo): Boolean;
{ Gets the version info from a VXD file. Returns True if successful.
Note: The code in this function is based on the code in the MS KB article
Q201685.
Known issue: This function fails if the version resource has a name
(TVXDVersionResource.cName <> $FF). It's rare, but such VXDs do exist --
see Windows 98's MSGAME.VXD for example. Given that as of 2007 Windows 9x
is mostly obsolete, I don't plan on fixing this. }
const
IMAGE_DOS_SIGNATURE = $5A4D; { MZ }
IMAGE_VXD_SIGNATURE = $454C; { LE }
type
PImageVXDHeader = ^TImageVXDHeader;
TImageVXDHeader = packed record
e32_magic: Word; // Magic number
e32_border: Byte; // The byte ordering for the VXD
e32_worder: Byte; // The word ordering for the VXD
e32_level: DWORD; // The EXE format level for now = 0
e32_cpu: Word; // The CPU type
e32_os: Word; // The OS type
e32_ver: DWORD; // Module version
e32_mflags: DWORD; // Module flags
e32_mpages: DWORD; // Module # pages
e32_startobj: DWORD; // Object # for instruction pointer
e32_eip: DWORD; // Extended instruction pointer
e32_stackobj: DWORD; // Object # for stack pointer
e32_esp: DWORD; // Extended stack pointer
e32_pagesize: DWORD; // VXD page size
e32_lastpagesize: DWORD; // Last page size in VXD
e32_fixupsize: DWORD; // Fixup section size
e32_fixupsum: DWORD; // Fixup section checksum
e32_ldrsize: DWORD; // Loader section size
e32_ldrsum: DWORD; // Loader section checksum
e32_objtab: DWORD; // Object table offset
e32_objcnt: DWORD; // Number of objects in module
e32_objmap: DWORD; // Object page map offset
e32_itermap: DWORD; // Object iterated data map offset
e32_rsrctab: DWORD; // Offset of Resource Table
e32_rsrccnt: DWORD; // Number of resource entries
e32_restab: DWORD; // Offset of resident name table
e32_enttab: DWORD; // Offset of Entry Table
e32_dirtab: DWORD; // Offset of Module Directive Table
e32_dircnt: DWORD; // Number of module directives
e32_fpagetab: DWORD; // Offset of Fixup Page Table
e32_frectab: DWORD; // Offset of Fixup Record Table
e32_impmod: DWORD; // Offset of Import Module Name Table
e32_impmodcnt: DWORD; // Number of entries in Import Module Name Table
e32_impproc: DWORD; // Offset of Import Procedure Name Table
e32_pagesum: DWORD; // Offset of Per-Page Checksum Table
e32_datapage: DWORD; // Offset of Enumerated Data Pages
e32_preload: DWORD; // Number of preload pages
e32_nrestab: DWORD; // Offset of Non-resident Names Table
e32_cbnrestab: DWORD; // Size of Non-resident Name Table
e32_nressum: DWORD; // Non-resident Name Table Checksum
e32_autodata: DWORD; // Object # for automatic data object
e32_debuginfo: DWORD; // Offset of the debugging information
e32_debuglen: DWORD; // The length of the debugging info. in bytes
e32_instpreload: DWORD; // Number of instance pages in preload section of VXD file
e32_instdemand: DWORD; // Number of instance pages in demand load section of VXD file
e32_heapsize: DWORD; // Size of heap - for 16-bit apps
e32_res3: array[0..11] of Byte; // Reserved words
e32_winresoff: DWORD;
e32_winreslen: DWORD;
e32_devid: Word; // Device ID for VxD
e32_ddkver: Word; // DDK version for VxD
end;
PVXDVersionResource = ^TVXDVersionResource;
TVXDVersionResource = packed record
cType: Byte;
wID: Word;
cName: Byte;
wOrdinal: Word;
wFlags: Word;
dwResSize: DWORD;
end;
var
F: TFile;
DosHeader: packed record
Sig: Word;
Other: array[0..57] of Byte;
VXDHeaderOffset: DWORD;
end;
VXDHeader: TImageVXDHeader;
VXDVersionRes: TVXDVersionResource;
RootNode: packed record
cbNode: Word;
cbData: Word;
szKey: array[0..15] of AnsiChar; { should always be 'VS_VERSION_INFO'#0 }
Value: TVSFixedFileInfo;
end;
begin
Result := False;
try
if not NewFileExists(Filename) then
Exit;
F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
try
{ DOS header }
if (F.Read(DosHeader, SizeOf(DosHeader)) <> SizeOf(DosHeader)) or
(DosHeader.Sig <> IMAGE_DOS_SIGNATURE) or
(DosHeader.VXDHeaderOffset = 0) then
Exit;
{ VXD header }
F.Seek(DosHeader.VXDHeaderOffset);
if (F.Read(VXDHeader, SizeOf(VXDHeader)) <> SizeOf(VXDHeader)) or
(DWORD(Pointer(@VXDHeader)^) <> IMAGE_VXD_SIGNATURE) then
Exit;
if Cardinal(VXDHeader.e32_winreslen) <= Cardinal(SizeOf(VXDVersionRes)) then
Exit; { sanity check }
{ Resource }
F.Seek(VXDHeader.e32_winresoff);
F.ReadBuffer(VXDVersionRes, SizeOf(VXDVersionRes));
if (VXDVersionRes.cType <> $FF) or
(VXDVersionRes.wID <> 16) or { RT_VERSION? }
(VXDVersionRes.cName <> $FF) then
Exit; { we don't support non-ordinal types/names (see "Known issue") }
if Cardinal(VXDVersionRes.dwResSize) < Cardinal(SizeOf(RootNode)) then
Exit; { sanity check }
F.ReadBuffer(RootNode, SizeOf(RootNode));
if (RootNode.cbNode >= SizeOf(RootNode)) and
(RootNode.cbData >= SizeOf(RootNode.Value)) and
(RootNode.Value.dwSignature = VS_FFI_SIGNATURE) then begin
VersionInfo := RootNode.Value;
Result := True;
end;
finally
F.Free;
end;
except
{ don't propagate exceptions }
end;
end;
function GetVersionInfo(const Filename: String;
var VersionInfo: TVSFixedFileInfo): Boolean;
var
VersionSize: Integer;
VersionHandle: DWORD;
VersionBuf: PChar;
VerInfo: PVSFixedFileInfo;
VerInfoSize: UINT;
begin
Result := False;
VersionSize := GetFileVersionInfoSize(PChar(Filename), VersionHandle);
if VersionSize > 0 then begin
GetMem(VersionBuf, VersionSize);
try
if GetFileVersionInfo(PChar(Filename), VersionHandle, VersionSize, VersionBuf) then begin
if VerQueryValue(VersionBuf, '\', Pointer(VerInfo), VerInfoSize) then begin
VersionInfo := VerInfo^;
Result := True;
end;
end;
finally
FreeMem(VersionBuf);
end;
end
else if Win32Platform <> VER_PLATFORM_WIN32_WINDOWS then begin
{ NT's version APIs don't support VXDs, so use our own code to handle them }
Result := GetVXDVersionInfo(Filename, VersionInfo);
end;
end;
function GetVersionNumbers(const Filename: String;
var VersionNumbers: TFileVersionNumbers): Boolean;
var
VerInfo: TVSFixedFileInfo;
begin
Result := GetVersionInfo(Filename, VerInfo);
if Result then begin
VersionNumbers.MS := VerInfo.dwFileVersionMS;
VersionNumbers.LS := VerInfo.dwFileVersionLS;
end;
end;
function StrToVersionNumbers(const S: String; var Version: TFileVersionNumbers): Boolean;
function SplitNextNumber(var Z: String): Word;
var
I, N: Integer;
begin
if Trim(Z) <> '' then begin
I := Pos('.', Z);
if I = 0 then
I := Length(Z)+1;
N := StrToInt(Trim(Copy(Z, 1, I-1)));
if (N < Low(Word)) or (N > High(Word)) then
Abort;
Result := N;
Z := Copy(Z, I+1, Maxint);
end else
Result := 0;
end;
var
Z: String;
W: Word;
begin
try
Z := S;
W := SplitNextNumber(Z);
Version.MS := (DWord(W) shl 16) or SplitNextNumber(Z);
W := SplitNextNumber(Z);
Version.LS := (DWord(W) shl 16) or SplitNextNumber(Z);
Result := True;
except
Result := False;
end;
end;
end.

31
Projects/Wizard.pas
View File

@ -2,7 +2,7 @@ unit Wizard;
{
Inno Setup
Copyright (C) 1997-2019 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
@ -767,9 +767,8 @@ begin
PrevSelectedTasks := TStringList.Create();
PrevDeselectedTasks := TStringList.Create();
{$IFDEF IS_D7}
MainPanel.ParentBackground := False;
{$ENDIF}
{ Prior to scaling the form, shrink WizardSmallBitmapImage if it's currently
larger than WizardSmallImage. This way, stretching will not occur if the
user specifies a smaller-than-default image and WizardImageStretch=yes,
@ -2703,26 +2702,18 @@ var
pszPath: PChar; dwFlags: DWORD): HRESULT; stdcall;
procedure ReconnectPath(const Path: String);
{ Attempts to re-establish the connection to Path if it's on a network drive.
It is particularly important to call this on Windows Vista, where mapped
network drives are initially disconnected in elevated processes.
Only has an effect on Windows XP and later. }
{ Attempts to re-establish the connection to Path if it's on a network drive
since mapped network drives are initially disconnected in elevated processes. }
var
WindowList: Pointer;
begin
{ If this fails, we shouldn't display any message boxes since the install
might be running silently with /SUPPRESSMSGBOXES.
Because of that requirement, we must limit this code to Windows XP and
later: The SHPathPrepareForWrite documentation claims that "user interface
windows will not be created" when hwnd is NULL, however I found that on
Windows 2000, it can still display unowned "An error occurred while
reconnecting" message boxes (e.g. if you log in with persistently mapped
drives while your Local Area Connection is disabled).
Windows XP/2003/Vista suppress these message boxes when NULL is passed. }
if (WindowsVersion >= Cardinal($05010000)) and
Assigned(SHPathPrepareForWriteFunc) then begin
{ "Just in case" XP and later tries to display UI (it never did in my
tests), disable our windows }
might be running silently with /SUPPRESSMSGBOXES and this is indeed so:
The SHPathPrepareForWrite documentation claims that "user interface
windows will not be created" when hwnd is NULL. }
if Assigned(SHPathPrepareForWriteFunc) then begin
{ "Just in case" it tries to display UI anyway (it never did in tests),
disable our windows }
WindowList := DisableTaskWindows(0);
try
SHPathPrepareForWriteFunc(0, nil, PChar(Path), SHPPFW_NONE);
@ -3008,5 +2999,5 @@ end;
initialization
SHPathPrepareForWriteFunc := GetProcAddress(SafeLoadLibrary(AddBackslash(GetSystemDir) + shell32,
SEM_NOOPENFILEERRORBOX), {$IFDEF UNICODE}'SHPathPrepareForWriteW'{$ELSE}'SHPathPrepareForWriteA'{$ENDIF});
SEM_NOOPENFILEERRORBOX), 'SHPathPrepareForWriteW');
end.

14
Projects/XPTheme.pas
View File

@ -2,12 +2,11 @@ unit XPTheme;
{
Inno Setup
Copyright (C) 1997-2007 Jordan Russell
Copyright (C) 1997-2024 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
Enables themes on Windows XP/Vista, and disables DPI scaling on Vista.
Used only by the Setup and SetupLdr projects.
Enables themes. Used only by the Setup and SetupLdr projects.
Note: XPTheme must be included as the first unit in the program's "uses"
clause so that its code runs before any VCL initialization code.
@ -26,14 +25,5 @@ uses
procedure InitCommonControls; external comctl32 name 'InitCommonControls';
initialization
{ Work around bug in Windows XP Gold & SP1: If the application manifest
specifies COMCTL32.DLL version 6.0 (to enable visual styles), we must
call InitCommonControls() to ensure that we actually link to
COMCTL32.DLL, otherwise calls to MessageBox() fail. (XP SP2 appears
to fix this.)
Programs that don't statically link to COMCTL32, like SetupLdr, need this.
(Actually, that's not completely true -- SetupLdr uses RedirFunc, which
loads SHELL32.DLL, which in turn loads COMCTL32.DLL. But let's not rely on
that undocumented behavior.) }
InitCommonControls;
end.

5
whatsnew.htm
View File

@ -52,6 +52,11 @@ For conditions of distribution and use, see <a href="https://jrsoftware.org/file
<li>The tab for the selected #include file now shows a close button.</li>
<li>Added a clickable panel to the Status Bar showing the amount of closed tabs if there are any.</li>
</ul>
<p><span class="head2">Support for Windows Vista and Windows Server 2008 removed</span></p>
<ul>
<li><b>OS requirements change:</b> Windows Vista and Windows Server 2008 are no longer supported. Windows 7 and Windows Server 2008 R2 are now the minimum supported operating systems. [Setup] section directive <tt>MinVersion</tt> still defaults to <tt>6.1sp1</tt>, so by default Setup will still not run versions of Windows 7 and Windows Server 2008 R2 which have not been updated.</li>
<li>Removed [Icons] section flag <tt>foldershortcut</tt> which was already ignored except when running on Windows Vista or Windows Server 2008, as folder shortcuts do not expand properly on the Start Menu anymore.</li>
</ul>
<p><span class="head2">Other changes</span></p>
<ul>
<li>Compiler IDE change: Added new <i>[Files] Entries Designer</i> menu item to the <i>Tools</i> menu to design and insert extra entries to the [Files] section.</li>