Inno setup Windows Registry not catchable - file

:-)
I already did already a little bit programming in Inno setup, but now I think I am not able to see the forest for the trees. :-)
I want to copy some customization files in the section "Copyfiles" into the installation path of the files which is located in the registry. For this I call "GetInstalledPath" and want to get the registry information. BUt the message box in the Copyfiles section with input message "Test" is afterwards empty and also the files are not copied into the right place. I could swear it worked in an earlier version, probably I changed sth or is there sth to take care about it?
Thank you very much for having a look!
Best wishes and stay healthy!
JH
function GetInstallPath(Param: String): String;
begin
if Param = 'File1' then
Result := 'C:\Program Files\FolderFile1'
else if Param = 'InstPath32' then
begin
if RegGetSubkeyNames(HKLM32, 'Software\Programname', RegKeys) then
begin
if RegQueryStringValue(HKLM32,'Software\Programname' + '\'+ 'Versionnumber'+ 'Paths','InstallDirectory', Program_PATH2) then
Result := Program_PATH2
else
end
end
else if Param = 'InstPath64' then
begin
if RegGetSubkeyNames(HKLM64, 'Software\Programname', RegKeys) then
begin
if RegQueryStringValue(HKLM64,'Software\Programname' + '\'+ 'Versionnumber+ 'Paths','InstallDirectory', Program_PATH3) then
Result := Program_PATH3
else
MsgBox('InstPath64 ' + Program_PATH3, mbInformation, MB_OK);
end
end
end;
procedure WaitUntilInstalled();
var
I: integer;
count: integer;
begin
count := 0;
I := 0
while (NOT FileExists(ExpandConstant('{tmp}\filename.txt'))) AND (count<90) DO
begin
count := count + 1;
Sleep(1000);
end;
end;
procedure CopyFiles(Param: String) ;
var
SrcDir: String;
DestDir: String;
ResultCode: Integer;
Command: String;
begin
if Param = 'Example32' then
begin
SrcDir := '{tmp}\Customization';
DestDir := GetInstallPath('InstPath32');
Exec('md',ExpandConstant(DestDir),'',SW_SHOW, ewWaitUntilTerminated, ResultCode);
Command := '"' + ExpandConstant(SrcDir) + '" "' + ExpandConstant(DestDir) + '"' + ' /y /E /I';
Exec('xcopy', Command, '',SW_SHOW, ewWaitUntilTerminated, ResultCode);
end
else if Param = 'Example64' then
begin
SrcDir := '{tmp}\Customization';
DestDir := GetInstallPath('InstPath64');
MsgBox('Test' + DestDir, mbInformation, MB_OK)
Exec('md',ExpandConstant(DestDir),'',SW_SHOW, ewWaitUntilTerminated, ResultCode);
Command := '"' + ExpandConstant(SrcDir) + '" "' + ExpandConstant(DestDir) + '"' + ' /y /E /I';
Exec('xcopy', Command, '',SW_SHOW, ewWaitUntilTerminated, ResultCode);
end
end;

Related

AsStreams FireDAC got nil value from MemoryStream

i was trying to insert a lot of info into my database Access and i am stuck on this exemple:
(TableContact.FieldByName('foto') as TBlobField).SaveToStream(AQuery.Params.ParamByName('pFoto').AsStreams[I];
Always my AsStreams[I] is nil
Trying to get it solved i tryed to do an loop adding my Streams into an Array and then insert them into my AsStreams[I], but it was the same error (nil).
Exemple:
for I := 0 to Streams.Count - 1 do
(AQuery.Params.ParamByName('pFoto').AsStreams[I] as TBlobField).LoadFromStream(Streams[I]);
Anyone could help me?
Full code downhere
procedure TPrincipalController.SetDadosMemTableToBanco;
var
I: Integer;
AQuery: TFDQuery;
function GetSQLMemTableToBanco: String;
begin
Result :=
'INSERT INTO PESSOA (nome, telefone, email, foto, observacoes) ' + sLineBreak +
' VALUES (:pNome, :pTelefone, :pEmail, :pFoto, :pObservacoes); ';
end;
function GetSQLMemTableUpdateToBanco: String;
begin
Result :=
'UPDATE PESSOA ' + sLineBreak +
' SET nome = :pNome, ' + sLineBreak +
' telefone = :pTelefone, ' + sLineBreak +
' email = :pEmail, ' + sLineBreak +
' foto = :pFoto, ' + sLineBreak +
' observacoes = :pObservacoes ' + sLineBreak +
' WHERE id = :pID; ';
end;
procedure SetArraySizeOnSQLChange;
begin
AQuery.Params.ArraySize := FTableContatos.RecordCount;
end;
begin
try
AQuery := TFDQuery.Create(nil);
try
AQuery.Connection := TConexao.GetConexao;
TableContatos.First;
for I := 0 to TableContatos.RecordCount - 1 do
begin
AQuery.SQL.Text := GetSQLMemTableToBanco;
SetArraySizeOnSQLChange;
if ExisteRegistro(TableContatos.FieldByName('id').AsInteger) then
begin
AQuery.SQL.Text := GetSQLMemTableUpdateToBanco;
SetArraySizeOnSQLChange;
AQuery.ParamByName('pID').AsIntegers[I] := TableContatos.FieldByName('id').AsInteger;
end;
AQuery.ParamByName('pNome').AsStrings[I] := TableContatos.FieldByName('nome').AsString;
AQuery.ParamByName('pTelefone').AsStrings[I] := TableContatos.FieldByName('telefone').AsString;
AQuery.ParamByName('pEmail').AsStrings[I] := TableContatos.FieldByName('email').AsString;
AQuery.ParamByName('pObservacoes').AsStrings[I] := TableContatos.FieldByName('observacoes').AsString;
(TableContatos.FieldByName('foto') as TBlobField).SaveToStream(AQuery.Params.ParamByName('pFoto').AsStreams[I]);
TableContatos.Next;
end;
AQuery.Execute(TableContatos.RecordCount, 0);
finally
AQuery.Free;
end;
except
on E: Exception do
ShowMessageFmt('Erro ao incluir dados no banco. MSG -> %s', [E.Message]);
end;
end;
Solved using only Update on SQL and the attribution to the Field i needed to use like this:
AStream := TableContatos.CreateBlobStream(TableContatos.FieldByName('foto'), TBlobStreamMode.bmRead);
try
AQuery.ParamByName('pFoto').LoadFromStream(AStream, ftBlob, I);
finally
AStream.Free;
end;

Command Line Parms: Function Return Type As Array?

Here's the current problem:
Executing an uninstall string with command line parameters following this solution:
Here's what we have in the form of non-functioning code:
const MAX_PATH = 260;
function GetUninstallString(): TArrayOfString;
var
sUnInstPath: String;
sUnInstallString: String;
sUnInstallStringPrm: String;
begin
sUnInstPath := ExpandConstant('Software\Microsoft\Windows\CurrentVersion\Uninstall\{#MyAppName}');
sUnInstallString := '';
if not RegQueryStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString) then
RegQueryStringValue(HKCU, sUnInstPath, 'UninstallString', sUnInstallString);
if sUnInstallString = '' Then
Begin
sUnInstPath := ExpandConstant('Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\{#MyAppName}');
RegQueryStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString);
End;
if sUnInstallString <> '' Then
Begin
sUnInstallStringPrm:= copy(sUnInstallString, pos(' ', sUnInstallString) + 1, MAX_PATH);
MsgBox(sUnInstallStringPrm, mbInformation, MB_OK);
Delete(sUnInstallString, pos(' ', sUnInstallString), MAX_PATH);
End;
Result := [sUnInstallString, UnInstallStringPrm];
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 ShellExec('open', sUnInstallString, '','', SW_SHOW, 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;
There is very little info on how to use GetUninstallString in this context. Possible at all?
Not sure if, as an alternative, the string array containing sUnInstallString... can be passed as a parameter within the above fixture, albeit the return type as array appears to fit a little better.
The GetUninstallString is used twice in the code.
In IsUpgrade
and in UnInstallOldVersion.
In IsUpgrade it's only tested for non-empty value.
In UnInstallOldVersion it is executed.
So make the function return whole UninstallString as a simple string.
For IsUpgrade it is enough.
And do the actual parsing to program path and its arguments in the UnInstallOldVersion only.
Also you should:
Handle a situation where there's no space in the string (no parameters)
The path to the uninstaller can contain spaces too (and it typically will as the uninstallers tend to be in Program Files).

Select items from a combobox and write index of selected value to an INI file during installation

How to make the user select an item from a combobox and then write it to an INI file as a number (01, 02, 03, ..., 18)? I generated this code but I do not know what else to do. If you could help me I would be very grateful
[INI]
Filename: "{app}\rev.ini"; Section: "steamclient"; Key: "RankLevel"; String: ""
[Code]
var
NewComboBox1: TNewComboBox;
procedure RedesignWizardForm;
begin
{ NewComboBox1 }
NewComboBox1 := TNewComboBox.Create(WizardForm);
with NewComboBox1 do
begin
Name := 'NewComboBox1';
Parent := WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(120);
Width := ScaleX(145);
Height := ScaleY(21);
Text := 'Alcon';
Items.Text := 'Alcon' + #13#10 +
'Aguila' + #13#10 +
'Elite' + #13#10 +
'Pro';
ItemIndex := 0;
end;
NewComboBox1.TabOrder := 5;
end;
procedure InitializeWizard();
begin
RedesignWizardForm;
end;
The easiest solution is using a scripted constant in the INI section:
[INI]
Filename: "{app}\rev.ini"; Section: "steamclient"; \
Key: "RankLevel"; String: "{code:GetRankLevel}"
[Code]
{ ... }
function GetRankLevel(Param: string): string;
begin
Result := Format('%.2d', [NewComboBox1.ItemIndex + 1]);
end;
Though this will not write the INI file "in a custom page after the components section". It will write it only during the actual installation, what is the correct behavior, imho.
See also Save Inno Setup custom page field values to an INI file.

Moving the content of a folder to another one

Using Delphi 7, I need to move all the content (files, folders and subfolders) from one folder to another one. After some research, SHFileOpStruct seems to be the best option. Here is what I got so far:
function MoveDir(SrcDir, DstDir: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
ZeroMemory(#FOS, SizeOf(FOS));
with FOS do
begin
wFunc := FO_MOVE; // FO_COPY;
fFlags := FOF_FILESONLY or
FOF_ALLOWUNDO or FOF_SIMPLEPROGRESS;
pFrom := PChar(SrcDir + #0);
pTo := PChar(DstDir + #0);
end;
Result := (SHFileOperation(FOS) = 0);
end;
But when using this function, the entire folder is moved to destination, not only it content. For example, if I use MoveDir('c:\test', 'd:\test') I get d:\teste\teste.
I already tried to change this line bellow, and it works when coping the files (FO_COPY) but not when moving.
pFrom := PChar(SrcDir + '\*.*' + #0);
Please, can someone help me with this? Would be great if I can do this without moving file by file, folder by folder...
Thanks!!
You should use your second version, without FOF_FILESONLY flag:
function MoveDir(SrcDir, DstDir: string): Boolean;
var
FOS: TSHFileOpStruct;
begin
ZeroMemory(#FOS, SizeOf(FOS));
with FOS do
begin
wFunc := FO_MOVE; // FO_COPY;
fFlags := FOF_ALLOWUNDO or FOF_SIMPLEPROGRESS;
pFrom := PChar(IncludeTrailingPathDelimiter(SrcDir) + '*.*'#0);
pTo := PChar(DstDir + #0);
end;
Result := (SHFileOperation(FOS) = 0);
end;

Create multiple text files

what would be a neat way to create multiple *.txt files on application
startup i.e check if they exist if not create them.
I need to create about 10 text files.
Will I have to do like this for every single file:
var
MyFile: textfile;
ApplicationPath: string;
begin
ApplicationPath := ExtractFileDir(Application.ExeName);
if not FileExists(ApplicationPath + '\a1.txt') then
begin
AssignFile(MyFile, (ApplicationPath + '\a1.txt'));
Rewrite(MyFile);
Close(MyFile);
end
else
Abort;
end;
If you only want to create the empty files (or rewrite the existing) with subsequently numbered file names, you might try something like this. The following examples use the CreateFile API function. But pay attention that several things may forbid your file creation attempts!
If you want to create (overwrite) them in all circumstances, use CREATE_ALWAYS disposition flag
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
Name: string;
Path: string;
begin
Path := ExtractFilePath(ParamStr(0));
for I := 1 to 10 do
begin
Name := Path + 'a' + IntToStr(I) + '.txt';
CloseHandle(CreateFile(PChar(Name), 0, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
end;
end;
Or if you want to create the files only if they doesn't exist, use the CREATE_NEW disposition flag
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
Name: string;
Path: string;
begin
Path := ExtractFilePath(ParamStr(0));
for I := 1 to 10 do
begin
Name := Path + 'a' + IntToStr(I) + '.txt';
CloseHandle(CreateFile(PChar(Name), 0, 0, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0));
end;
end;
Something like this, perhaps:
var
ApplicationDir: string;
I: Integer;
F: TextFile;
begin
ApplicationDir := ExtractFileDir(Application.ExeName);
for I := 1 to 10 do
begin
Path := ApplicationDir + '\a' + IntToStr(I) + '.txt';
if not FileExists(Path) then
begin
AssignFile(F, Path);
Rewrite(F);
Close(F);
end
end;
procedure CreateFile(Directory: string; FileName: string; Text: string);
var
F: TextFile;
begin
try
AssignFile(F, Directory + '\' + FileName);
{$i-}
Rewrite(F);
{$i+}
if IOResult = 0 then
begin
Writeln(F, Text);
end;
finally
CloseFile(f);
end;
end;
...
for i := 0 to 10 do
CreateFile(Directory, Filename, Text);

Resources