What is the `MinServicePack` parameter in IsDotNetInstalled Inno Setup function - inno-setup

I just noticed that Inno Setup 6.0.4 is now out and that it has a new IsDotNetInstalled function.
At the moment I have been using this script to see if 4.6.2 is installed:
{ Determines if .NET 4.6.2 (or higher) is installed }
function IsDotNetDetected(): boolean;
var
strKey64: string;
strKey86: string;
dwInstalled: cardinal;
begin
strKey64 := 'SOFTWARE\Wow6432Node\Microsoft\NET Framework Setup\NDP\v4\Full';
strKey86 := 'SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full';
result := false; { Assume .NET Framework 4.6.2 is not installed }
{ For more information, see: }
{ http://msdn.microsoft.com/en-us/library/hh925568%28v=vs.110%29.aspx#net_b }
if(Is64BitInstallMode()) then begin
if (RegValueExists(HKLM, strKey64, 'Release')) then begin
RegQueryDWordValue(HKLM, strKey64, 'Release', dwInstalled);
if(dwInstalled >= 378675) then begin
result := true;
end;
end;
end
else begin
if (RegValueExists(HKLM, strKey86, 'Release')) then begin
RegQueryDWordValue(HKLM, strKey86, 'Release', dwInstalled);
if(dwInstalled >= 378675) then begin
result := true;
end;
end;
end;
end;
The above code was called here:
function PrepareToInstall(var NeedsRestart: Boolean): String;
begin
result := '';
dotNetNeeded := not IsDotNetDetected();
if(dotNetNeeded) then begin
if (MsgBox(ExpandConstant('{cm:DotNet_NeedToDownload}'),
mbConfirmation, MB_OKCANCEL) = IDCANCEL) then begin
result := ExpandConstant('{cm:DotNet_InstallAborted}');
Abort();
end;
end;
if (bDownloadHelpDocSetup) then
DoDeleteFile(ExpandConstant('{app}\MeetSchedAssist.chm'));
end;
I have read the help topic and it seems that I can simplify this code to:
function PrepareToInstall(var NeedsRestart: Boolean): String;
begin
result := '';
dotNetNeeded := not IsDotNetInstalled(net462, 0);
if(dotNetNeeded) then begin
if (MsgBox(ExpandConstant('{cm:DotNet_NeedToDownload}'),
mbConfirmation, MB_OKCANCEL) = IDCANCEL) then begin
result := ExpandConstant('{cm:DotNet_InstallAborted}');
Abort();
end;
end;
if (bDownloadHelpDocSetup) then
DoDeleteFile(ExpandConstant('{app}\MeetSchedAssist.chm'));
end;
I notice that the sample code is also using this to format the error message:
FmtMessage(SetupMessage(msgWinVersionTooLowError), ['.NET Framework', '4.6.2'])
What is the MinServicePack parameter here?
Thanks for the clarification.

I found the answer about MinServicePack here. It states:
// service -- Specify any non-negative integer for the required service pack level:
// 0 No service packs required
// 1, 2, etc. Service pack 1, 2, etc. required

Related

Inno Setup - Uninstall the previous version correctly [duplicate]

This question already has answers here:
Executing UninstallString in Inno Setup
(1 answer)
Inno Setup: How to automatically uninstall previous installed version?
(13 answers)
Closed 5 years ago.
I am trying to use this code to uninstall the previous version (optionally, if it is installed) and uninstall silent from control panel:
#define AppId "Program158"
[code]
procedure ChangeUninstallString;
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 begin
RegQueryStringValue(HKCU, sUnInstPath, 'UninstallString', sUnInstallString);
RegWriteStringValue(HKCU, sUnInstPath, 'UninstallString', sUnInstallString + '/SILENT');
end
else begin
RegWriteStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString + '/SILENT');
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep=ssPostInstall then begin
ChangeUninstallString;
end;
end;
function GetUninstallString: string;
var
sUnInstPath: string;
sUnInstallString: String;
begin
Result := '';
sUnInstPath := ExpandConstant('Software\Microsoft\Windows\CurrentVersion\Uninstall\Program156_is1'); { Your App GUID/ID }
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 InitializeSetup(): Boolean;
var
V: Integer;
iResultCode: Integer;
sUnInstallString: string;
begin
Result := True; { in case when no previous version is found }
if RegValueExists(HKEY_LOCAL_MACHINE,'Software\Microsoft\Windows\CurrentVersion\Uninstall\Program156_is1', 'UninstallString') then { Your App GUID/ID }
begin
V := MsgBox(ExpandConstant('Hey! An old version of app was detected. Do you want to uninstall it?'), mbInformation, MB_YESNO); { Custom Message if App installed }
if V = IDYES then
begin
sUnInstallString := GetUninstallString();
sUnInstallString := RemoveQuotes(sUnInstallString);
Exec(ExpandConstant(sUnInstallString), '', '', SW_SHOW, ewWaitUntilTerminated, iResultCode);
Result := True; { if you want to proceed after uninstall }
{ Exit; //if you want to quit after uninstall }
end
else
Result := False; { when older version present and not uninstalled }
end;
end;
This code does not work correctly if both ideas are used simultaneously. It only works well if I use the code to detect the previous version and the uninstaller runs. If I use both ideas simultaneously (all this code), if I choose to uninstall the previous version of my program, the uninstaller does not run.
How to correctly use both codes simultaneously?

Checking for presence of Framework 4.6.2 using Inno Setup

I have this custom code to check for installation of the Microsoft Framework:
function PrepareToInstall(var NeedsRestart: Boolean): String;
var
IsInstalled: Cardinal;
begin
Result := '';
dotNetNeeded := true;
{ Check for required netfx installation }
{ http://msdn.microsoft.com/en-us/library/hh925568%28v=vs.110%29.aspx#net_b }
if(Is64BitInstallMode()) then begin
if (RegValueExists(HKLM, 'SOFTWARE\Wow6432Node\Microsoft\NET Framework Setup\NDP\v4\Full', 'Release')) then begin
RegQueryDWordValue(HKLM, 'SOFTWARE\Wow6432Node\Microsoft\NET Framework Setup\NDP\v4\Full', 'Release', IsInstalled);
if(IsInstalled >= 378675) then begin
dotNetNeeded := false;
downloadNeeded := false;
end;
end;
end
else begin
if (RegValueExists(HKLM, 'SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full', 'Release')) then begin
RegQueryDWordValue(HKLM, 'SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full', 'Release', IsInstalled);
if(IsInstalled >= 378675) then begin
dotNetNeeded := false;
downloadNeeded := false;
end;
end;
end;
if(dotNetNeeded) then begin
if (not IsAdminLoggedOn()) then begin
Result := ExpandConstant('{cm:DotNet_NeedAdminRights}');
end
else begin
dotnetRedistPath := ExpandConstant('{src}\NDP451-KB2858728-x86-x64-AllOS-ENU.exe');
if not FileExists(dotnetRedistPath) then begin
dotnetRedistPath := ExpandConstant('{tmp}\NDP451-KB2858728-x86-x64-AllOS-ENU.exe');
if not FileExists(dotnetRedistPath) then begin
isxdl_AddFile(dotnetRedistURL, dotnetRedistPath);
downloadNeeded := true;
end;
end;
if (downloadNeeded) then begin
if (MsgBox(ExpandConstant('{cm:DotNet_NeedToDownload}'), mbConfirmation, MB_OKCANCEL) = IDCANCEL) then begin
Result := ExpandConstant('{cm:DotNet_InstallAborted}');
end;
end;
end;
end;
end;
I am in the process of migrating this code to support the 4.6.2 framework, so I can going to change download path to:
http://go.microsoft.com/fwlink/?LinkId=780600
With the file name:
NDP462-KB3151800-x86-x64-AllOS-ENU.exe
But, it is the registry checking I have a question about. According to here for version 4.6.2 the value of the key will be:
On Windows 10 Anniversary Update: 394802
On all other OS versions: 394806
How do I know within my script which value I should be looking for? Or is it safe to just use >= 394802?
The test for >= 394802 should be good enough.
If you want to be on the safe side, you use this to test for the Windows 10 Anniversary Update (build 10.0.14393):
GetWindowsVersion >= $A003839

Merging event function (InitializeWizard) implementations from different sources

I am now combining the script that I want but it has an error.
When I put a period, it will run but missing other feature.
Here is my code:
procedure InitializeWizard;
begin
MessageBoxTimeout(WizardForm.Handle, 'MsgBox ' +
Timeout 'Setup', MB_OK or MB_ICONINFORMATION, 0, 2000);
end;
var
TuneLabel: TLabel;
begin
ExtractTemporaryFile('tune.xm');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
SoundCtrlButton := TNewButton.Create(WizardForm);
Music := BASS_MusicLoad(False,
ExpandConstant('{tmp}\tune.xm'), 0, 0,
EncodingFlag or BASS_SAMPLE_LOOP, 0);
BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, 10000);
BASS_ChannelPlay(Music, False);
SoundCtrlButton := TNewButton.Create(WizardForm);
SoundCtrlButton.Parent := WizardForm;
SoundCtrlButton.Left := 10;
SoundCtrlButton.TabStop := False;
SoundCtrlButton.Top := WizardForm.ClientHeight -
SoundCtrlButton.Height - 9;
SoundCtrlButton.Width := 40;
SoundCtrlButton.Caption :=
ExpandConstant('{cm:SoundCtrlButtonCaptionSoundOff}');
SoundCtrlButton.OnClick := #SoundCtrlButtonClick;
TuneLabel := TLabel.Create(WizardForm);
TuneLabel.Parent := WizardForm;
TuneLabel.Caption := 'Tune';
TuneLabel.Left := SoundCtrlButton.Left + SoundCtrlButton.Width + ScaleX(5);
TuneLabel.Top :=
SoundCtrlButton.Top + ((SoundCtrlButton.Height - TuneLabel.Height) div 2);
end;
end;
The error refers to a line after the last end;.
Please help me through.
When you are reusing various feature implementations from different sources, those commonly implement the same Inno Setup event functions (like the InitializeWizard).
The solution for Inno Setup 6 is very simple, as shown below. In older versions it's more complicated. See lower.
Inno Setup 6
Inno Setup 6 has event attributes features that helps solving this problem.
Just make sure that each of your event implementation have an unique name, e.g. appending unique suffix. And add event attribute with the name of the implemented event.
[Code]
procedure InitializeWizard;
begin
Log('InitializeWizard called');
end;
<event('InitializeWizard')>
procedure InitializeWizard2;
begin
Log('InitializeWizard2 called');
end;
Inno Setup 5
In old versions of Inno Setup that does not support the event attributes, you have to merge these event functions as there can be just one function implementation.
You can do that by appending unique suffix to the different implementation and than calling them from a main implementation.
The main implementation have to be below the other implementations.
For example, if one source has InitializeWizard event function implemented as:
var
GlobalVariable1: Integer;
procedure SubProcedure1;
begin
{ blah }
end;
procedure InitializeWizard;
var
Variable1: Integer;
Variable2: Integer;
begin
Variable1 := GlobalVariable1;
SubProcedure1;
end;
And the other source as:
var
GlobalVariableA: Integer;
procedure SubProcedureA;
begin
{ blah }
end;
procedure InitializeWizard;
var
VariableA: Integer;
begin
VariableA := GlobalVariableA;
SubProcedureA;
end;
Then merged code should be:
var
GlobalVariable1: Integer;
procedure SubProcedure1;
begin
{ blah }
end;
procedure InitializeWizard1;
var
Variable1: Integer;
Variable2: Integer;
begin
Variable1 := GlobalVariable1;
SubProcedure1;
end;
var
GlobalVariableA: Integer;
procedure SubProcedureA;
begin
{ blah }
end;
procedure InitializeWizard2;
var
VariableA: Integer;
begin
VariableA := GlobalVariableA;
SubProcedureA;
end;
procedure InitializeWizard;
begin
InitializeWizard1;
InitializeWizard2;
end;
See also Inno Setup - Merging implementations of event functions that return boolean (like InitializeSetup).
So, in your specific case the code should be:
procedure InitializeWizard1;
begin
MessageBoxTimeout(WizardForm.Handle, 'MsgBox ' +
Timeout 'Setup', MB_OK or MB_ICONINFORMATION, 0, 2000);
end;
procedure InitializeWizard2;
var
TuneLabel: TLabel;
begin
ExtractTemporaryFile('tune.xm');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
SoundCtrlButton := TNewButton.Create(WizardForm);
Music := BASS_MusicLoad(False,
ExpandConstant('{tmp}\tune.xm'), 0, 0,
EncodingFlag or BASS_SAMPLE_LOOP, 0);
BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, 10000);
BASS_ChannelPlay(Music, False);
SoundCtrlButton := TNewButton.Create(WizardForm);
SoundCtrlButton.Parent := WizardForm;
SoundCtrlButton.Left := 10;
SoundCtrlButton.TabStop := False;
SoundCtrlButton.Top := WizardForm.ClientHeight -
SoundCtrlButton.Height - 9;
SoundCtrlButton.Width := 40;
SoundCtrlButton.Caption :=
ExpandConstant('{cm:SoundCtrlButtonCaptionSoundOff}');
SoundCtrlButton.OnClick := #SoundCtrlButtonClick;
TuneLabel := TLabel.Create(WizardForm);
TuneLabel.Parent := WizardForm;
TuneLabel.Caption := 'Tune';
TuneLabel.Left := SoundCtrlButton.Left + SoundCtrlButton.Width + ScaleX(5);
TuneLabel.Top :=
SoundCtrlButton.Top + ((SoundCtrlButton.Height - TuneLabel.Height) div 2);
end;
end;
procedure InitializeWizard;
begin
InitializeWizard1;
InitializeWizard2;
end;
If you are using Inno Setup Script #Includes (ISSI), see Implementing event functions InitializeWizard while using ISSI (to add background image) in Inno Setup: Duplicate identifier 'INITIALIZEWIZARD'.

Inno Setup Get progress from .NET Framework 4.5 (or higher) installer to update progress bar position

I am currently installing .NET Framework 4.6.2 as a prerequisite in the PrepareToInstall event function so that I can obtain the exit code, set the NeedsReboot status, or abort if installation fails. My code is below and this is all working fine.
var
PrepareToInstallLabel: TNewStaticText;
PrepareToInstallProgressBar: TNewProgressBar;
intDotNetResultCode: Integer;
CancelWithoutPrompt, AbortInstall: Boolean;
function InitializeSetup(): Boolean;
begin
Result := True;
OverwriteDB := False;
CancelWithoutPrompt := False;
AbortInstall := False;
end;
function PrepareToInstall(var NeedsRestart: Boolean): String;
var
intResultCode: Integer;
strInstallType: String;
begin
if not IsDotNet45Installed and IsWindows7Sp1OrAbove then
begin
HidePrepareToInstallGuiControls;
PrepareToInstallLabel.Caption := 'Installing Microsoft .NET Framework 4.6.2...';
ShowPrepareToInstallGuiControls;
ExtractTemporaryFile('NDP462-KB3151800-x86-x64-AllOS-ENU.exe');
if WizardSilent = True then
begin
strInstallType := '/q';
end
else
begin
strInstallType := '/passive';
end;
Exec(ExpandConstant('{tmp}\NDP462-KB3151800-x86-x64-AllOS-ENU.exe'), strInstallType + ' /norestart', '', SW_SHOW,
ewWaitUntilTerminated, intDotNetResultCode);
if (intDotNetResultCode = 0) or (intDotNetResultCode = 1641) or (intDotNetResultCode = 3010) then
begin
Log('Microsoft .NET Framework 4.6.2 installed successfully.' + #13#10 + 'Exit Code: ' + IntToStr(intDotNetResultCode));
CancelWithoutPrompt := False;
AbortInstall := False;
end
else
begin
if WizardSilent = True then
begin
Log('Microsoft .NET Framework 4.6.2 failed to install.' + #13#10 + 'Exit Code: ' + IntToStr(intDotNetResultCode) + #13#10 + 'Setup aborted.');
end
else
begin
MsgBox('Microsoft .NET Framework 4.6.2 failed to install.' + #13#10 + #13#10 +
'Exit Code: ' + IntToStr(intDotNetResultCode) + #13#10 + #13#10 +
'Setup aborted. Click Next or Cancel to exit, or Back to try again.',
mbCriticalError, MB_OK);
end;
PrepareToInstallProgressBar.Visible := False;
PrepareToInstallLabel.Caption := 'Microsoft .NET Framework 4.6.2 failed to install.' + #13#10 + #13#10 + 'Exit Code: ' + IntToStr(intDotNetResultCode) + #13#10 + #13#10 + 'Setup aborted. Click Next or Cancel to exit, or Back to try again.';
CancelWithoutPrompt := True;
AbortInstall := True;
Abort;
end;
end;
end;
procedure InitializeWizard();
begin
//Define the label for the Preparing to Install page
PrepareToInstallLabel := TNewStaticText.Create(WizardForm);
with PrepareToInstallLabel do
begin
Visible := False;
Parent := WizardForm.PreparingPage;
Left := WizardForm.StatusLabel.Left;
Top := WizardForm.StatusLabel.Top;
end;
//Define Progress Bar for the Preparing to Install Page
PrepareToInstallProgressBar := TNewProgressBar.Create(WizardForm);
with PrepareToInstallProgressBar do
begin
Visible := False;
Parent := WizardForm.PreparingPage;
Left := WizardForm.ProgressGauge.Left;
Top := WizardForm.ProgressGauge.Top;
Width := WizardForm.ProgressGauge.Width;
Height := WizardForm.ProgressGauge.Height;
PrepareToInstallProgressBar.Style := npbstMarquee;
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
if AbortInstall = True then
begin
Abort;
end;
end;
end;
At the moment, I am setting the installation type to either silent or unattended using /q or /passive to control the amount of visible GUI the .NET Framework installer displays, depending on how Inno Setup is running and using a Marquee style progress bar to indicate that something is happening. However, from the Microsoft documentation here, it appears that it is possible to get the .NET Framework installer to report it's install progress back, using the /pipe switch, which might allow it to interactively update a normal style progress bar on the actual progress. This would mean that the .NET Framework installer could be hidden completely and Inno Setup used to indicate the relative progress, which is a much tidier solution. Unfortunately, I do not know C++ and am only a novice programmer. Therefore, can anyone confirm if this is possible to do with Inno Setup and, if so, how it might be attempted?
The following shows Pascal Script implementation of the code from
How to: Get Progress from the .NET Framework 4.5 Installer
[Files]
Source: "NDP462-KB3151800-x86-x64-AllOS-ENU.exe"; Flags: dontcopy
[Code]
// Change to unique names
const
SectionName = 'MyProgSetup';
EventName = 'MyProgSetupEvent';
const
INFINITE = 65535;
WAIT_OBJECT_0 = 0;
WAIT_TIMEOUT = $00000102;
FILE_MAP_WRITE = $0002;
E_PENDING = $8000000A;
S_OK = 0;
MMIO_V45 = 1;
MAX_PATH = 260;
SEE_MASK_NOCLOSEPROCESS = $00000040;
INVALID_HANDLE_VALUE = -1;
PAGE_READWRITE = 4;
MMIO_SIZE = 65536;
type
TMmioDataStructure = record
DownloadFinished: Boolean; // download done yet?
InstallFinished: Boolean; // install done yet?
DownloadAbort: Boolean; // set downloader to abort
InstallAbort: Boolean; // set installer to abort
DownloadFinishedResult: Cardinal; // resultant HRESULT for download
InstallFinishedResult: Cardinal; // resultant HRESULT for install
InternalError: Cardinal;
CurrentItemStep: array[0..MAX_PATH-1] of WideChar;
DownloadSoFar: Byte; // download progress 0 - 255 (0 to 100% done)
InstallSoFar: Byte; // install progress 0 - 255 (0 to 100% done)
// event that chainer 'creates' and chainee 'opens'to sync communications
EventName: array[0..MAX_PATH-1] of WideChar;
Version: Byte; // version of the data structure, set by chainer.
// 0x0 : .Net 4.0
// 0x1 : .Net 4.5
// current message being sent by the chainee, 0 if no message is active
MessageCode: Cardinal;
// chainer's response to current message, 0 if not yet handled
MessageResponse: Cardinal;
// length of the m_messageData field in bytes
MessageDataLength: Cardinal;
// variable length buffer, content depends on m_messageCode
MessageData: array[0..MMIO_SIZE] of Byte;
end;
function CreateFileMapping(
File: THandle; Attributes: Cardinal; Protect: Cardinal;
MaximumSizeHigh: Cardinal; MaximumSizeLow: Cardinal; Name: string): THandle;
external 'CreateFileMappingW#kernel32.dll stdcall';
function CreateEvent(
EventAttributes: Cardinal; ManualReset: Boolean; InitialState: Boolean;
Name: string): THandle;
external 'CreateEventW#kernel32.dll stdcall';
function CreateMutex(
MutexAttributes: Cardinal; InitialOwner: Boolean; Name: string): THandle;
external 'CreateMutexW#kernel32.dll stdcall';
function WaitForSingleObject(
Handle: THandle; Milliseconds: Cardinal): Cardinal;
external 'WaitForSingleObject#kernel32.dll stdcall';
function MapViewOfFile(
FileMappingObject: THandle; DesiredAccess: Cardinal; FileOffsetHigh: Cardinal;
FileOffsetLow: Cardinal; NumberOfBytesToMap: Cardinal): Cardinal;
external 'MapViewOfFile#kernel32.dll stdcall';
function ReleaseMutex(Mutex: THandle): Boolean;
external 'ReleaseMutex#kernel32.dll stdcall';
type
TShellExecuteInfo = record
cbSize: DWORD;
fMask: Cardinal;
Wnd: HWND;
lpVerb: string;
lpFile: string;
lpParameters: string;
lpDirectory: string;
nShow: Integer;
hInstApp: THandle;
lpIDList: DWORD;
lpClass: string;
hkeyClass: THandle;
dwHotKey: DWORD;
hMonitor: THandle;
hProcess: THandle;
end;
function ShellExecuteEx(var lpExecInfo: TShellExecuteInfo): BOOL;
external 'ShellExecuteExW#shell32.dll stdcall';
function GetExitCodeProcess(Process: THandle; var ExitCode: Cardinal): Boolean;
external 'GetExitCodeProcess#kernel32.dll stdcall';
procedure CopyPointerToData(
var Destination: TMmioDataStructure; Source: Cardinal; Length: Cardinal);
external 'RtlMoveMemory#kernel32.dll stdcall';
procedure CopyDataToPointer(
Destination: Cardinal; var Source: TMmioDataStructure; Length: Cardinal);
external 'RtlMoveMemory#kernel32.dll stdcall';
var
FileMapping: THandle;
EventChaineeSend: THandle;
EventChainerSend: THandle;
Mutex: THandle;
Data: TMmioDataStructure;
View: Cardinal;
procedure LockDataMutex;
var
R: Cardinal;
begin
R := WaitForSingleObject(Mutex, INFINITE);
Log(Format('WaitForSingleObject = %d', [Integer(R)]));
if R <> WAIT_OBJECT_0 then
RaiseException('Error waiting for mutex');
end;
procedure UnlockDataMutex;
var
R: Boolean;
begin
R := ReleaseMutex(Mutex);
Log(Format('ReleaseMutex = %d', [Integer(R)]));
if not R then
RaiseException('Error releasing waiting for mutex');
end;
procedure ReadData;
begin
CopyPointerToData(Data, View, MMIO_SIZE);
end;
procedure WriteData;
begin
CopyDataToPointer(View, Data, MMIO_SIZE);
end;
procedure InitializeChainer;
var
I: Integer;
begin
Log('Initializing chainer');
FileMapping :=
CreateFileMapping(
INVALID_HANDLE_VALUE, 0, PAGE_READWRITE, 0, MMIO_SIZE, SectionName);
Log(Format('FileMapping = %d', [Integer(FileMapping)]));
if FileMapping = 0 then
RaiseException('Error creating file mapping');
EventChaineeSend := CreateEvent(0, False, False, EventName);
Log(Format('EventChaineeSend = %d', [Integer(EventChaineeSend)]));
if EventChaineeSend = 0 then
RaiseException('Error creating chainee event');
EventChainerSend := CreateEvent(0, False, False, EventName + '_send');
Log(Format('EventChainerSend = %d', [Integer(EventChainerSend)]));
if EventChainerSend = 0 then
RaiseException('Error creating chainer event');
Mutex := CreateMutex(0, False, EventName + '_mutex');
Log(Format('Mutex = %d', [Integer(Mutex)]));
if Mutex = 0 then
RaiseException('Error creating mutex');
View :=
MapViewOfFile(FileMapping, FILE_MAP_WRITE, 0, 0, 0);
if View = 0 then
RaiseException('Cannot map data view');
Log('Mapped data view');
LockDataMutex;
ReadData;
Log('Initializing data');
for I := 1 to Length(EventName) do
Data.EventName[I - 1] := EventName[I];
Data.EventName[Length(EventName)] := #$00;
// Download specific data
Data.DownloadFinished := False;
Data.DownloadSoFar := 0;
Data.DownloadFinishedResult := E_PENDING;
Data.DownloadAbort := False;
// Install specific data
Data.InstallFinished := False;
Data.InstallSoFar := 0;
Data.InstallFinishedResult := E_PENDING;
Data.InstallAbort := False;
Data.InternalError := S_OK;
Data.Version := MMIO_V45;
Data.MessageCode := 0;
Data.MessageResponse := 0;
Data.MessageDataLength := 0;
Log('Initialized data');
WriteData;
UnlockDataMutex;
Log('Initialized chainer');
end;
var
ProgressPage: TOutputProgressWizardPage;
procedure InstallNetFramework;
var
R: Cardinal;
ExecInfo: TShellExecuteInfo;
ExitCode: Cardinal;
InstallError: string;
Completed: Boolean;
Progress: Integer;
begin
ExtractTemporaryFile('NDP462-KB3151800-x86-x64-AllOS-ENU.exe');
// Start the installer using ShellExecuteEx to get process ID
ExecInfo.cbSize := SizeOf(ExecInfo);
ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
ExecInfo.Wnd := 0;
ExecInfo.lpFile :=
ExpandConstant('{tmp}\NDP462-KB3151800-x86-x64-AllOS-ENU.exe');
ExecInfo.lpParameters :=
'/pipe ' + SectionName + ' /chainingpackage mysetup /q';
ExecInfo.nShow := SW_HIDE;
if not ShellExecuteEx(ExecInfo) then
RaiseException('Cannot start .NET framework installer');
Log(Format('.NET framework installer started as process %x', [
ExecInfo.hProcess]));
Progress := 0;
ProgressPage.SetProgress(Progress, 100);
ProgressPage.Show;
try
Completed := False;
while not Completed do
begin
// Check if the installer process has finished already
R := WaitForSingleObject(ExecInfo.hProcess, 0);
if R = WAIT_OBJECT_0 then
begin
Log('.NET framework installer completed');
Completed := True;
if not GetExitCodeProcess(ExecInfo.hProcess, ExitCode) then
begin
InstallError := 'Cannot get .NET framework installer exit code';
end
else
begin
Log(Format('Exit code: %d', [Integer(ExitCode)]));
if ExitCode <> 0 then
begin
InstallError :=
Format('.NET framework installer failed with exit code %d', [
ExitCode]);
end;
end;
end
else
if R <> WAIT_TIMEOUT then
begin
InstallError := 'Error waiting for .NET framework installer to complete';
Completed := True;
end
else
begin
// Check if the installer process has signaled progress event
R := WaitForSingleObject(EventChaineeSend, 0);
if R = WAIT_OBJECT_0 then
begin
Log('Got event from the installer');
{ Read progress data }
LockDataMutex;
ReadData;
Log(Format(
'DownloadSoFar = %d, InstallSoFar = %d', [
Data.DownloadSoFar, Data.InstallSoFar]));
Progress := Integer(Data.InstallSoFar) * 100 div 255;
Log(Format('Progress = %d', [Progress]));
UnlockDataMutex;
ProgressPage.SetProgress(Progress, 100);
end
else
if R <> WAIT_TIMEOUT then
begin
InstallError := 'Error waiting for .NET framework installer event';
Completed := True;
end
else
begin
// Seemingly pointless as progress did not change,
// but it pumps a message queue as a side effect
ProgressPage.SetProgress(Progress, 100);
Sleep(100);
end;
end;
end;
finally
ProgressPage.Hide;
end;
if InstallError <> '' then
begin
// RaiseException does not work properly
// while TOutputProgressWizardPage is shown
RaiseException(InstallError);
end;
end;
function InitializeSetup(): Boolean;
begin
InitializeChainer;
Result := True;
end;
procedure InitializeWizard();
begin
ProgressPage := CreateOutputProgressPage('Installing .NET framework', '');
end;
You can use it like below, or on any other place of your installer process.
function NextButtonClick(CurPageID: Integer): Boolean;
begin
Result := True;
if CurPageID = wpReady then
begin
try
InstallNetFramework;
except
MsgBox(GetExceptionMessage, mbError, MB_OK);
Result := False;
end;
end;
end;
The following screenshot shows how the "progress page" in Inno Setup is linked to the .NET framework installer (of course the .NET framework installer is hidden by the /q switch, it was just temporarily shown for purposes of obtaining the screenshot).
I've successfully tested the code on
dotnetfx45_full_x86_x64.exe (.NET framework 4.5 - off-line installer)
NDP462-KB3151800-x86-x64-AllOS-ENU.exe (.NET framework 4.6.2 - off-line installer)
Note that the code takes into account the InstallSoFar only as both installers above are off-line. For on-line installers, DownloadSoFar should be taken into account too. And actually even off-line installers do sometime download something.
The ShellExecuteEx code taken from Inno Setup Exec() function Wait for a limited time.

multithread downloadstring delphi

Function
function DownloadString(AUrl: string): string;
var
LHttp: TIdHttp;
begin
LHttp := TIdHTTP.Create;
try
LHttp.HandleRedirects := true;
result := LHttp.Get('http://127.0.0.1/a.php?n='+AUrl);
finally
LHttp.Free;
end;
end;
Boot
procedure TForm1.Button1Click(Sender: TObject);
var
LUrlArray: TArray<String>;
begin
LUrlArray := form1.listbox1.Items.ToStringArray;
TThread.CreateAnonymousThread(
procedure
var
LResult: string;
LUrl: string;
begin
for LUrl in LUrlArray do
begin
LResult := DownloadString(LUrl);
TThread.Synchronize(nil,
procedure
begin
if Pos('DENEGADA',LResult)>0 then
begin
Memo1.Lines.Add(LResult);
end
else
begin
Memo1.Lines.Add(LResult + 'DIE');
end;
end
);
end;
end
).Start;
end;
Listbox Lines
http://127.0.0.1/a.php?n=4984
http://127.0.0.1/a.php?n=4986
http://127.0.0.1/a.php?n=4989
in this case only one thread will download all URL's content but I would like to make it creates a thread for each item...
example:
thread1 - check item1 listbox - http://127.0.0.1/a.php?n=4984
thread2 - check next item 4986
thread3 - check next item 4989
how make this? Is there any way to do this ?, I believe that this method will be more effective.
In order to create separate threads, you have to bind the url variable value like this:
procedure TForm1.Button1Click(Sender: TObject);
var
LUrlArray: TArray<String>;
LUrl: String;
function CaptureThreadTask(const s: String) : TProc;
begin
Result :=
procedure
var
LResult : String;
begin
LResult := DownloadString(s);
TThread.Synchronize(nil,
procedure
begin
if Pos('DENEGADA',LResult)>0 then
begin
Memo1.Lines.Add(LResult);
end
else
begin
Memo1.Lines.Add(LResult + 'DIE');
end;
end
);
end;
end;
begin
LUrlArray := form1.listbox1.Items.ToStringArray;
for LUrl in LUrlArray do
// Bind variable LUrl value like this
TThread.CreateAnonymousThread( CaptureThreadTask(LUrl)
).Start;
end;
See Anonymous Methods Variable Binding
You can try using ForEach pattern of omnithreadlibrary :
http://otl.17slon.com/book/chap04.html#highlevel-foreach
http://otl.17slon.com/book/chap04.html#leanpub-auto-iomniblockingcollection
Draft is like that:
TMyForm = class(TForm)
private
DownloadedStrings: iOmniBlockingCollection;
published
DownloadingProgress: TTimer;
MemoSourceURLs: TMemo;
MemoResults: TMemo;
...
published
procedure DownloadingProgressOnTimer( Sender: TObject );
procedure StartButtonClick ( Sender: TObject );
.....
private
property InDownloadProcess: boolean write SetInDownloadProcess;
procedure FlushCollectedData;
end;
procedure TMyForm.StartButtonClick ( Sender: TObject );
begin
DownloadedStrings := TOmniBlockingCollection.Create;
Parallel.ForEach<string>(MemoSourceURLs.Lines)
.NumTasks(10) // we do not want to overload computer by millions of threads when given a long list. We are not "fork bomb"
// .PreserveOrder - usually not a needed option
.Into(DownloadedStrings) // - or you would have to manually seal the container by calling .CompleteAdding AFTER the loop is over in .OnStop option
.NoWait
.Execute(
procedure (const URL: string; var res: TOmniValue)
var Data: string; Success: Boolean;
begin
if my_IsValidUrl(URL) then begin
Success := my_DownloadString( URL, Data);
if Success and my_IsValidData(Data) then begin
if ContainsText(Data, 'denegada') then
Data := Data + ' DIE';
res := Data;
end;
end
);
InDownloadProcess := true;
end;
procedure TMyForm.SetInDownloadProcess(const process: Boolean);
begin
if process then begin
StartButton.Hide;
Prohibit-Form-Closing := true;
MemoSourceURLs.ReadOnly := true;
MemoResults.Clear;
with DownloadingProgress do begin
Interval := 333; // update data in form 3 times per second - often enough
OnTimer := DownloadingProgressOnTimer;
Enabled := True;
end;
end else begin
DownloadingProgress.Enabled := false;
if nil <> DownloadedStrings then
FlushCollectedData; // one last time
Prohibit-Form-Closing := false;
MemoSourceURLs.ReadOnly := false;
StartButton.Show;
end;
end;
procedure TMyForm.FlushCollectedData;
var s: string; value: TOmniValue;
begin
while DownloadedStrings.TryTake(value) do begin
s := value;
MemoResults.Lines.Add(s);
end;
PostMessage( MemoResults.Handle, .... ); // not SendMessage, not Perform
// I do not remember, there was something very easy to make the memo auto-scroll to the last line added
end;
procedure TMyForm.DownloadingProgressOnTimer( Sender: TObject );
begin
if nil = DownloadedStrings then begin
InDownloadProcess := false;
exit;
end;
FlushCollectedData;
if DownloadedStrings.IsCompleted then begin
InDownloadProcess := false; // The ForEach loop is over, everything was downloaded
DownloadedStrings := nil; // free memory
end;
end;
http://docwiki.embarcadero.com/Libraries/XE4/en/System.StrUtils.ContainsText
http://docwiki.embarcadero.com/Libraries/Seattle/en/Vcl.ExtCtrls.TTimer_Properties
PS. note that the online version of the book is old, you perhaps would have to update it to features in the current version of the omnithreadlibrarysources.
PPS: your code has a subtle error:
for LUrl in LUrlArray do
begin
LResult := DownloadString(LUrl);
Given your implementation of DownloadString that means in the case of HTTP error your function would re-return the previous value of LResult again and again and again and.... until the no-error downloading happened.
That is why I changed your function definition to be clear when error happens and no output data is given.

Resources