How to check if Adobe Acrobat Reader is installed - installation

I have this code that prompts the user to install Foxit PDF reader. How can I check whether the computer has Adobe Acrobat Reader is installed or not?
[Components]
Name: "foxit"; Description: "Foxit"; Types: "games"; ExtraDiskSpaceRequired: "30000000"; Check: "not AcrobatExists";
If Adobe Acrobat Reader is not found, then I want to start the install for Foxit Reader.

Try this Acrobat Reader - Detect installed version script:
[Setup]
AppName=Acrobat
AppVerName=Acrobat
DefaultDirName={pf}\Acrobat
DisableStartupPrompt=true
Uninstallable=false
DisableDirPage=true
OutputBaseFilename=Acrobat
CreateAppDir=false
[Code]
function GetAcrobatReaderVersion(): String;
var
sVersion: String;
begin
sVersion := '';
RegQueryStringValue( HKLM, 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe',
'', sVersion );
GetVersionNumbersString( sVersion , sVersion );
Result := sVersion;
end;
function NextButtonClick(CurPage: Integer): Boolean;
begin
// by default go to next page
Result := true;
if CurPage = wpWelcome then
begin
if Length( GetAcrobatReaderVersion() ) = 0 then
begin
MsgBox( 'There is not installed Acrobat reader', mbInformation, MB_OK );
Result := false;
end
else
MsgBox( 'Acrobat reader installed is version ' + GetAcrobatReaderVersion() ,
mbInformation, MB_OK );
end;
end;
You can take GetAcrobatReaderVersion() and make a check function, for example:
function AcrobatExists(): Boolean;
begin
result := Length( GetAcrobatReaderVersion() ) <> 0;
end;

Related

Inno Setup - Copy Files with Progress Bar on a custom page

I'm currently working on a program that updates our companys software.
I'm letting a User chose the location of the installed program and a backup location in an "CreateInputDirPage"
Currently I'm creating a mask for the selection of the two directorys:
SelectPathPage := CreateInputDirPage(PreviousPageId,
'Text 1',
'Text 2.',
'Text 3', False, 'New Folder');
SelectPathPage.Add('Path to company program');
SelectPathPage.Add('Path to backup folder');
Then I'm validating with existing files if the first Folder indead holds our companys program.
Now I want to copy the first selection to a new subfolder in the Backup-Folder.
I found this sample code from another question for copying the files:
DirectoryCopy(SelectPathPage.Values[0], SelectPathPage.Values[1]);
Which seems to work with the "NextButtonClick"-Function.
How can I copy the folder and the content of the folder on a seperate mask after the "SelectPathPage"-Mask with a progress bar and making the next button available when the copy is finished.
It should be similar to the "Install"-Mask with the progress bar.
Is it even possible to create something like this in a custom mask in Inno Setup?
Thanks in Advance
Use CreateOutputProgressPage to create the progress page.
And modify the DirectoryCopy function from Copying hidden files in Inno Setup to advance the progress on the page.
To calculate the total size (to set the maximum of the progress bar), the code needs GetDirSize function from Inno Setup get directory size including subdirectories.
[Code]
const
ProgressRatio = 1024;
procedure DirectoryCopyWithProgress(
SourcePath, DestPath: string; ProgressPage: TOutputProgressWizardPage);
var
FindRec: TFindRec;
SourceFilePath: string;
DestFilePath: string;
Size: Int64;
begin
if FindFirst(SourcePath + '\*', FindRec) then
begin
try
repeat
if (FindRec.Name <> '.') and (FindRec.Name <> '..') then
begin
SourceFilePath := SourcePath + '\' + FindRec.Name;
DestFilePath := DestPath + '\' + FindRec.Name;
ProgressPage.SetText(SourceFilePath, DestFilePath);
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
Size := Int64(FindRec.SizeHigh) shl 32 + FindRec.SizeLow;
if FileCopy(SourceFilePath, DestFilePath, False) then
begin
Log(Format('Copied %s to %s with %s bytes', [
SourceFilePath, DestFilePath, IntToStr(Size)]));
end
else
begin
Log(Format('Failed to copy %s to %s', [
SourceFilePath, DestFilePath]));
end;
end
else
begin
Size := 0;
if DirExists(DestFilePath) or CreateDir(DestFilePath) then
begin
Log(Format('Created %s', [DestFilePath]));
DirectoryCopyWithProgress(
SourceFilePath, DestFilePath, ProgressPage);
end
else
begin
Log(Format('Failed to create %s', [DestFilePath]));
end;
end;
Size := Size / ProgressRatio;
ProgressPage.SetProgress(
ProgressPage.ProgressBar.Position + Longint(Size),
ProgressPage.ProgressBar.Max);
end;
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end
else
begin
Log(Format('Failed to list %s', [SourcePath]));
end;
end;
function SelectPathPageNextButtonClick(Sender: TWizardPage): Boolean;
var
SourcePath: string;
DestPath: string;
ProgressPage: TOutputProgressWizardPage;
TotalSize: Longint;
begin
ProgressPage := CreateOutputProgressPage('Copying files...', '');
SourcePath := TInputDirWizardPage(Sender).Values[0];
DestPath := TInputDirWizardPage(Sender).Values[1];
TotalSize := GetDirSize(SourcePath) / ProgressRatio;
Log(Format('Total size is %s', [IntToStr(TotalSize)]));
ProgressPage.SetProgress(0, TotalSize);
ProgressPage.Show;
try
DirectoryCopyWithProgress(SourcePath, DestPath, ProgressPage);
finally
ProgressPage.Hide;
ProgressPage.Free;
end;
Result := True;
end;
procedure InitializeWizard();
var
SelectPathPage: TInputDirWizardPage;
begin
SelectPathPage :=
CreateInputDirPage(
wpSelectDir, 'Text 1', 'Text 2.', 'Text 3', False, 'New Folder');
SelectPathPage.Add('Path to company program');
SelectPathPage.Add('Path to backup folder');
SelectPathPage.OnNextButtonClick := #SelectPathPageNextButtonClick;
end;

Download and run sub install - Inno Download Plugin progress bar does not move during download

Ok, so I created the following iss but I the progress bar does not move. I want the setup file to download and run the other setup program. Everything works fine except the progress bar does not move.
#define MyAppName "My Program Setup Downloader"
#define MySetupAppName "My Program Setup.exe"
#define MySetupUrlFolder "https://www.example.com/folder/"
#pragma include __INCLUDE__ + ";" + "c:\Program Files (x86)\Inno Download Plugin\"
[Setup]
AppName={#MyAppName}
AppVerName={#MyAppName}
DisableReadyPage=yes
DisableFinishedPage=yes
CreateAppDir=no
Uninstallable=no
#include <idp.iss>
[Code]
var FileName: string;
procedure InitializeWizard;
var DownloadUrl: String;
begin
FileName := ExpandConstant('{tmp}\{#MySetupAppName}');
DownloadUrl := '{#MySetupUrlFolder}{#MySetupAppName}';
idpAddFile(DownloadUrl, FileName);
idpDownloadAfter(wpSelectDir);
end;
function NextButtonClick(CurPageID: Integer) : boolean;
var ResultCode: Integer;
begin
if CurPageID = IDPForm.Page.ID then
begin
Result := Exec(FileName, '', '', SW_SHOW, ewWaitUntilTerminated, ResultCode);
if not Result then MsgBox('Error Running Downloaded Setup File', mbError, MB_OK);
Result := True;
end
else Result := True;
end;
Any Ideas? Everything else works fine.
Edit: I have a workaround that will show the details section. This might be more appropriate anyways. Still not sure why the Total progress is not updating.
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = IDPForm.Page.ID then
begin
idpShowDetails(True);
IDPForm.TotalProgressBar.Visible := false;
IDPForm.TotalProgressLabel.Visible := false;
IDPForm.TotalDownloaded.Visible := false;
IDPForm.CurrentFileLabel.Caption := 'Downloading...';
IDPForm.DetailsButton.Visible := False;
WizardForm.NextButton.Visible := False;
WizardForm.PageNameLabel.Caption := 'Downloading Setup File';
WizardForm.PageDescriptionLabel.Caption := 'Please wait while the Setup file is being downloaded.';
end;
end;
I indeed get the same behavior. I do not understand why.
But as you have a single file, you can replace the total progress bar with file progress bar:
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = IDPForm.Page.ID then
begin
IDPForm.TotalProgressBar.Visible := False;
IDPForm.FileProgressBar.Top := IDPForm.TotalProgressBar.Top;
IDPForm.FileProgressBar.Visible := True;
IDPForm.DetailsButton.Visible := False;
IDPForm.DetailsVisible := True;
end;
end;

How to get amin rights during runtime using delphi xe5 [duplicate]

We need to change some settings to the HKEY_LOCAL_MACHINE at runtime.
Is it possible to prompt for uac elevation if needed at runtime, or do I have to launch a second elevated process to do 'the dirty work'?
i would relaunch yourself as elevated, passing command line parameters indicating what elevated thing you want to do. You can then jump right to the appropriate form, or just save your HKLM stuff.
function RunAsAdmin(hWnd: HWND; filename: string; Parameters: string): Boolean;
{
See Step 3: Redesign for UAC Compatibility (UAC)
http://msdn.microsoft.com/en-us/library/bb756922.aspx
This code is released into the public domain. No attribution required.
}
var
sei: TShellExecuteInfo;
begin
ZeroMemory(#sei, SizeOf(sei));
sei.cbSize := SizeOf(TShellExecuteInfo);
sei.Wnd := hwnd;
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
sei.lpVerb := PChar('runas');
sei.lpFile := PChar(Filename); // PAnsiChar;
if parameters <> '' then
sei.lpParameters := PChar(parameters); // PAnsiChar;
sei.nShow := SW_SHOWNORMAL; //Integer;
Result := ShellExecuteEx(#sei);
end;
The other Microsoft suggested solution is to create an COM object out of process (using the specially created CoCreateInstanceAsAdmin function). i don't like this idea because you have to write and register a COM object.
Note: There is no "CoCreateInstanceAsAdmin" API call. It's just some code floating around. Here's the Dephi version i stumbled around for. It is apparently based on the trick of prefixing a class guid string with the "Elevation:Administrator!new:" prefix when normally hidden code internally calls CoGetObject:
function CoGetObject(pszName: PWideChar; pBindOptions: PBindOpts3;
const iid: TIID; ppv: PPointer): HResult; stdcall; external 'ole32.dll';
procedure CoCreateInstanceAsAdmin(const Handle: HWND;
const ClassID, IID: TGuid; PInterface: PPointer);
var
BindOpts: TBindOpts3;
MonikerName: WideString;
Res: HRESULT;
begin
//This code is released into the public domain. No attribution required.
ZeroMemory(#BindOpts, Sizeof(TBindOpts3));
BindOpts.cbStruct := Sizeof(TBindOpts3);
BindOpts.hwnd := Handle;
BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;
MonikerName := 'Elevation:Administrator!new:' + GUIDToString(ClassID);
Res := CoGetObject(PWideChar(MonikerName), #BindOpts, IID, PInterface);
if Failed(Res) then
raise Exception.Create(SysErrorMessage(Res));
end;
One other question: How do you handle someone running as standard user in Windows XP?
You can't "elevate" an existing process. Elevated processes under UAC have a different token with a different LUID, different mandatory integrity level, and different group membership. This level of change can't be done within a running process - and it would be a security problem if that could happen.
You need to launch a second process elevated that would do the work or by creating a COM object that runs in an elevated dllhost.
http://msdn.microsoft.com/en-us/library/bb756922.aspx gives an example "RunAsAdmin" function and a "CoCreateInstanceAsAdmin" function.
EDIT: I just saw "Delphi" in your title. Everything I listed is obviously native, but if Delphi provides access to ShellExecute-like functionality you should be able to adapt the code from the link.
A sample of ready-to-use code:
Usage example:
unit Unit1;
interface
uses
Windows{....};
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure StartWait;
procedure EndWait;
end;
var
Form1: TForm1;
implementation
uses
RunElevatedSupport;
{$R *.dfm}
const
ArgInstallUpdate = '/install_update';
ArgRegisterExtension = '/register_global_file_associations';
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption := Format('IsAdministrator: %s', [BoolToStr(IsAdministrator, True)]);
Label2.Caption := Format('IsAdministratorAccount: %s', [BoolToStr(IsAdministratorAccount, True)]);
Label3.Caption := Format('IsUACEnabled: %s', [BoolToStr(IsUACEnabled, True)]);
Label4.Caption := Format('IsElevated: %s', [BoolToStr(IsElevated, True)]);
Button1.Caption := 'Install updates';
SetButtonElevated(Button1.Handle);
Button2.Caption := 'Register file associations for all users';
SetButtonElevated(Button2.Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StartWait;
try
SetLastError(RunElevated(ArgInstallUpdate, Handle, Application.ProcessMessages));
if GetLastError <> ERROR_SUCCESS then
RaiseLastOSError;
finally
EndWait;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StartWait;
try
SetLastError(RunElevated(ArgRegisterExtension, Handle, Application.ProcessMessages));
if GetLastError <> ERROR_SUCCESS then
RaiseLastOSError;
finally
EndWait;
end;
end;
function DoElevatedTask(const AParameters: String): Cardinal;
procedure InstallUpdate;
var
Msg: String;
begin
Msg := 'Hello from InstallUpdate!' + sLineBreak +
sLineBreak +
'This function is running elevated under full administrator rights.' + sLineBreak +
'This means that you have write-access to Program Files folder and you''re able to overwrite files (e.g. install updates).' + sLineBreak +
'However, note that your executable is still running.' + sLineBreak +
sLineBreak +
'IsAdministrator: ' + BoolToStr(IsAdministrator, True) + sLineBreak +
'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
'IsUACEnabled: ' + BoolToStr(IsUACEnabled, True) + sLineBreak +
'IsElevated: ' + BoolToStr(IsElevated, True);
MessageBox(0, PChar(Msg), 'Hello from InstallUpdate!', MB_OK or MB_ICONINFORMATION);
end;
procedure RegisterExtension;
var
Msg: String;
begin
Msg := 'Hello from RegisterExtension!' + sLineBreak +
sLineBreak +
'This function is running elevated under full administrator rights.' + sLineBreak +
'This means that you have write-access to HKEY_LOCAL_MACHINE key and you''re able to write keys and values (e.g. register file extensions globally/for all users).' + sLineBreak +
'However, note that this is usually not a good idea. It is better to register your file extensions under HKEY_CURRENT_USER\Software\Classes.' + sLineBreak +
sLineBreak +
'IsAdministrator: ' + BoolToStr(IsAdministrator, True) + sLineBreak +
'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
'IsUACEnabled: ' + BoolToStr(IsUACEnabled, True) + sLineBreak +
'IsElevated: ' + BoolToStr(IsElevated, True);
MessageBox(0, PChar(Msg), 'Hello from RegisterExtension!', MB_OK or MB_ICONINFORMATION);
end;
begin
Result := ERROR_SUCCESS;
if AParameters = ArgInstallUpdate then
InstallUpdate
else
if AParameters = ArgRegisterExtension then
RegisterExtension
else
Result := ERROR_GEN_FAILURE;
end;
procedure TForm1.StartWait;
begin
Cursor := crHourglass;
Screen.Cursor := crHourglass;
Button1.Enabled := False;
Button2.Enabled := False;
Application.ProcessMessages;
end;
procedure TForm1.EndWait;
begin
Cursor := crDefault;
Screen.Cursor := crDefault;
Button1.Enabled := True;
Button2.Enabled := True;
Application.ProcessMessages;
end;
initialization
OnElevateProc := DoElevatedTask;
CheckForElevatedTask;
end.
And support unit itself:
unit RunElevatedSupport;
{$WARN SYMBOL_PLATFORM OFF}
{$R+}
interface
uses
Windows;
type
TElevatedProc = function(const AParameters: String): Cardinal;
TProcessMessagesMeth = procedure of object;
var
// Warning: this function will be executed in external process.
// Do not use any global variables inside this routine!
// Use only supplied AParameters.
OnElevateProc: TElevatedProc;
// Call this routine after you have assigned OnElevateProc
procedure CheckForElevatedTask;
// Runs OnElevateProc under full administrator rights
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
function IsAdministrator: Boolean;
function IsAdministratorAccount: Boolean;
function IsUACEnabled: Boolean;
function IsElevated: Boolean;
procedure SetButtonElevated(const AButtonHandle: THandle);
implementation
uses
SysUtils, Registry, ShellAPI, ComObj;
const
RunElevatedTaskSwitch = '0CC5C50CB7D643B68CB900BF000FFFD5'; // some unique value, just a GUID with removed '[', ']', and '-'
function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership';
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
var
SEI: TShellExecuteInfo;
Host: String;
Args: String;
begin
Assert(Assigned(OnElevateProc), 'OnElevateProc must be assigned before calling RunElevated');
if IsElevated then
begin
if Assigned(OnElevateProc) then
Result := OnElevateProc(AParameters)
else
Result := ERROR_PROC_NOT_FOUND;
Exit;
end;
Host := ParamStr(0);
Args := Format('/%s %s', [RunElevatedTaskSwitch, AParameters]);
FillChar(SEI, SizeOf(SEI), 0);
SEI.cbSize := SizeOf(SEI);
SEI.fMask := SEE_MASK_NOCLOSEPROCESS;
{$IFDEF UNICODE}
SEI.fMask := SEI.fMask or SEE_MASK_UNICODE;
{$ENDIF}
SEI.Wnd := AWnd;
SEI.lpVerb := 'runas';
SEI.lpFile := PChar(Host);
SEI.lpParameters := PChar(Args);
SEI.nShow := SW_NORMAL;
if not ShellExecuteEx(#SEI) then
RaiseLastOSError;
try
Result := ERROR_GEN_FAILURE;
if Assigned(AProcessMessages) then
begin
repeat
if not GetExitCodeProcess(SEI.hProcess, Result) then
Result := ERROR_GEN_FAILURE;
AProcessMessages;
until Result <> STILL_ACTIVE;
end
else
begin
if WaitForSingleObject(SEI.hProcess, INFINITE) <> WAIT_OBJECT_0 then
if not GetExitCodeProcess(SEI.hProcess, Result) then
Result := ERROR_GEN_FAILURE;
end;
finally
CloseHandle(SEI.hProcess);
end;
end;
function IsAdministrator: Boolean;
var
psidAdmin: Pointer;
B: BOOL;
const
SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
SE_GROUP_USE_FOR_DENY_ONLY = $00000010;
begin
psidAdmin := nil;
try
// Создаём SID группы админов для проверки
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
psidAdmin));
// Проверяем, входим ли мы в группу админов (с учётов всех проверок на disabled SID)
if CheckTokenMembership(0, psidAdmin, B) then
Result := B
else
Result := False;
finally
if psidAdmin <> nil then
FreeSid(psidAdmin);
end;
end;
{$R-}
function IsAdministratorAccount: Boolean;
var
psidAdmin: Pointer;
Token: THandle;
Count: DWORD;
TokenInfo: PTokenGroups;
HaveToken: Boolean;
I: Integer;
const
SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
SE_GROUP_USE_FOR_DENY_ONLY = $00000010;
begin
Result := Win32Platform <> VER_PLATFORM_WIN32_NT;
if Result then
Exit;
psidAdmin := nil;
TokenInfo := nil;
HaveToken := False;
try
Token := 0;
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token);
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
if HaveToken then
begin
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
psidAdmin));
if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or
(GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
RaiseLastOSError;
TokenInfo := PTokenGroups(AllocMem(Count));
Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count));
for I := 0 to TokenInfo^.GroupCount - 1 do
begin
Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid);
if Result then
Break;
end;
end;
finally
if TokenInfo <> nil then
FreeMem(TokenInfo);
if HaveToken then
CloseHandle(Token);
if psidAdmin <> nil then
FreeSid(psidAdmin);
end;
end;
{$R+}
function IsUACEnabled: Boolean;
var
Reg: TRegistry;
begin
Result := CheckWin32Version(6, 0);
if Result then
begin
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then
if Reg.ValueExists('EnableLUA') then
Result := (Reg.ReadInteger('EnableLUA') <> 0)
else
Result := False
else
Result := False;
finally
FreeAndNil(Reg);
end;
end;
end;
function IsElevated: Boolean;
const
TokenElevation = TTokenInformationClass(20);
type
TOKEN_ELEVATION = record
TokenIsElevated: DWORD;
end;
var
TokenHandle: THandle;
ResultLength: Cardinal;
ATokenElevation: TOKEN_ELEVATION;
HaveToken: Boolean;
begin
if CheckWin32Version(6, 0) then
begin
TokenHandle := 0;
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, TokenHandle);
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle);
if HaveToken then
begin
try
ResultLength := 0;
if GetTokenInformation(TokenHandle, TokenElevation, #ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
Result := ATokenElevation.TokenIsElevated <> 0
else
Result := False;
finally
CloseHandle(TokenHandle);
end;
end
else
Result := False;
end
else
Result := IsAdministrator;
end;
procedure SetButtonElevated(const AButtonHandle: THandle);
const
BCM_SETSHIELD = $160C;
var
Required: BOOL;
begin
if not CheckWin32Version(6, 0) then
Exit;
if IsElevated then
Exit;
Required := True;
SendMessage(AButtonHandle, BCM_SETSHIELD, 0, LPARAM(Required));
end;
procedure CheckForElevatedTask;
function GetArgsForElevatedTask: String;
function PrepareParam(const ParamNo: Integer): String;
begin
Result := ParamStr(ParamNo);
if Pos(' ', Result) > 0 then
Result := AnsiQuotedStr(Result, '"');
end;
var
X: Integer;
begin
Result := '';
for X := 1 to ParamCount do
begin
if (AnsiUpperCase(ParamStr(X)) = ('/' + RunElevatedTaskSwitch)) or
(AnsiUpperCase(ParamStr(X)) = ('-' + RunElevatedTaskSwitch)) then
Continue;
Result := Result + PrepareParam(X) + ' ';
end;
Result := Trim(Result);
end;
var
ExitCode: Cardinal;
begin
if not FindCmdLineSwitch(RunElevatedTaskSwitch) then
Exit;
ExitCode := ERROR_GEN_FAILURE;
try
if not IsElevated then
ExitCode := ERROR_ACCESS_DENIED
else
if Assigned(OnElevateProc) then
ExitCode := OnElevateProc(GetArgsForElevatedTask)
else
ExitCode := ERROR_PROC_NOT_FOUND;
except
on E: Exception do
begin
if E is EAbort then
ExitCode := ERROR_CANCELLED
else
if E is EOleSysError then
ExitCode := Cardinal(EOleSysError(E).ErrorCode)
else
if E is EOSError then
else
ExitCode := ERROR_GEN_FAILURE;
end;
end;
if ExitCode = STILL_ACTIVE then
ExitCode := ERROR_GEN_FAILURE;
TerminateProcess(GetCurrentProcess, ExitCode);
end;
end.
Usually, putting the text "Setup" or "Install" somewhere in your EXE name is enough to make Windows run with elevated privileges automatically, and is well worth doing if it is a setup utility you are writing, as it's so easy to do.
I am now running into problems though on Windows 7, when not logged in as an Administrator, and am having to use the right-click Run As Administrator when running manually (running the program via Wise installation wizard is still fine)
I see though that Delphi 10.1 Berlin has a very easy to use new option under Project Options | Application. Just tick Enable Administrator Privileges, and the manifest is done for you, so easy!
NB. make sure you only do these kind of changes via a separate setup program, running your application with elevated privileges all the time can cause problems with other things, for example e-mail, where the default mail profile no longer gets picked up.
Edit: Jan 2018: since writing this answer in August 2017, it seems a lot of Windows updates have come out, that now require the user to right-click and Run As Administrator on just about everything, even on installation exe's built with Wise. Even Outlook is no longer installing properly without running as administrator. There is no more automated elevation at all it seems.

Delphi application - Block windows-key (Start) on Windows 8

I' programming a Delphi application. My goal is to cover ALL screen with my application to force user to fill my form. Application will be run as scheduled task.
My problem is, that normally, Windows does not allow applications to block other users action.
In Windows 7 I can run my application as scr file (screen saver), with no title bar and set StayOnTop. In this case, other application even if visible on "Window key" (start), stays behind my application, so my goal is reached.
Unfortunately, in Windows 8 this solution does not work because "window key" shows start screen, when I can run anything and this "anything" stays on top.
I tried some trick with code below, but without success.
h := FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil);
ShowWindow(h,0);
Windows.SetParent(h,0);
How to block 'window key' (start button) action in the entire Windows 8 system?
I didn't test it on windows 8, but in principle one can use a keyboard hook to discard the key-press.
Something similar to the following:
const
WH_KEYBOARD_LL = 13;
LLKHF_ALTDOWN = $00000020;
LLKHF_INJECTED = $00000010;
type
tagKBDLLHOOKSTRUCT = record
vkCode: DWORD;
scanCode: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
KBDLLHOOKSTRUCT = tagKBDLLHOOKSTRUCT;
LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
var
hhkLowLevelKybd: HHOOK;
function LowLevelKeyBoardProc(nCode: Integer; awParam: WPARAM; alParam: LPARAM): LRESULT; stdcall;
var
fEatKeyStroke: Boolean;
p: PKBDLLHOOKSTRUCT;
begin
fEatKeystroke := False;
if active and( nCode = HC_ACTION) then
begin
case awParam of
WM_KEYDOWN,
WM_SYSKEYDOWN,
WM_KEYUP,
WM_SYSKEYUP:
begin
p := PKBDLLHOOKSTRUCT(alParam);
if DisableWinKeys then
begin
if p^.vkCode = VK_LWIN
then fEatKeystroke := True;
if p^.vkCode = VK_RWIN
then fEatKeystroke := True;
end;
end;
end;
end;
if fEatKeyStroke then
Result := 1
else
Result := CallNextHookEx(hhkLowLevelKybd, nCode, awParam, alParam);
end;
procedure InstallHook;
begin
if hhkLowLevelKybd <> 0 then exit;
hhkLowLevelKybd := SetWindowsHookEx(WH_KEYBOARD_LL, #LowLevelKeyboardProc, hInstance, 0);
end;
procedure UninstallHook;
begin
if hhkLowLevelKybd = 0 then exit;
UnhookWindowsHookEx(hhkLowLevelKybd);
hhkLowLevelKybd := 0;
end;

Inno Setup: How to automatically uninstall previous installed version?

I'm using Inno Setup to create an installer.
I want the installer to automatically uninstall the previous installed version, instead of overwriting it. How can I do that?
I have used the following. I'm not sure it's the simplest way to do it but it works.
This uses {#emit SetupSetting("AppId")} which relies on the Inno Setup Preprocessor. If you don't use that, cut-and-paste your App ID in directly.
[Code]
{ ///////////////////////////////////////////////////////////////////// }
function GetUninstallString(): String;
var
sUnInstPath: String;
sUnInstallString: String;
begin
sUnInstPath := ExpandConstant('Software\Microsoft\Windows\CurrentVersion\Uninstall\{#emit SetupSetting("AppId")}_is1');
sUnInstallString := '';
if not RegQueryStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString) then
RegQueryStringValue(HKCU, sUnInstPath, 'UninstallString', sUnInstallString);
Result := sUnInstallString;
end;
{ ///////////////////////////////////////////////////////////////////// }
function IsUpgrade(): Boolean;
begin
Result := (GetUninstallString() <> '');
end;
{ ///////////////////////////////////////////////////////////////////// }
function UnInstallOldVersion(): Integer;
var
sUnInstallString: String;
iResultCode: Integer;
begin
{ Return Values: }
{ 1 - uninstall string is empty }
{ 2 - error executing the UnInstallString }
{ 3 - successfully executed the UnInstallString }
{ default return value }
Result := 0;
{ get the uninstall string of the old app }
sUnInstallString := GetUninstallString();
if sUnInstallString <> '' then begin
sUnInstallString := RemoveQuotes(sUnInstallString);
if Exec(sUnInstallString, '/SILENT /NORESTART /SUPPRESSMSGBOXES','', SW_HIDE, ewWaitUntilTerminated, iResultCode) then
Result := 3
else
Result := 2;
end else
Result := 1;
end;
{ ///////////////////////////////////////////////////////////////////// }
procedure CurStepChanged(CurStep: TSetupStep);
begin
if (CurStep=ssInstall) then
begin
if (IsUpgrade()) then
begin
UnInstallOldVersion();
end;
end;
end;
Alternatives
See also this blog post "Inno Setup Script Sample for Version Comparison" which goes one step further, and reads the version number of any previously installed version, and compares that version number with that of the current installation package.
You should be able to read the uninstall string from the registry, given the AppId (i.e. the value you used for AppID in the [Setup]-section). It could be found under Software\Microsoft\Windows\CurrentVersion\Uninstall\{AppId}\ (could be either HKLM or HKCU, so best check both) where {AppId} should be substituted with the actual value you used. Look for the UninstallString or QuietUninstallString values and use the Exec function to run it from your InitializeSetup() event function.
If you "just want to remove the old icons" (because yours have changed/updated) you can use this:
; attempt to remove previous versions' icons
[InstallDelete]
Type: filesandordirs; Name: {group}\*;
This is run "at the beginning of installation" so basically removes the old icons, and your new ones will still be installed there after this is completely done.
I just do this with every install "in case anything has changed" icon wise (it all gets reinstalled anyway).
When using Inno Setup, there's no reason to uninstall a previous version unless that version was installed by a different installer program. Otherwise upgrades are handled automatically.
Here is a simplified version based on answer from Craig McQueen:
const
UninstallRegisterPath = 'Software\Microsoft\Windows\CurrentVersion\Uninstall\' + '{#emit SetupSetting("AppName")}' + '_is1';
function GetUninstallerPath(): String;
begin
result := '';
if (not RegQueryStringValue(HKLM, UninstallRegisterPath, 'UninstallString', result)) then
RegQueryStringValue(HKCU, UninstallRegisterPath, 'UninstallString', result);
end;
procedure UninstallOldVersion();
var
UninstallerPath: String;
ResultCode: Integer;
begin
UninstallerPath := GetUninstallerPath();
if (UninstallerPath <> '') then begin
Exec(UninstallerPath, '/VERYSILENT /NORESTART /SUPPRESSMSGBOXES', '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if (CurStep = ssInstall) then
begin
UninstallOldVersion();
end;
end;
Note: in my case, I use AppName instead of AppId.
The answer provided by Craig McQueen is totally viable. Although, I would add those comments:
The {#emit SetupSetting("AppId")} code does not work for me, so I just add my App ID.
I didn't want to execute my uninstallation program, because I have a INI config file stored in the AppData/ folder which is removed by the uninstaller, and I don't want it to be erased when installing a new version. So, I modified a bit the code provided by Craig McQueen to remove the directory where is installed the program, after retrieving its path.
So, regarding the code of Craig McQueen, changes are:
Retrieve the InstallLocation key instead of the UninstallString key.
Use the DelTree function instead of the Exec(sUnInstallString, ...)
For anyone that uses the GetUninstallString() suggested above to force an uninstall inside CurStepChanged() and has disk caching issues, see below for a related solution that actually waits a while after unistallation for the uninstaller exe to be deleted!
Disk caching issue with inno-setup?
For those interested, I wrote a DLL for Inno Setup 6 and later that provides a simple mechanism for supporting automatic uninstall.
The DLL provides a way to detect if the package you are installing is already installed (via AppId) and to decide, based on the installed version, if you want to automatically uninstall it (for example, you might want to automatically uninstall if user is downgrading).
https://github.com/Bill-Stewart/UninsIS
You can exec an uninstaller in the [code] section. You have to figure out how to get the path to the existing uninstaller. For simplicity when I install my apps I add a registry string value that points to the folder containing the uninstaller, and just exec the uninstaller in the InitializeWizard callback.
Keep in mind that Inno setup uninstaller names are all of the form uninsnnn.exe, you need to take that into account in your code.
i got edited #Crain Mc-Queen code , i think this code is better because not need to modified in different project :
[Code]
function GetNumber(var temp: String): Integer;
var
part: String;
pos1: Integer;
begin
if Length(temp) = 0 then
begin
Result := -1;
Exit;
end;
pos1 := Pos('.', temp);
if (pos1 = 0) then
begin
Result := StrToInt(temp);
temp := '';
end
else
begin
part := Copy(temp, 1, pos1 - 1);
temp := Copy(temp, pos1 + 1, Length(temp));
Result := StrToInt(part);
end;
end;
function CompareInner(var temp1, temp2: String): Integer;
var
num1, num2: Integer;
begin
num1 := GetNumber(temp1);
num2 := GetNumber(temp2);
if (num1 = -1) or (num2 = -1) then
begin
Result := 0;
Exit;
end;
if (num1 > num2) then
begin
Result := 1;
end
else if (num1 < num2) then
begin
Result := -1;
end
else
begin
Result := CompareInner(temp1, temp2);
end;
end;
function CompareVersion(str1, str2: String): Integer;
var
temp1, temp2: String;
begin
temp1 := str1;
temp2 := str2;
Result := CompareInner(temp1, temp2);
end;
function InitializeSetup(): Boolean;
var
oldVersion: String;
uninstaller: String;
ErrorCode: Integer;
vCurID :String;
vCurAppName :String;
begin
vCurID:= '{#SetupSetting("AppId")}';
vCurAppName:= '{#SetupSetting("AppName")}';
//remove first "{" of ID
vCurID:= Copy(vCurID, 2, Length(vCurID) - 1);
//
if RegKeyExists(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + vCurID + '_is1') then
begin
RegQueryStringValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + vCurID + '_is1',
'DisplayVersion', oldVersion);
if (CompareVersion(oldVersion, '{#SetupSetting("AppVersion")}') < 0) then
begin
if MsgBox('Version ' + oldVersion + ' of ' + vCurAppName + ' is already installed. Continue to use this old version?',
mbConfirmation, MB_YESNO) = IDYES then
begin
Result := False;
end
else
begin
RegQueryStringValue(HKEY_LOCAL_MACHINE,
'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + vCurID + '_is1',
'UninstallString', uninstaller);
ShellExec('runas', uninstaller, '/SILENT', '', SW_HIDE, ewWaitUntilTerminated, ErrorCode);
Result := True;
end;
end
else
begin
MsgBox('Version ' + oldVersion + ' of ' + vCurAppName + ' is already installed. This installer will exit.',
mbInformation, MB_OK);
Result := False;
end;
end
else
begin
Result := True;
end;
end;
I must be missing something.
The new files are copied to the target directory before the removal of the old installation occurs.
Then comes the uninstaller deletes them and remove the directory.
Do not use the [Run] section, but the [UninstallRun].
Infact, the program under [Run] are executed after the installation, causing to uninstall your program immediately after the installation :-|
Instead, the [UninstallRun] section is evaluated before the installation.
Follow this link: http://news.jrsoftware.org/news/innosetup/msg55323.html
In InitializeSetup() function, you can call "MSIEXEC /x {your program ID}" after user prompt to uninstall old old version

Resources