InnoSetup v6 ARC Extraction, Minimize Broken - inno-setup-v6

InnoSetup v6
Extracting from a FreeArc 0.67 (March 15 2014) Archive using temporary file unarc.exe, during the extraction process the minimize window button is broken.
Using FreeARC because it's the best compression software I can find to date.
During the archive decompression, the GUI window with the status message can't be minimized.
Clicking the window makes windows respond with a deny sound. How do I resolve this?
Something to do with "ProgressPage" or executing the arc command line?
Even with this page disabled, it does the same thing, so probably the setup waiting for the process to finish?
I am constantly working on improving and getting this fix because I got files that are in the 100 GB range that need to be compressed to save on disk space. Making a setup program for the extraction process makes it easier to install those files vs relying on the application that I must install first in order to do an extraction.
EDIT: I switch the extraction program from arc.exe to unarc.exe because arc.exe was crashing due to RAM issues.
#define ArcArchive "Test.arc"
[Setup]
AppName=Test App
DefaultDirName=Test App
AppVerName=Test App
WizardStyle=modern
Compression=lzma2
SolidCompression=yes
Uninstallable=no
DisableProgramGroupPage=yes
[Files]
Source: unarc.exe; Flags: dontcopy
[Code]
var
ProgressPage: TOutputProgressWizardPage;
ProgressFileName: string;
procedure ExtractArc;
var
ArcExtracterPath: string;
ArcArchivePath: string;
TempPath: string;
CommandLine: string;
ResultCode: Integer;
S: AnsiString;
Message: string;
begin
ExtractTemporaryFile('unarc.exe');
ProgressPage := CreateOutputProgressPage('Decompression', 'Decompressing archive...please wait');
ProgressPage.Show;
try
TempPath := ExpandConstant('{tmp}');
ArcExtracterPath := TempPath + '\unarc.exe';
ArcArchivePath := ExpandConstant('{src}\{#ArcArchive}');
ProgressFileName := ExpandConstant('{tmp}\progress.txt');
Log(Format('Expecting progress in %s', [ProgressFileName]));
CommandLine :=
Format('"%s" x -o+ -dp"%s" "%s" > "%s"', [
ArcExtracterPath, ExpandConstant('{app}'), ArcArchivePath, ProgressFileName]);
Log(Format('Executing: %s', [CommandLine]));
CommandLine := Format('/C "%s"', [CommandLine]);
if not Exec(ExpandConstant('{cmd}'), CommandLine, '', SW_HIDE,
ewWaitUntilTerminated, ResultCode) then
begin
RaiseException('Cannot start extracter');
end
else
if ResultCode <> 0 then
begin
LoadStringFromFile(ProgressFileName, S);
Message := Format('Arc extraction failed failed with code %d', [ResultCode]);
Log(Message);
Log('Output: ' + S);
RaiseException(Message);
end
else
begin
Log('Arc extraction done');
end;
finally
{ Clean up }
Log('Arc extraction cleanup');
ProgressPage.Hide;
DeleteFile(ProgressFileName);
end;
Log('Arc extraction end');
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
ExtractArc;
end;
end;

Related

Input and output pipe in Lazarus TProcess

I would like to make a terminal with a Lazarus GUI application. But I'm in trouble. And I hope someone can help me, please.
Question1: The Chinese and other special chars cannot display normally, I would like to know how to fix this problem.
(code)Class of the thread and "run" button on click event
screenshot
Question2: I want to know how to input some command into the console. I tried to start a Windows cmd, and use "winver" command. But when I click the button, nothing happened.
The send command button
Winver is not console but a GUI program. To run a program with output into memo, use the following code, which retrieves version using the cmd.exe "ver" command. You can try to use this template for the first question too.
unit mainprocesstomemo;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Process, Pipes;
Type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
public
procedure ProcessEvent(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TProcessMemo }
Type
TProcessToMemo = class(TProcess)
public
fmemo : Tmemo;
bytesprocessed : integer;
fstringsadded : integer;
function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;override;
end;
function RunCommandMemo(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;memo:TMemo=nil;runrefresh : TOnRunCommandEvent=nil ):boolean;
Var
p : TProcessToMemo;
i,
exitstatus : integer;
ErrorString : String;
begin
p:=TProcessToMemo.create(nil);
if Options<>[] then
P.Options:=Options - [poRunSuspended,poWaitOnExit];
p.options:=p.options+[poRunIdle];
P.ShowWindow:=SwOptions;
p.Executable:=exename;
if high(commands)>=0 then
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
p.fmemo:=memo;
p.OnRunCommandEvent:=runrefresh;
try
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
if exitstatus<>0 then result:=false;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var s : string;
begin
//RunCommandMemo('testit',[],s,[],swonone,memo1,ProcessEvent);
RunCommandMemo('cmd.exe',['/w','/c','ver'],s,[],swonone,memo1,ProcessEvent);
end;
procedure TForm1.ProcessEvent(Sender, Context: TObject;
Status: TRunCommandEventCode; const Message: string);
begin
if status in [RunCommandIdle, RunCommandFinished] then
begin
if status =RunCommandFinished then
begin
memo1.lines.add(' process finished');
end;
if tprocesstomemo(sender).fstringsadded>0 then
begin
tprocesstomemo(sender).fstringsadded:=0;
// memo1.lines.add('Handle:'+inttostr(tprocesstomemo(sender).ProcessHandle));
memo1.refresh;
end;
sleep(10);
application.ProcessMessages;
end;
end;
{ TProcessToMemo }
function TProcessToMemo.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;
var lfpos : integer;
crcorrectedpos:integer;
stradded : integer;
newstr : string;
begin
Result:=inherited ReadInputStream(p, BytesRead, DataLength, data, MaxLoops);
if (result) and (bytesread>bytesprocessed)then
begin
stradded:=0;
lfpos:=pos(#10,data,bytesprocessed+1);
while (lfpos<>0) and (lfpos<=bytesread) do
begin
crcorrectedpos:=lfpos;
if (crcorrectedpos>0) and (data[crcorrectedpos-1]=#13) then
dec(crcorrectedpos);
newstr:=copy(data,bytesprocessed+1,crcorrectedpos-bytesprocessed-1);
fmemo.lines.add(newstr);
inc(stradded);
bytesprocessed:=lfpos;
lfpos:=pos(#10,data,bytesprocessed+1);
end;
inc(fstringsadded,stradded); // check idle event.
end;
end;
end.
I don't know minecraft server, and many external programs might do weird things to the console. But a simple combination of programs to test with is here http://www.stack.nl/~marcov/files/processmemodemo.zip

Lazarus (freepascal) Reading large output from TProcess

I' m reading large process output data in Lazarus using the TProcess and the suggestions from this freepascal wiki page.
The wiki page suggests to create a loop to read the process output data like this:
// ... If you want to read output from an external process, this is the code you should adapt for production use.
while True do
begin
MemStream.SetSize(BytesRead + 2024); // make sure we have room
NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
if NumBytes > 0
then begin
Inc(BytesRead, NumBytes);
Write('.') //Output progress to screen.
end else
BREAK // Program has finished execution.
end;
// "Then read the MemStream to do your job"
The wiki page also mentions that the calling program should read from the output pipe to prevent it from getting full.
So, how much data makes the output pipe full?
Why we should use a MemStream (TMemoryStream) and not directly read from OurProcess.Output stream (using the bytesAvailable, etc) in the above loop?
I'm reading 80MB of wav data from a process and I have noticed that both MemStream and OurProcess.Output streams have the same amount of data! The memory usage gets doubled. So the suggested method from the wiki cannot be considered as efficient or optimized. Or there is something I'm missing?
Afaik output/input streams are a stream form of a pipe, not memory streams. The values you see are retrieved from the OS handle, not from memory allocated to the FPC app per se.
It is just like you can ask for the .size of a file on disk without reading the whole file.
procedure RunExternalAppInMemo(DosApp:String;AMemo:TMemo);
const READ_BYTES = 2048;
var
aProcess: TProcess; //TProcess is crossplatform is best way
MemStream: TMemoryStream;
NumBytes: LongInt;
BytesRead: LongInt;
Lines: TStringList;
begin
// A temp Memorystream is used to buffer the output
MemStream := TMemoryStream.Create;
Lines :=TStringList.Create;
BytesRead := 0;
aProcess := TProcess.Create(nil);
aProcess.CommandLine := DosApp;
aprocess.ShowWindow := swoHIDE;
AProcess.Options := AProcess.Options + [poUsePipes];
aProcess.Execute;
while aProcess.Running do
begin
// make sure we have room
MemStream.SetSize(BytesRead + READ_BYTES);
// try reading it
NumBytes := aProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
if NumBytes > 0 // All read() calls will block, except the final one.
then Inc(BytesRead, NumBytes)
else
BREAK // Program has finished execution.
end;
MemStream.SetSize(BytesRead);
Lines.LoadFromStream(MemStream);
AMemo.lines.AddStrings(Lines);
aProcess.Free;
Lines.Free;
MemStream.Free;
end;
I was dealing with this problem today, I've modified Georgescu answer, as I wanted Memo to display output stream on the fly
procedure RunExternalAppInMemo(DosApp:String;AMemo:TMemo);
const READ_BYTES = 2048;
var
aProcess: TProcess; //TProcess is crossplatform is best way
NumBytes: LongInt;
Buffer: array of byte;
begin
// set the size of your buffer
SetLength(Buffer,READ_BYTES);
aProcess := TProcess.Create(nil);
aProcess.CommandLine := DosApp;
aprocess.ShowWindow := swoHIDE;
AProcess.Options := AProcess.Options + [poUsePipes];
aProcess.Execute;
while aProcess.Running do
begin
// try reading it
NumBytes := aProcess.Output.Read(Buffer[0], length(buffer)*sizeof(byte)); // I usually do it that way, so I can change Buffer size on if needed
AProcess.Suspend; //I have no experience with pipes, but it seems way I won loose eny output?
if NumBytes > 0 then // All read() calls will block, except the final one.
begin
AMemo.Lines.Add(Pchar(Buffer);
application.ProcessMessages;
AProcess.Resume;
end
else
BREAK; // Program has finished execution.
end;
setlength(Buffer,0);
aProcess.Free;
end;

.NET Framework as a pre-requisite for installation with Inno-Setup

I have an application I have to check if .NET FW 3.5 has already installed. If already installed, I want to open a messagebox that asks the user to download it from Microsoft website and stop the installation.
I found the following code. Can you tell me please:
a) Where should I call this function from?
b) Should I check if .NET FW 3.5 or higher version is already installed? e.g. If FW 4.0 installed - is that necessary to install 3.5?
Thank you
function IsDotNET35Detected(): Boolean;
var
ErrorCode: Integer;
netFrameWorkInstalled : Boolean;
isInstalled: Cardinal;
begin
result := true;
// Check for the .Net 3.5 framework
isInstalled := 0;
netFrameworkInstalled := RegQueryDWordValue(HKLM, 'SOFTWARE\Microsoft\NET Framework Setup\NDP\v3.5', 'Install', isInstalled);
if ((netFrameworkInstalled) and (isInstalled <> 1)) then netFrameworkInstalled := false;
if netFrameworkInstalled = false then
begin
if (MsgBox(ExpandConstant('{cm:dotnetmissing}'), mbConfirmation, MB_YESNO) = idYes) then
begin
ShellExec('open',
'http://www.microsoft.com/downloads/details.aspx?FamilyID=333325fd-ae52-4e35-b531-508d977d32a6&DisplayLang=en',
'','',SW_SHOWNORMAL,ewNoWait,ErrorCode);
end;
result := false;
end;
end;
If you want to perform your check when the installation starts but before the wizard form is shown, use the InitializeSetup event handler for it. When you return False to that handler, the setup will abort, when True, setup will start. Here's a little bit optimized script you've posted:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
[CustomMessages]
DotNetMissing=.NET Framework 3.5 is missing. Do you want to download it ? Setup will now exit!
[Code]
function IsDotNET35Detected: Boolean;
var
ErrorCode: Integer;
InstallValue: Cardinal;
begin
Result := True;
if not RegQueryDWordValue(HKLM, 'SOFTWARE\Microsoft\NET Framework Setup\NDP\v3.5',
'Install', InstallValue) or (InstallValue <> 1) then
begin
Result := False;
if MsgBox(ExpandConstant('{cm:DotNetMissing}'), mbConfirmation, MB_YESNO) = IDYES then
ShellExec('', 'http://www.microsoft.com/downloads/details.aspx?FamilyID=333325fd-ae52-4e35-b531-508d977d32a6&DisplayLang=en',
'', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;
end;
function InitializeSetup: Boolean;
begin
Result := IsDotNET35Detected;
end;

Communication between two programs using file

I want two separate programs written in Pascal communicate between themselves using additional text file. It works fine for the first 2-3 messages but then it gives run-time error in either sender.pas or receiver.pas Do you know where my mistake is or do you have any suggestion?
First program receiver.pas
var
f : text;
s : string;
begin
{I-}
Assign(f,'main.in');
while true do
begin
reset(f);
while IOResult<>0 do //
begin // Wait until the file
close(f); // is closed by sender
reset(f); //
end; //
if eof(f) then
close(f)
else
begin
readln(f,s);
close(f);
rewrite(f);
close(f);
writeln(s);
end;
end;
{I+}
end.
second program sender.pas
var
f : text;
s : string;
begin
{I-}
Assign(f,'main.in');
while true do
begin
readln(s);
rewrite(f); //
while IOResult<>0 do //
begin // Wait until the file
close(f); // is closed by receiver
rewrite(f); //
end; //
writeln(f,s);
close(f);
end;
{I+}
end.
Some things I noticed:
If rewrite fails, afaik the file was not opened and you don't have to close it? Closing an unopened file might cause runtime errors (though I assume assign will init it safely)
depending on how you use these, there might be in the logic. Namely that after closing a file is directly ready for opening by other apps. In general closed filehandles linger several 100ms till several seconds (depending on filesystem busines). This can cause starvation problems in such schemes. (while it would work in plain dos, which didn't linger, at least not that much)
The reader will crash if the file doesn't exist.
I assume that the {I-}/{I+} is a typo and that your sourcecode really reads {$I-} and {$I+} (note the dollar?)
In Windows pascal versions, read only access is not always locking. Put filemode:=2 as first line in everything.
What compiler is this? Delphi, Free Pascal? Which version?
My new (Free Pascal) receiver code becomes:
uses sysutils;
var
f : text;
s : string;
begin
filemode := 2; // read-only
{$I-}
Assign(f,'main.in');
while true do
begin
reset(f);
while IOResult<>0 do //
begin // Wait until the file
close(f); // is closed by sender
sleep(1000);
reset(f);
end;
if eof(f) then
begin
close(f);
sleep(1000);
end
else
begin
readln(f,s);
close(f);
rewrite(f);
close(f);
writeln(s);
end;
end;
{$I+}
end.
The new sender code is:
uses sysutils;
var
f : text;
s : string;
begin
filemode := 2; // read-only
{$I-}
Assign(f,'main.in');
while true do
begin
reset(f);
while IOResult<>0 do //
begin // Wait until the file
close(f); // is closed by sender
sleep(1000);
reset(f);
end;
if eof(f) then
begin
close(f);
sleep(1000);
end
else
begin
readln(f,s);
close(f);
rewrite(f);
close(f);
writeln(s);
end;
end;
{$I+}
end.
A couple of things: Make sure you check IOResult after every file operation, not just rewrite/reset - don't call close if your reset/rewrite failed - and you probably want something like a Sleep(250) in those retry loops.

Is it possible to 'Pin to start menu' using Inno Setup?

I'm using the excellent Inno Setup installer and I notice that some Applications (often from Microsoft) get installed with their launch icon already highly visible ('pinned?') in the start menu (in Windows 7). Am I totally reliant on the most-recently-used algorithm for my icon to be 'large' in the start menu, or is there a way of promoting my application from the installer please?
It is possible to pin programs, but not officially. Based on a code posted in this thread (which uses the same way as described in the article linked by #Mark Redman) I wrote the following:
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
// these constants are not defined in Windows
SHELL32_STRING_ID_PIN_TO_TASKBAR = 5386;
SHELL32_STRING_ID_PIN_TO_STARTMENU = 5381;
SHELL32_STRING_ID_UNPIN_FROM_TASKBAR = 5387;
SHELL32_STRING_ID_UNPIN_FROM_STARTMENU = 5382;
type
HINSTANCE = THandle;
HMODULE = HINSTANCE;
TPinDest = (
pdTaskbar,
pdStartMenu
);
function LoadLibrary(lpFileName: string): HMODULE;
external 'LoadLibrary{#AW}#kernel32.dll stdcall';
function FreeLibrary(hModule: HMODULE): BOOL;
external 'FreeLibrary#kernel32.dll stdcall';
function LoadString(hInstance: HINSTANCE; uID: UINT;
lpBuffer: string; nBufferMax: Integer): Integer;
external 'LoadString{#AW}#user32.dll stdcall';
function TryGetVerbName(ID: UINT; out VerbName: string): Boolean;
var
Buffer: string;
BufLen: Integer;
Handle: HMODULE;
begin
Result := False;
Handle := LoadLibrary(ExpandConstant('{sys}\Shell32.dll'));
if Handle <> 0 then
try
SetLength(Buffer, 255);
BufLen := LoadString(Handle, ID, Buffer, Length(Buffer));
if BufLen <> 0 then
begin
Result := True;
VerbName := Copy(Buffer, 1, BufLen);
end;
finally
FreeLibrary(Handle);
end;
end;
function ExecVerb(const FileName, VerbName: string): Boolean;
var
I: Integer;
Shell: Variant;
Folder: Variant;
FolderItem: Variant;
begin
Result := False;
Shell := CreateOleObject('Shell.Application');
Folder := Shell.NameSpace(ExtractFilePath(FileName));
FolderItem := Folder.ParseName(ExtractFileName(FileName));
for I := 1 to FolderItem.Verbs.Count do
begin
if FolderItem.Verbs.Item(I).Name = VerbName then
begin
FolderItem.Verbs.Item(I).DoIt;
Result := True;
Exit;
end;
end;
end;
function PinAppTo(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_PIN_TO_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_PIN_TO_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
function UnpinAppFrom(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
The above code first reads the caption of the menu item for pinning or unpinning applications from the string table of the Shell32.dll library. Then connects to the Windows Shell, and for the target app. path creates the Folder object, then obtains the FolderItem object and on this object iterates all the available verbs and checks if their name matches to the one read from the Shell32.dll library string table. If so, it invokes the verb item action by calling the DoIt method and exits the iteration.
Here is a possible usage of the above code, for pinning:
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc has been pinned to the taskbar.', mbInformation, MB_OK);
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc has been pinned to the start menu.', mbInformation, MB_OK);
And for unpinning:
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc is not pinned to the taskbar anymore.', mbInformation, MB_OK);
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc is not pinned to the start menu anymore.', mbInformation, MB_OK);
Please note that even though this code works on Windows 7 (and taskbar pinning also on Windows 8.1 where I've tested it), it is really hacky way, since there is no official way to programatically pin programs to taskbar, nor start menu. That's what the users should do by their own choice.
There's a reason there's no programmatic way to pin things to the taskbar/start menu. In my experience, I have seen the start menu highlight newly-created shortcuts, and that's designed to handle exactly this situation. When you see a newly-installed program show up on the start menu, it's probably because of that algorithm and not because the installer placed it there.
That said, if a new shortcut does not appear highlighted, it may be because the installer extracts a pre-existing shortcut and preserves an old timestamp on it, rather than using the API function to create a shortcut in the start menu.
Have a look at: http://blogs.technet.com/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx