Is there a way to prevent installation if a reboot/restart is already pending/required?
Our setup installs SQL Server Express and it will sometimes refuse to do so if there is a pending restart in the system. Can Inno Setup detect this condition so I can tell the user to reboot before installing our software?
I know about MakePendingFileRenameOperationsChecksum but it's usually mentioned to detect whether the reboot required condition appeared DURING the setup. Can it be used BEFORE?
If you want to detect, if there is a pending rename that requires a restart, query PendingFileRenameOperations registry value.
See also How to find out if an MSI I just installed requested a Windows reboot?
function IsRestartPending: Boolean;
var
S: string;
begin
if RegQueryMultiStringValue(
HKLM, 'SYSTEM\CurrentControlSet\Control\Session Manager',
'PendingFileRenameOperations', S) then
begin
Log(Format('PendingFileRenameOperations value exists with value [%s]', [S]));
Result := (Trim(S) <> ''); { This additional check is probably not needed }
end
else
begin
Log('PendingFileRenameOperations value does not exist');
Result := False;
end;
end;
function InitializeSetup(): Boolean;
begin
if IsRestartPending then
begin
MsgBox('Restart your machine please', mbError, MB_OK);
Result := False;
Exit;
end;
Result := True;
end;
If you need to test for other actions that may need restart, you will have to adapt the answer by #Jerry for Inno Setup.
The other accepted answer only covered one scenario. However, there are actually numerous different scenarios to check. I found this article describing all the different registry things to check, and wrote a function around it. This is actually in Delphi, but should be easily implemented in Inno Setup as well. In fact, part of it I got from here, which was in Inno Setup, for checking valid GUID.
Please note that this generally checks for pending Windows updates, which may not necessarily be desired. You can modify it and remove those checks you don't wish to perform for your purpose. The second and third checks for PendingFileRenameOperations actually appear not necessary for SQL Server.
const
S_OK = $00000000;
CO_E_CLASSSTRING = $800401F3;
type
LPCLSID = TGUID;
LPCOLESTR = WideString;
function CLSIDFromString(lpsz: LPCOLESTR; pclsid: LPCLSID): HRESULT;
stdcall; external 'ole32.dll';
function IsValidGuid(const Value: string): Boolean;
var
GUID: LPCLSID;
RetVal: HRESULT;
begin
RetVal := CLSIDFromString(LPCOLESTR(Value), GUID);
Result := RetVal = S_OK;
if not Result and (RetVal <> CO_E_CLASSSTRING) then
OleCheck(RetVal);
end;
function IsRestartPending(const RestartOnly: Boolean = True): Boolean;
var
R: TRegistry;
L: TStringList;
X: Integer;
T: String;
begin
R:= TRegistry.Create(KEY_READ);
try
L:= TStringList.Create;
try
Result:= False;
R.RootKey:= HKEY_LOCAL_MACHINE;
if R.OpenKey('SOFTWARE\Microsoft\Updates', False) then begin
try
if R.ValueExists('UpdateExeVolatile') then begin
if R.ReadInteger('UpdateExeVolatile') <> 0 then
Result:= True;
end;
finally
R.CloseKey;
end;
end;
if not RestartOnly then begin
//These next 2 checks are not necessary for a SQL Server installation.
if not Result then begin
if R.OpenKey('SYSTEM\CurrentControlSet\Control\Session Manager', False) then begin
try
Result:= R.ValueExists('PendingFileRenameOperations');
finally
R.CloseKey;
end;
end;
end;
if not Result then begin
if R.OpenKey('SYSTEM\CurrentControlSet\Control\Session Manager', False) then begin
try
Result:= R.ValueExists('PendingFileRenameOperations2');
finally
R.CloseKey;
end;
end;
end;
end;
if not Result then begin
Result:= R.KeyExists('SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\RebootRequired');
end;
if not Result then begin
if R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Services\Pending', False) then begin
try
L.Clear;
R.GetKeyNames(L);
for X := 0 to L.Count-1 do begin
if IsValidGuid(L[X]) then begin
Result:= True;
Break;
end;
end;
finally
R.CloseKey;
end;
end;
end;
if not Result then begin
Result:= R.KeyExists('SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update\PostRebootReporting');
end;
if not Result then begin
if R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce', False) then begin
try
Result:= R.ValueExists('DVDRebootSignal');
finally
R.CloseKey;
end;
end;
end;
if not Result then begin
Result:= R.KeyExists('Software\Microsoft\Windows\CurrentVersion\Component Based Servicing\RebootPending');
end;
if not Result then begin
Result:= R.KeyExists('Software\Microsoft\Windows\CurrentVersion\Component Based Servicing\RebootInProgress');
end;
if not Result then begin
Result:= R.KeyExists('Software\Microsoft\Windows\CurrentVersion\Component Based Servicing\PackagesPending');
end;
if not Result then begin
Result:= R.KeyExists('SOFTWARE\Microsoft\ServerManager\CurrentRebootAttempts');
end;
if not Result then begin
if R.OpenKey('SYSTEM\CurrentControlSet\Services\Netlogon', False) then begin
try
Result:= R.ValueExists('JoinDomain');
finally
R.CloseKey;
end;
end;
end;
if not Result then begin
if R.OpenKey('SYSTEM\CurrentControlSet\Services\Netlogon', False) then begin
try
Result:= R.ValueExists('AvoidSpnSet');
finally
R.CloseKey;
end;
end;
end;
if not Result then begin
if R.OpenKey('SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName', False) then begin
try
T:= R.ReadString('ComputerName');
finally
R.CloseKey;
end;
end;
if R.OpenKey('SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName', False) then begin
try
if R.ReadString('ComputerName') <> T then
Result:= True;
finally
R.CloseKey;
end;
end;
end;
finally
L.Free;
end;
finally
R.Free;
end;
end;
Related
i used a httpd to request some data from internet
function requestToServer(lParamList: TStringList) : string;
var
userDataString : string;
lHTTP: TIdHTTP;
serverResponce : string;
aobj: ISuperObject;
begin
application.ProcessMessages;
TThread.CreateAnonymousThread(
procedure
begin
lHTTP := TIdHTTP.Create(nil);
try
serverResponce := lHTTP.Post('http://domain.com/mjson.php', lParamList);
application.ProcessMessages;
aobj:= SO(serverResponce);
try
X := aobj['dta'].AsArray;
Except
form2.Memo1.Lines.Add('errr');
end;
if aobj['result'].AsString = 'lr_102' then
begin
form2.Label3.Text:='Saved token expired.';
form2.Rectangle2.Visible:=true;
end
else if aobj['result'].AsString = 'lr_103' then
begin
form2.Label3.Text:='Auto login.';
//load device data
form2.allDeviceListData := X;
form2.Hide;
form1.show;
end;
// globalReachedServer:=true;
finally
lHTTP.Free;
lParamList.Free;
end;
TThread.Synchronize(nil,
procedure
begin
end);
end
).Start();
end;
but after reach this function
the application show a black page and dont do anything until manually close
how can i do a web request at the background and with out hanging on fire-monkey !?
what a bout using REST is it better to access web service's?
Your code is not thread-safe. Your thread is directly accessing UI controls without synchronizing with the main UI thread. That alone can cause problems.
Also, all of the variables declared in the var section of requestToServer() should be moved into the var section of the anonymous procedure instead, since requestToServer() does not use them, so they can be completely local to the thread instead. The only thing the anonymous procedure should be capturing is the lParamList content.
Try something more like this:
function requestToServer(lParamList: TStringList) : string;
var
Params: TStringList;
Thread: TThread;
begin
Params := TStringList.Create;
try
Params.Assign(lParamList);
except
Params.Free;
raise;
end;
TThread.CreateAnonymousThread(
procedure
var
lHTTP: TIdHTTP;
serverResponce : string;
aObj: ISuperObject;
begin
try
try
lHTTP := TIdHTTP.Create(nil);
try
serverResponce := lHTTP.Post('http://domain.com/mjson.php', lParamList);
aObj := SO(serverResponce);
if aObj['result'].AsString = 'lr_102' then
begin
TThread.Queue(nil,
procedure
begin
form2.Label3.Text := 'Saved token expired.';
form2.Rectangle2.Visible := true;
end
);
end
else if aObj['result'].AsString = 'lr_103' then
begin
X := aObj['dta'].AsArray;
TThread.Queue(nil,
procedure
begin
form2.Label3.Text := 'Auto login.';
//load device data
form2.allDeviceListData := X;
form2.Hide;
form1.show;
end
);
end;
// globalReachedServer := true;
finally
lHTTP.Free;
end;
finally
Params.Free;
end;
except
TThread.Queue(nil,
procedure
begin
form2.Memo1.Lines.Add('errr');
end
);
end;
end
).Start;
end;
I am new to delphi, I need to write an ftp client program that will go through a text file with list of ftp addresses, and download the subfolders from an ftp site .
I have successfully hooked to the server but got stuck on the download part. can someone please help me with the codes to insert in the download procedure
procedure TCleint.btnConnectClick(Sender: TObject);
begin
try
if not IdFTP.Connected then
begin
IdFTP.Host := 'ftp server';
IdFTP.Username := 'anonymous';
IdFTP.Password := 'emailaddress';
IdFTP.Port := 21;
IdFTP.Connect;
IdFTP.List(listaDirectory.Items, '', false);
btnConnect.Enabled := False;
btnDisconnect.Enabled := True;
btnDownload.Enabled := True;
end;
except
on E:Exception do
begin
MessageDlg('connection error!', mtError, [mbOK], 0);
btnConnect.Enabled := true;
btnDisconnect.Enabled := false;
btnDownload.Enabled := false;
end;
end;
end;
procedure TCleint.btnDisconnectClick(Sender: TObject);
begin
try
if IdFTP.Connected then
begin
IdFTP.Disconnect;
listaDirectory.Clear;
btnConnect.Enabled := True;
btnDisconnect.Enabled := False;
btnDownload.Enabled := False;
end;
except
on E:Exception do
begin
MessageDlg('connection error!', mtError, [mbOK], 0);
btnConnect.Enabled := false;
btnDisconnect.Enabled := true;
btnDownload.Enabled := true;
end;
end;
end;
procedure TCleint.btnDownloadClick(Sender: TObject);
begin
end;
end.
After calling List(), you need to loop through the entries of the DirectoryListing property. That will tell you which items are files and which are subfolders. You can then Get() the files and (recursively) ChangeDir()/List() the subfolders.
Maybe there is something that I missed, I can't figure what is happening here.
I'm trying to load the same DLL in multiple instances of a TThread Object.
Here is my DLL code:
library MyCalcFor32;
uses
SysUtils,
Classes,
uRunner in 'uRunner.pas';
Exports EVal;
{$R *.res}
begin
end.
This is the uRunner.pas:
unit uRunner;
interface
uses SysUtils,
Classes;
function EVal(Valor: WideString): WideString; stdcall; export;
implementation
function EVal(Value: WideString): WideString; stdcall; export;
begin
Result := Value+' xxx';
end;
initialization
finalization
end.
This is the program to Load the DLL:
procedure TfrmMain.FormCreate(Sender: TObject);
var I: Integer;
begin
SetLength(Threads, 10);
for I:= 0 to 9 do
begin
Threads[I] := TWorker.Create(Self.Handle, I+1, Memo1.Text, ExtractFilePath(ParamStr(0)));
end;
end;
procedure TfrmMain.btnExecuteThreadsClick(Sender: TObject);
var I: Integer;
begin
ClearMemos([MT1, MT2, MT3, MT4, MT5, MT6, MT7, MT8, MT9, MT10]);
for I:= 0 to 0 do //to 9, for multiple
begin
if Threads[I].Suspended then
Threads[I].Resume
else
ShowMessage('Thread already in execution');
end;
end;
procedure TWorker.Execute;
var I: Integer;
J: Cardinal;
Ret: WideString;
A,B,C: Extended;
begin
CoInitialize(nil);
try
LoadDll;
while not Terminated do
begin
if not (Suspended or Terminated) then
begin
A := 310132041025;
B := 17592186044416;
C := 0;
for I:= 0 to 10 do
begin
if (Terminated) then begin
Break;
end;
for J:= 0 to 9999999 do
begin
if (Terminated) then begin
Break;
end;
A:= Sqrt(A);
if A <= 0 then begin
A:= 310132041025;
end
else begin
A:= Math.Power(A, 2);
end;
C:= C + (B-34 / 4);
B:= B / 2;
if B <= 0 then begin
B:= 17592186044416;
end;
end;
Ret := FEvalProcAddress(FEValValue);
NotifyMainForm(Format('Evaluate %s, resulted in %s', [IntToStr(I), Ret]));
end;
Suspend;
end;
Sleep(5000);
end;
finally
CoUninitialize;
end;
end;
procedure TWorker.LoadDll;
begin
//GlobalLock.Enter;
//try
FDLLHandle := LoadLibraryA(PChar(FPathApp + 'MyCalcFor32.dll'));
//finally
// GlobalLock.Leave;
//end;
if GetLastError <> 0 then
begin
NotifyTerminateThread;
end
else
begin
FEvalProcAddress := GetProcAddress(FDLLHandle, PChar('EVal'));
if GetLastError <> 0 then
begin
NotifyTerminateThread;
end;
end;
end;
When I have only 1 thread, it works just fine, but when I use multiple threads It raises the following exception:
System Error. Code: 87.
Incorrect Parameter
Note: The above code is just for reproduction;
I am aware of WideString + AnsiString problem.
You are performing the error checking incorrectly. You are only meant to call GetLastError if the function fails. I expect that you are calling GetLastError after an API call that succeeded and not all API calls do SetLastError(0) when they return success. So you are picking up a stale error code that does not apply to the function call that you made.
To check for failure, for these functions, you need to examine the return value.
LoadLibrary reports failure by returning 0.
GetProcAddress reports failure by returning nil.
You have to read the documentation of the functions carefully, but this is a very common theme. Each Win32 API function may potentially handle errors differently. Read the docs for each function individually.
I need my installer to check if a file exists in the destination location, and if is not there, then the installation aborts. My project is a update patch, so I want the installer to avoid installing the update files if the main exe of the application is not in the destination. How can I do this?
Can someone give an example of code to check file version through the Windows registry?
[Files]
Source C:\filename.exe; DestDir {app}; Flags: ignoreversion; BeforeInstall: CheckForFile;
[code]
procedure CheckForFile(): Boolean;
begin
if (FileExists('c:\somefile.exe')) then
begin
MsgBox('File exists, install continues', mbInformation, MB_OK);
Result := True;
end
else
begin
MsgBox('File does not exist, install stops', mbCriticalError, MB_OK);
Result := False;
end;
end;
Just don't let the user proceed until they pick the correct folder.
function NextButtonClick(PageId: Integer): Boolean;
begin
Result := True;
if (PageId = wpSelectDir) and not FileExists(ExpandConstant('{app}\yourapp.exe')) then begin
MsgBox('YourApp does not seem to be installed in that folder. Please select the correct folder.', mbError, MB_OK);
Result := False;
exit;
end;
end;
Of course, it's also a good idea to try to automatically pick the correct folder for them, eg. by retrieving the correct location out of the registry.
Another solution would be the InitializeSetup():
Credit: Manfred
[code]
function InitializeSetup(): Boolean;
begin
if (FileExists(ExpandConstant('{pf}\{#MyAppName}\somefile.exe'))) then
begin
MsgBox('Installation validated', mbInformation, MB_OK);
Result := True;
end
else
begin
MsgBox('Abort installation', mbCriticalError, MB_OK);
Result := False;
end;
end;
Is there any way to know which verion of Windows we are working on?
I need to set image to TBitButton in Windows XP and no image in Windows7. It should be done automatically.
Check the SysUtils.Win32MajorVersion (in Delphi 7, you'll need to add SysUtils to your uses clause if it's not there already - later versions add it automatically). The easiest way is to assign the Glyph as usual in the IDE, and clear it if you're running on Vista or higher:
if SysUtils.Win32MajorVersion >= 6 then // Windows Vista or higher
BitBtn1.Glyph := nil;
For more info on detecting specific Windows editions and versions, see this post. It hasn't been updated for the latest Windows versions and editions, but it'll get you started. You can also search SO for [delphi] GetVersionEx to see other examples.
This is actually a little project of mine - a drop-in component which provides info of the operating system - even preview it in design-time...
unit JDOSInfo;
interface
uses
Classes, Windows, SysUtils, StrUtils, Forms, Registry;
type
TJDOSInfo = class(TComponent)
private
fReg: TRegistry;
fKey: String;
fMinor: Integer;
fMajor: Integer;
fBuild: Integer;
fPlatform: Integer;
fIsServer: Bool;
fIs64bit: Bool;
fProductName: String;
function GetProductName: String;
procedure SetProductName(Value: String);
procedure SetMajor(Value: Integer);
procedure SetMinor(Value: Integer);
procedure SetBuild(Value: Integer);
procedure SetPlatform(Value: Integer);
procedure SetIs64Bit(const Value: Bool);
procedure SetIsServer(const Value: Bool);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Major: Integer read fMajor write SetMajor;
property Minor: Integer read fMinor write SetMinor;
property Build: Integer read fBuild write SetBuild;
property Platf: Integer read fPlatform write SetPlatform;
property ProductName: String read GetProductName write SetProductName;
property IsServer: Bool read fIsServer write SetIsServer;
property Is64Bit: Bool read fIs64bit write SetIs64Bit;
end;
function IsWOW64: Boolean;
function GetOSInfo: TOSVersionInfo;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('JD Custom', [TJDOSInfo]);
end;
function GetOSInfo: TOSVersionInfo;
begin
FillChar(Result, SizeOf(Result), 0);
Result.dwOSVersionInfoSize := SizeOf(Result);
if not GetVersionEx(Result) then
raise Exception.Create('Error calling GetVersionEx');
end;
function IsWOW64: Boolean;
type
TIsWow64Process = function( // Type of IsWow64Process API fn
Handle: THandle;
var Res: BOOL): BOOL; stdcall;
var
IsWow64Result: BOOL; // result from IsWow64Process
IsWow64Process: TIsWow64Process; // IsWow64Process fn reference
begin
// Try to load required function from kernel32
IsWow64Process:= GetProcAddress(GetModuleHandle('kernel32'),'IsWow64Process');
if Assigned(IsWow64Process) then
begin
// Function is implemented: call it
if not IsWow64Process(GetCurrentProcess, IsWow64Result) then
raise Exception.Create('Bad process handle');
// Return result of function
Result := IsWow64Result;
end else
// Function not implemented: can't be running on Wow64
Result:= False;
end;
constructor TJDOSInfo.Create(AOwner: TComponent);
var
Info: TOSVersionInfo;
Str: String;
begin
inherited Create(AOwner);
fReg:= TRegistry.Create(KEY_READ);
fReg.RootKey:= HKEY_LOCAL_MACHINE;
fKey:= 'Software\Microsoft\Windows NT\CurrentVersion';
fReg.OpenKey(fKey, False);
Info:= GetOSInfo;
fMajor:= Info.dwMajorVersion;
fMinor:= Info.dwMinorVersion;
fBuild:= Info.dwBuildNumber;
fIsServer:= False;
fIs64bit:= False;
fPlatform:= Info.dwPlatformId;
if fMajor >= 5 then begin
//After 2000
if fReg.ValueExists('ProductName') then
Str:= fReg.ReadString('ProductName')
else begin
Str:= 'Unknown OS: '+IntToStr(fMajor)+'.'+IntToStr(fMinor)+'.'+
IntToStr(fBuild)+'.'+IntToStr(fPlatform);
end;
if fReg.ValueExists('InstallationType') then begin
if UpperCase(fReg.ReadString('InstallationType')) = 'SERVER' then
fIsServer:= True;
end;
fIs64bit:= IsWOW64;
if fIs64bit then
Str:= Str + ' 64 Bit';
end else begin
//Before 2000
case fMajor of
4: begin
case fMinor of
0: Str:= 'Windows 95';
10: Str:= 'Windows 98';
90: Str:= 'Windows ME';
end;
end;
else begin
Str:= 'Older than 95';
end;
end;
end;
Self.fProductName:= Str;
end;
destructor TJDOSInfo.Destroy;
begin
if assigned(fReg) then begin
if fReg.Active then
fReg.CloseKey;
fReg.Free;
end;
inherited Destroy;
end;
function TJDOSInfo.GetProductName: String;
begin
Result:= Self.fProductName;
end;
procedure TJDOSInfo.SetProductName(Value: String);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetMinor(Value: Integer);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetMajor(Value: Integer);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetBuild(Value: Integer);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetPlatform(Value: Integer);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetIs64Bit(const Value: Bool);
begin
//Do Nothing Here!
end;
procedure TJDOSInfo.SetIsServer(const Value: Bool);
begin
//Do Nothing Here!
end;
end.