Related
How can I execute an external program from a Linux console application created in Delphi 10.2 Tokyo?
What I want to do is execute a shell command with parameters like
/home/test/qrencode -o /tmp/abc.png '08154711'
I do not need the output of the program but it should be executed synchronously.
It is easy in Windows environments but as 64 bit Linux support in Delphi (after Kylix) is quite new, I could not find any hints on the Web by now.
Any tip helping me to solve that is very appreciated.
Thanks in advance!
Davids hint pointed me to an example that helped creating the solution. The most tricky part was finding out how to convert a Delphi string to a MarshaledAString as the example used a const string as argument for popen. I tested on RHEL 7.3, runs like a charm.
uses
...
System.SysUtils,
Posix.Base,
Posix.Fcntl,
...;
type
TStreamHandle = pointer;
function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle; cdecl;
external libc name _PU + 'popen';
function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
function fgets(buffer: pointer; size: int32; Stream: TStreamHandle): pointer; cdecl; external libc name _PU + 'fgets';
function runCommand(const acommand: MarshaledAString): String;
// run a linux shell command and return output
// Adapted from http://chapmanworld.com/2017/04/06/calling-linux-commands-from-delphi/
var
handle: TStreamHandle;
data: array [0 .. 511] of uint8;
function bufferToString(buffer: pointer; maxSize: uint32): string;
var
cursor: ^uint8;
endOfBuffer: nativeuint;
begin
if not assigned(buffer) then
exit;
cursor := buffer;
endOfBuffer := nativeuint(cursor) + maxSize;
while (nativeuint(cursor) < endOfBuffer) and (cursor^ <> 0) do
begin
result := result + chr(cursor^);
cursor := pointer(succ(nativeuint(cursor)));
end;
end;
begin
result := '';
handle := popen(acommand, 'r');
try
while fgets(#data[0], sizeof(data), handle) <> nil do
begin
result := result + bufferToString(#data[0], sizeof(data));
end;
finally
pclose(handle);
end;
end;
function createQRCode(id, fn: string): string;
// Create qr-code using qrencode package
begin
deletefile(fn);
if fileExists(fn) then
raise Exception.create('Old file not deleted!');
// I am targeting rhel for now, so I know the path for sure
result := runCommand(MarshaledAString(UTF8STring('/usr/bin/qrencode -o ' + fn + ' ''' + id + '''')));
if not fileExists(fn) then
raise Exception.create('New file not created!');
end;
function testqr: String;
// Test QR Code creation with error handling
// QREncode does not output anything but who knows ;-)
begin
try
result := createQRCode('08154711', '/tmp/myqrcode.png');
except
on e: Exception do
begin
result := 'Error: ' + e.message;
end;
end;
end;
I wrote this code to do this task
uses
System.SysUtils,
System.Classes,
Posix.Base,
Posix.Fcntl;
type
TStreamHandle = pointer;
TLinuxUtils = class
public
class function RunCommandLine(ACommand : string) : TStringList;overload;
class function RunCommandLine(Acommand : string; Return : TProc<String>) : boolean; overload;
class function findParameter(AParameter : string) : boolean;
end;
function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle; cdecl; external libc name _PU + 'popen';
function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
function fgets(buffer: pointer; size: int32; Stream: TStreamHAndle): pointer; cdecl; external libc name _PU + 'fgets';
implementation
class function TLinuxUtils.RunCommandLine(ACommand : string) : TStringList;
var
Handle: TStreamHandle;
Data: array[0..511] of uint8;
M : TMarshaller;
begin
Result := TStringList.Create;
try
Handle := popen(M.AsAnsi(PWideChar(ACommand)).ToPointer,'r');
try
while fgets(#data[0],Sizeof(Data),Handle)<>nil do begin
Result.Add(Copy(UTF8ToString(#Data[0]),1,UTF8ToString(#Data[0]).Length -1));//,sizeof(Data)));
end;
finally
pclose(Handle);
end;
except
on E: Exception do
Result.Add(E.ClassName + ': ' + E.Message);
end;
end;
class function TLinuxUtils.RunCommandLine(Acommand : string; Return : TProc<string>) : boolean;
var
Handle: TStreamHandle;
Data: array[0..511] of uint8;
M : TMarshaller;
begin
Result := false;
try
Handle := popen(M.AsAnsi(PWideChar(ACommand)).ToPointer,'r');
try
while fgets(#data[0],Sizeof(Data),Handle)<>nil do begin
Return(Copy(UTF8ToString(#Data[0]),1,UTF8ToString(#Data[0]).Length -1));//,sizeof(Data)));
end;
finally
pclose(Handle);
end;
except
on E: Exception do
Return(E.ClassName + ': ' + E.Message);
end;
end;
class function TLinuxUtils.findParameter(AParameter : string) : boolean;
var
I : Integer;
begin
Result := false;
for I := 0 to Pred(ParamCount) do
begin
Result := AParameter.ToUpper = ParamStr(i).ToUpper;
if Result then
Break;
end;
end;
You do not have to worry about MarshaledString.
The RunCommandLine function has 2 ways to be called. The first you have the return on a TStringList with all the lines that the console will return.
The second you can pass an anonymous method that will treat line by line of return of the command line.
I'm setting up a new system using Indy 10.6 tcpserver on a Raspberry PI with the latest Raspbian loaded. I am running the app from the GUI desktop via a terminal bash script with sudo. Everything works fine until a client connects, then when it disconnects I get Gtk-WARNINGs, and some times Gtk-CRITICALs and I don't know why. Here's my code, it only allows one client connection at a time, then it deactivates the server and restarts it after each connection is done:
Procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject);
Begin //start the server
Server.Active := False;
Server.Bindings.Clear;
Server.Bindings.Add.IPVersion := Id_IPv4;
Server.Bindings.Add.IP := LIP;
Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0);
Try
Server.Active := True;
Except
On E: Exception Do
Memo1.Lines.Add(E.Message);
End;
If Not Server.Active Then
Exit;
ASpeedBtn1.Enabled := False;
ASpeedBtn2.Enabled := True;
AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0));
End;
Procedure TFK20Elevator.ServerConnect(AContext: TIdContext);
Begin
If Connected Then
Begin
Abort();
Exit;
End;
AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' - Authenticating...';
Memo1.Lines.Clear;
Manager := False;
EncDecSIdx := 1;
RetryTimer.Enabled := False;
RetryTimer.Interval := 3000;
Authenticating := True;
AuthTimer.Enabled := True;
StayAlive.Enabled := True;
End;
Procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception);
Begin
If AnsiContainsText(AException.Message, 'Gracefully') Then
AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) //closed gracefully message
Else
Begin //show the exception
Memo1.Lines.Add('An exception happend! - ' + AException.Message);
RetryTimer.Enabled := True;
End;
Manager := False;
Authenticating := False;
End;
Procedure TFK20Elevator.ServerExecute(AContext: TIdContext);
//EncStr and DecStr simply encode/decode, respectively, a standard
// string into/from a key encrypted hex string, i.e. '00' to 'FF'
// for each character in the string
Var
S, UserName, Password: String;
I, N: Integer;
Begin
S := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault); //get the data
If S = Heart Then //if message is the client heart beat, return to client
Begin //just a heart beat, reset timer
StayAlive.Enabled := False;
AContext.Connection.IOHandler.WriteLn(Heart, IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault);
StayAlive.Enabled := True;
Exit;
End;
S := PCommon.DecStr(S, EncDecStr, EncDecSIdx); //not heart beat, decompress
If Authenticating Then
Begin //test log in
If Length(S) > 3 Then
Begin
I := Pos('|', S);
If (I > 1) And (Length(S) > I) Then
Begin
UserName := Copy(S, 1, I - 1);
Password := Copy(S, I + 1, Length(S) - I);
If UserName = ManUser Then
Begin
If Password = ManPass Then
Begin
AuthTimer.Enabled := False;
Manager := True;
Authenticating := False;
AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP +
':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'M',
EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault,
IndyTextEncoding_OSDefault);
AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as Manager';
Connected := True;
End
Else
AuthTimerTimer(Self);
End
Else If UserName = GenUser Then
Begin
If Password = GenPass Then
Begin
AuthTimer.Enabled := False;
Authenticating := False;
AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP +
':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'U',
EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault,
IndyTextEncoding_OSDefault);
AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as General User';
Connected := True;
End
Else
AuthTimerTimer(Self);
End
Else
AuthTimerTimer(Self);
End
Else
AuthTimerTimer(Self);
End
Else
AuthTimerTimer(Self);
End
Else
Begin //test for commands
If Copy(S, 1, Length(AssignID)) = AssignID Then
Begin //command to assign a new unit id
NewLoc := DefLocation;
NewUnit := DefUnitNum;
I := Pos('-', S, 1);
If (I > 0) And (I < Length(S)) Then
Begin
N := Pos('-', S, I + 1);
If (N > 0) And (N < Length(S)) Then
Begin
NewLoc := Copy(S, I + 1, N - I - 1);
NewUnit := Copy(S, N + 1, Length(S) - N);
End;
End;
Label15.Caption := NewLoc;
Label16.Caption := NewUnit;
FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]);
LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip
Memo1.Lines.Add('--> ' + S + '-' + LIP);
AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx),
IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault);
Memo1.Lines.Add('<-- ' + Rebooting);
TestTimer.Enabled := True;
End;
End;
End;
Procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject);
Begin //shut down the server with optional restart if not rebooting
AuthTimer.Enabled := False;
RetryTimer.Enabled := False;
StayAlive.Enabled := False;
TestTimer.Enabled := False;
DropClient;
Try
Server.Active := False;
Except
On E: Exception Do
Memo1.Lines.Add('Error disconnecting server - ' + E.Message);
End;
If Server.Active Then
Exit;
ASpeedBtn1.Enabled := True;
ASpeedBtn2.Enabled := False;
AStatus1.SimpleText := 'Server not running...';
Manager := False;
Authenticating := False;
Connected := False;
RetryTimer.Enabled := Not SysReboot;
End;
Procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext);
Begin
StayAlive.Enabled := False;
RetryTimer.Enabled := False;
DropClient;
AStatus1.SimpleText := 'Client disconnected...';
Manager := False;
Authenticating := False;
Connected := False;
RetryTimer.Enabled := Not SysReboot;
End;
Procedure TFK20Elevator.DropClient; //make sure buffers are cleared
Var
I: Integer;
SC: TIdContext;
Begin
If Server.Active Then
Begin
Application.ProcessMessages;
With Server.Contexts.LockList Do
Try
Memo1.Lines.Add('Disconnecting...');
For I := Count - 1 DownTo 0 Do
Begin
SC := TIdContext(Items[I]);
If SC = Nil Then
Continue;
SC.Connection.IOHandler.WriteBufferClear;
SC.Connection.IOHandler.InputBuffer.Clear;
SC.Connection.IOHandler.Close;
If SC.Connection.Connected Then
SC.Connection.Disconnect;
Memo1.Lines.Add('Disconnecting client ' + IntToStr(I + 1) + ' of ' + IntToStr(Count));
End;
Finally
Server.Contexts.UnlockList;
Memo1.Lines.Add('Disconnected');
End;
End;
End;
Procedure TFK20Elevator.StayAliveTimer(Sender: TObject);
Begin //server reset timer if client stops sending heart beat
StayAlive.Enabled := False;
AStatus1.SimpleText := 'Client timed out!';
If ASpeedBtn2.Enabled Then
ASpeedBtn2Click(Self);
End;
Procedure TFK20Elevator.AuthTimerTimer(Sender: TObject);
Begin //login authorization timeout timer
AuthTimer.Enabled := False;
ASpeedBtn2Click(Self);
Application.ProcessMessages;
ASpeedBtn1Click(Self);
End;
Server.Bindings.Add.IPVersion := Id_IPv4;
Server.Bindings.Add.IP := LIP;
Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0);
This is a bug in your code. You are not opening just 1 listening socket, you are actually opening 3 listening sockets! Every call to Bindings.Add() will tell TIdTCPServer to create a separate listening socket, and each Binding object has its own IP/Port settings.
What you are really doing with the above code is:
creating an IPv4 Binding on IP 0.0.0.0 on port TIdTCPServer.DefaultPort.
creating another Binding on IP LIP on port TIdTCPServer.DefaultPort using Indy's default IP version (which happens to be IPv4, unless you recompile Indy with IdIPv6 defined in IdCompilerDefines.inc).
creating yet another Binding on IP 0.0.0.0 or ::1 on port DefPort+UnitID depending on Indy's default IP version.
For what you are attempting to do, you need to call Bindings.Add() one time only, eg:
var
Binding : TIdSocketHandle;
Binding := Server.Bindings.Add;
Binding.IPVersion := Id_IPv4;
Binding.IP := LIP;
Binding.Port := DefPort + StrToIntDef(UnitID, 0);
That being said, TIdTCPServer is a multi-threaded component. Its various events (OnConnect, OnDisconnect, OnExecute, OnException, and OnListenException) are fired in the context of worker threads created internally by TIdTCPServer. Your event handlers are directly accessing UI controls from outside the context of the main UI thread. That causes all kinds of problems, and must never be done.
If your event handlers need to access your UI, they must synchronize with the main UI thread, such as with TThread.Synchronize() or TThread.Queue(), or Indy's own TIdSync or TIdNotify class, or any other inter-thread synching mechanism of your choosing.
Also, when you go to manually drop clients with DropClient(), it is doing things to the contexts that it has no business doing. You don't even need to drop the clients manually anyway, as TIdTCPServer handles that for you while it is being deactivated.
With all of that said, try something more like this:
interface
uses
Classes, Form, SysUtils, StdCtrls, ExtCtrls, Buttons, IdTCPServer, IdContext;
type
TFK20Elevator = class(TForm)
Server: TIdTCPServer;
ASpeedBtn1: TSpeedButton;
ASpeedBtn2: TSpeedButton;
Memo1: TMemo;
AStatus1: TStatusBar;
AuthTimer: TTimer;
RetryTimer: TTimer;
StayAlive: TTimer;
TestTimer: TTimer;
...
procedure ASpeedBtn1Click(Sender: TObject);
procedure ASpeedBtn2Click(Sender: TObject);
procedure StayAliveTimer(Sender: TObject);
procedure AuthTimerTimer(Sender: TObject);
procedure ServerConnect(AContext: TIdContext);
procedure ServerDisconnect(AContext: TIdContext);
procedure ServerException(AContext: TIdContext; AException: Exception);
procedure ServerExecute(AContext: TIdContext);
...
private
DefPort: Integer;
UnitID: string;
Manager: Boolean;
Authenticating: Boolean;
EncDecSIdx: Integer;
...
procedure DropClient;
procedure ConnectedNotify(const APeerIP: string);
procedure DisconnectedNotify;
procedure ErrorNotify(const AMessage: string);
procedure HeartNotify;
procedure ManagerLoggedInNotify(const APeerIP: string);
procedure GeneralUserLoggedInNotify(const APeerIP: string);
procedure FailedAuthNotify;
procedure RebootNotify(const Data: string);
...
end;
var
FK20Elevator: TFK20Elevator;
implementation
uses
IdGlobal, IdSync;
const
Heart: string = ...;
AssignID: string = ...;
...
procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject);
var
Binding: TIdSocketHandle;
begin
//start the server
Server.Active := False;
Server.Bindings.Clear;
Binding := Server.Bindings.Add;
Binding.IPVersion := Id_IPv4;
Binding.IP := LIP;
Binding.Port := DefPort + StrToIntDef(UnitID, 0);
Server.MaxConnections := 1;
try
Server.Active := True;
except
on E: Exception do
begin
Memo1.Lines.Add('Error activating server - ' + E.Message);
Exit;
end;
end;
AStatus1.SimpleText := 'Server bound to ' + Binding.IP + ':' + IntToStr(Binding.Port);
ASpeedBtn1.Enabled := False;
ASpeedBtn2.Enabled := True;
end;
procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject);
begin
//shut down the server with optional restart if not rebooting
AuthTimer.Enabled := False;
RetryTimer.Enabled := False;
StayAlive.Enabled := False;
TestTimer.Enabled := False;
try
Server.Active := False;
except
on E: Exception do
begin
Memo1.Lines.Add('Error deactivating server - ' + E.Message);
Exit;
end;
end;
Manager := False;
Authenticating := False;
AStatus1.SimpleText := 'Server not running...';
ASpeedBtn1.Enabled := True;
ASpeedBtn2.Enabled := False;
RetryTimer.Enabled := not SysReboot;
end;
procedure TFK20Elevator.StayAliveTimer(Sender: TObject);
begin
//client stopped sending heart beats
StayAlive.Enabled := False;
Memo1.Lines.Add('Client timed out!');
DropClient;
end;
procedure TFK20Elevator.AuthTimerTimer(Sender: TObject);
begin
//login authorization timeout
AuthTimer.Enabled := False;
Memo1.Lines.Add('Authentication timed out!');
DropClient;
end;
procedure TFK20Elevator.DropClient;
begin
with Server.Contexts.LockList do
try
if Count > 0 then
TIdContext(Items[0]).Connection.Disconnect;
finally
Server.Contexts.UnlockList;
end;
end;
type
TMyNotifyMethod = procedure(const AStr: string) of object;
TMyNotify = class(TIdNotify)
protected
FMethod: TMyNotifyMethod;
FStr: string;
procedure DoNotify; override;
public
class procedure NotifyStr(AMethod: TMyNotifyMethod; const AStr: string);
end;
procedure TMyNotify.DoNotify;
begin
FMethod(FStr);
end;
class procedure TMyNotify.NotifyStr(AMethod: TMyNotifyMethod; const AStr: string);
begin
with Create do
begin
FMethod := AMethod;
FStr := AStr;
Notify;
end;
end;
procedure TFK20Elevator.ConnectedNotify(const APeerIP: string);
begin
if not Server.Active then Exit;
AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' - Authenticating...';
Memo1.Lines.Clear;
RetryTimer.Enabled := False;
RetryTimer.Interval := 3000;
AuthTimer.Enabled := True;
StayAlive.Enabled := True;
end;
procedure TFK20Elevator.DisconnectedNotify;
begin
StayAlive.Enabled := False;
RetryTimer.Enabled := False;
if Server.Active then
begin
with Server.Bindings[0] do
AStatus1.SimpleText := 'Client Disconnected. Server bound to ' + IP + ':' + IntToStr(Port);
end;
RetryTimer.Enabled := Not SysReboot;
end;
procedure TFK20Elevator.ErrorNotify(const AMessage: string);
begin
Memo1.Lines.Add('An exception happened! - ' + AMessage);
RetryTimer.Enabled := True;
end;
procedure TFK20Elevator.HeartNotify;
begin
StayAlive.Enabled := False;
StayAlive.Enabled := True;
end;
procedure TFK20Elevator.ManagerLoggedInNotify(const APeerIP: string);
begin
AuthTimer.Enabled := False;
AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as Manager';
end;
procedure TFK20Elevator.GeneralUserLoggedInNotify(const APeerIP: string);
begin
AuthTimer.Enabled := False;
AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as General User';
end;
procedure TFK20Elevator.FailedAuthNotify;
begin
//login authorization failed
AuthTimer.Enabled := False;
end;
procedure TFK20Elevator.RebootNotify(const Data: string);
var
Tmp, S, NewLoc, NewUnit, LIP: string;
begin
Tmp := Data;
S := Fetch(Tmp, #10);
NewLoc := Fetch(Tmp, #10);
NewUnit := Tmp;
Label15.Caption := NewLoc;
Label16.Caption := NewUnit;
FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]);
LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip
Memo1.Lines.Add('--> ' + S + '-' + LIP);
Memo1.Lines.Add('<-- ' + Rebooting);
TestTimer.Enabled := True;
end;
procedure TFK20Elevator.ServerConnect(AContext: TIdContext);
begin
Manager := False;
Authenticating := True;
EncDecSIdx := 1;
TMyNotify.NotifyStr(#ConnectedNotify, AContext.Binding.PeerIP);
// Note: OSDefault is platform-specific. On Linux, it is UTF-8, so
// you should use UTF-8 explicitly instead, so as to provide
// better compatibility across platforms, especially if you ever
// move this server code to another platform in the future...
//
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8
AContext.Connection.IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8
end;
procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext);
begin
Manager := False;
Authenticating := False;
TIdNotify.NotifyMethod(#DisconnectedNotify);
end;
procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception);
begin
if not (AException is EIdConnClosedGracefully) then
TMyNotify.NotifyStr(#ErrorNotify, AException.Message);
end;
procedure TFK20Elevator.ServerExecute(AContext: TIdContext);
var
S, Tmp, UserName, Password: String;
begin
S := AContext.Connection.IOHandler.ReadLn; //get the data
if S = Heart then
begin
//just a heart beat, return to client and reset timer
AContext.Connection.IOHandler.WriteLn(Heart);
TIdNotify.NotifyMethod(#HeartNotify);
Exit;
end;
//not heart beat, decompress
//EncStr and DecStr simply encode/decode, respectively, a standard
// string into/from a key encrypted hex string, i.e. '00' to 'FF'
// for each character in the string
S := PCommon.DecStr(S, EncDecStr, EncDecSIdx);
if Authenticating then
begin
//test log in
UserName := Fetch(S, '|');
Password := S;
if (UserName = ManUser) and (Password = ManPass) then
begin
Authenticating := False;
Manager := True;
AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'M', EncDecStr, EncDecSIdx));
TMyNotify.NotifyStr(#ManagerLoggedInNotify, AContext.Binding.PeerIP);
end
else if (UserName = GenUser) and (Password = GenPass) then
begin
Authenticating := False;
AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'U', EncDecStr, EncDecSIdx));
TMyNotify.NotifyStr(#GeneralUserLoggedInNotify, AContext.Binding.PeerIP);
end else
begin
TIdNotify.NotifyMethod(#FailedAuthNotify);
AContext.Connection.Disconnect;
end;
Exit;
end;
//test for commands
if TextStartsWith(S, AssignID) then
begin
//command to assign a new unit id
Tmp := S;
Fetch(Tmp, '-');
NewLoc := Fetch(Tmp, '-');
NewUnit := Tmp;
if (NewLoc = '') or (NewUnit = '') then
begin
NewLoc := DefLocation;
NewUnit := DefUnitNum;
end;
AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx));
TMyNotify.NotifyStr(#RebootNotify, S + #10 + NewLoc + #10 + NewUnit);
end;
end;
Lastly, I would suggest you consider getting rid of all your global variables and heartbeat/authentication timers from the main UI thread. Do timeout handling inside of the OnExecute event itself instead, such as making use of the client's ReadTimeout property and/or CheckForDataOnSource() method. Use the TIdContext.Data property (or derive a new class from TIdServerContext and assign it to the TIdTCPServer.ContextClass property) to keep track of per-connection values, like the last time a heartbeat was received, or whether the client is still authenticating (actually, you should handle authentication in the OnConnect before OnExecute even starts running), or whether the client is logged in as a manager, etc. That will reduce the amount of things that needs to be synchronized with the main UI thread, and avoid any timing issues introduced by delays in sync processing.
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.
Currently I'm trying to make an installer utility that sets the static IP for the Wi-Fi on Inno Setup. I'm having trouble finding a way to make the correct command insert when the Next button of custom page is pressed. The NextButtonClick method is called correctly however when I actually hit the next button on my page it merely exits without executing the query.
procedure InitializeWizard();
var
Page: TInputQueryWizardPage;
ipAddress, subnetMask, defaultGateway, prefferredDNSServer: String;
ResultCode: Integer;
begin
Page := CreateInputQueryPage(wpWelcome,
'Set Network Config', 'A window for setting the wifi configuration',
'Please indicate the IP address and press next when finished.');
{ Add items (False means it's not a password edit) }
Page.Add('IP Address:', False);
Page.Add('Subnet mask:', False);
Page.Add('Default gateway:', False);
Page.Add('Preferred DNS server:', False);
{ Set initial values (optional) }
Page.Values[0] := ExpandConstant('0.0.0.0');
ipAddress := Page.Values[0]
Page.Values[1] := ExpandConstant('0.0.0.0');
subnetMask := Page.Values[1]
Page.Values[2] := ExpandConstant('0.0.0.0');
defaultGateway := Page.Values[2]
Page.Values[3] := ExpandConstant('0.0.0.0');
prefferredDNSServer := Page.Values[3]
if NextButtonClick(Page.ID) then
begin
Exec('cmd.exe',
'/k ' + 'netsh interface ip set address "Wi-Fi" static ' + ipAddress + ' ' +
subnetMask + ' ' + defaultGateway + ' ' + prefferredDNSServer,
'', SW_SHOW, ewWaitUntilTerminated, ResultCode)
end;
end;
function NextButtonClick(CurPageID: Integer): Boolean;
var
ipAddress, subnetMask, defaultGateway, prefferredDNSServer: String;
ResultCode: Integer;
begin
Result := True
Log('NextButtonClick(' + IntToStr(CurPageID) + ') called');
case CurPageID of
100:
{ ipAddress := getParams(ipAddress); }
{ setWifi(ipAddress, subnetMask, defaultGateway, prefferredDNSServer); }
Result:= True;
end;
end;
You do not call the NextButtonClick function yourself. It's an event function, so it's called by Inno Setup.
The code should be like:
var
NetPage: TInputQueryWizardPage;
procedure InitializeWizard();
begin
NetPage :=
CreateInputQueryPage(wpWelcome,
'Set Network Config', 'A window for setting the wifi configuration',
'Please indicate the IP address and press next when finished.');
{ Add items (False means it's not a password edit) }
NetPage.Add('IP Address:', False);
NetPage.Add('Subnet mask:', False);
NetPage.Add('Default gateway:', False);
NetPage.Add('Preferred DNS server:', False);
{ Set initial values (optional) }
NetPage.Values[0] := ExpandConstant('0.0.0.0');
NetPage.Values[1] := ExpandConstant('0.0.0.0');
NetPage.Values[2] := ExpandConstant('0.0.0.0');
NetPage.Values[3] := ExpandConstant('0.0.0.0');
end;
function NextButtonClick(CurPageID: Integer): Boolean;
var
ipAddress, subnetMask, defaultGateway, prefferredDNSServer: String;
ResultCode: Integer;
Command: string;
begin
Result := True;
if CurPageID = NetPage.ID then
begin
ipAddress := NetPage.Values[0];
subnetMask := NetPage.Values[1];
defaultGateway := NetPage.Values[2];
prefferredDNSServer := NetPage.Values[3];
Command :=
'netsh interface ip set address "Wi-Fi" static ' +
ipAddress + ' ' + subnetMask + ' ' + defaultGateway + ' ' + prefferredDNSServer;
Exec('cmd.exe', '/C ' + Command, '', SW_SHOW, ewWaitUntilTerminated, ResultCode)
end;
end;
Though, in general, you should do any changes to the target system, until the user confirms the installation by clicking "Install" on the "Ready to Install" page.
While you can use CurPageID = wpReady for that, a more idiomatic approach is using CurStepChanged(ssInstall) (or ssPostInstall):
procedure CurStepChanged(CurStep: TSetupStep);
var
ipAddress, subnetMask, defaultGateway, prefferredDNSServer: String;
ResultCode: Integer;
Command: string;
begin
if CurStep = ssInstall then
begin
ipAddress := NetPage.Values[0];
subnetMask := NetPage.Values[1];
defaultGateway := NetPage.Values[2];
prefferredDNSServer := NetPage.Values[3];
Command :=
'netsh interface ip set address "Wi-Fi" static ' +
ipAddress + ' ' + subnetMask + ' ' + defaultGateway + ' ' + prefferredDNSServer;
Exec('cmd.exe', '/C ' + Command, '', SW_SHOW, ewWaitUntilTerminated, ResultCode)
end;
end;
I'm trying to make an Inno Setup installer that is capable of sending some logs, and also a bug report text for which I made a custom page:
In the following code I'm trying to import a function that I found in (MSDN) SmtpMail.Send Method, but without success:
var
ExtraPage : TInputQueryWizardPage;
RichEditViewer: TRichEditViewer;
labelchar,max_char:TLabel;
Installer_bug,Content_bug: TNewRadioButton;
function SetFocus(hWnd: HWND): HWND;external 'SetFocus#user32.dll stdcall';
function GetSystemMetrics (nIndex: Integer): Integer;external 'GetSystemMetrics#User32.dll stdcall setuponly';
//function Send(message: MailMessage); external 'Send#System.Web.dll stdcall setuponly';
procedure isAt(Sender: TObject; var Key: Char);
begin
if Key ='#' then begin
Key := #0;
SetFocus(ExtraPage.Edits[4].Handle);
end;
end;
procedure NumbersOnly(Sender:TObject; var Key: Char);
var s:string;
begin
s := ('1234567890'#8);
if pos(key,s) =0 then
Key:=#0;
end;
procedure OffsetPageItem(Page: TInputQueryWizardPage; Index, Offset: Integer);
begin
//Labels
Page.PromptLabels[Index].SetBounds(10,Offset,55,30);
//Name field
Page.Edits[Index].SetBounds(100,Offset,200,40);
//Resolution field
if Index=1 then
Page.Edits[Index].SetBounds(100,Offset,40,40);
Page.Edits[Index].MaxLength:=4
//x field
if Index=2 then begin
Page.Edits[Index].SetBounds(160,Offset,40,40);
Page.PromptLabels[Index].SetBounds(145,Offset+3,10,20);
Page.Edits[Index].MaxLength:=4
end;
//E-Mail field
if Index=3 then begin
Page.Edits[Index].SetBounds(100,Offset,130,40);
if not (Pos('#',Page.Values[Index])=0) then
Page.Edits[Index+1].SelectAll;
end;
//# field
if Index=4 then begin
Page.Edits[Index].SetBounds(250,Offset,70,40);
Page.PromptLabels[Index].SetBounds(235,Offset+3,10,20);
end;
//Description field
if Index=5 then begin
ExtraPage.PromptLabels[index].SetBounds(10,Offset+15,80,60);
ExtraPage.Edits[Index].Hide;
RichEditViewer := TRichEditViewer.Create(ExtraPage);
RichEditViewer.ScrollBars:=ssVertical;
with RichEditViewer do begin
Parent:=ExtraPage.Surface;
SetBounds(100,Offset+25,300,100);
Text:='Having a bug? Write it here... ';
MaxLength:=400;
end;
end;
end;
procedure InitializeWizard;
var
index:Integer;
begin
ExtraPage := CreateInputQueryPage(wpWelcome, 'E-mail sender','Add The following information!','');
ExtraPage.SubCaptionLabel.Hide;
//index=0;
index:=ExtraPage.Add('Name: ', False);
ExtraPage.Values[index]:=ExpandConstant('{computername}');
OffsetPageItem(ExtraPage,index,10);
//index=1;
index:=ExtraPage.Add('Resolution: ', False);
OffsetPageItem(ExtraPage,index,40);
ExtraPage.Values[index]:=IntToStr(GetSystemMetrics(0));
ExtraPage.Edits[index].OnKeyPress:=#NumbersOnly;
//index=2;
index:=ExtraPage.Add(' x ', False);
OffsetPageItem(ExtraPage,index,40);
ExtraPage.Values[index]:=IntToStr(GetSystemMetrics(1));
ExtraPage.Edits[index].OnKeyPress:=#NumbersOnly;
//index=3;
index:=ExtraPage.Add('E-mail: ', False);
OffsetPageItem(ExtraPage,index,70);
ExtraPage.Edits[index].OnKeyPress:=#isAt;
//index=4;
index:=ExtraPage.Add('#', False);
OffsetPageItem(ExtraPage,index,70);
ExtraPage.Edits[index].OnKeyPress:=#isAt;
//index=5;
index:=ExtraPage.Add('Short Description:'+#10+'(How to reproduce?)', False);
OffsetPageItem(ExtraPage,index,100);
labelchar:=TLabel.Create(WizardForm);
with labelchar do begin
Parent:=ExtraPage.Surface;
SetBounds(10,200,100,30);
Caption:='Max number of'+#10#13+'characters: ';
end;
max_char:=TLabel.Create(WizardForm);
with max_char do begin
Parent:=ExtraPage.Surface;
Font.Style:=[fsBold];
SetBounds(68,213,100,30);
Caption:=IntToStr(400);
end;
Installer_bug:=TNewRadioButton.Create(WizardForm)
with Installer_bug do begin
Parent := ExtraPage.Surface;
SetBounds(100,100,80,20);
Caption:='Installer bug'
end;
Content_bug:=TNewRadioButton.Create(WizardForm)
with Content_bug do begin
Parent := ExtraPage.Surface;
SetBounds(190,100,80,20);
Caption:='Content bug'
end;
end;
function NextButtonClick(CurPageID: Integer): Boolean;
var
line:String;
// E_mail :MailMessage;
begin
Result := True;
if CurPageID = ExtraPage.ID then begin
line:=ExtraPage.PromptLabels[0].Caption + ExtraPage.Values[0] + #10;
line:=line + ExtraPage.PromptLabels[1].Caption + ExtraPage.Values[1] + ExtraPage.PromptLabels[2].Caption+ExtraPage.Values[2] + #10;
line:=line + ExtraPage.PromptLabels[3].Caption + ExtraPage.Values[3] + ExtraPage.PromptLabels[4].Caption+ExtraPage.Values[4] + #10;
line:=line +'Type: ';
if Installer_bug.Checked then
line:=line + Installer_bug.Caption + #10;
if Content_bug.Checked then
line:=line + Content_bug.Caption + #10;
line:=line + ExtraPage.PromptLabels[5].Caption + #10#13;
line:=line + RichEditViewer.Text;
SaveStringToFile(ExpandConstant('{src}\test.txt'),line,false);
// E_mail:=MailMessage.Create(WizardForm);
// E_mail.From= "test#sdsd.com"
// E_mail.To = "test#gmail.com"
// E_mail.Subject="test";
// SmtpMail.SmtpServer= "MyMailServer";
// SmtpMail.Send(E_mail);
end;
end;
I ran into same issue this is what I did...
bmail:
bmail -s smtp.example.net -t you#example.com -f me#example.net -h ^
-a "mail subject" -b "message text"
You could also write your own mailer to execute.
[Run]
begin
// need to email Version
// blat -to %eMail% -f %eMail% %subj% %server% %debug% %x%
ExtractTemporaryFile('blat.exe');
connExe:=ExpandConstant('{tmp}')+'\blat.exe';
connTxt := ' -to ' + E_mail.From.text + ' -f '+ E_mail.To.Text + E_mail.Subject.Text + 'SmtpMail.SmtpServer.text' + ExpandConstant('{tmp}\log.log');
Log('The Value is connTxt: ' + connTxt );
if Exec(connExe, connTxt, '' , SW_HIDE, ewWaitUntilTerminated, ResultCode) then
begin
//MsgBox(IntToStr(ResultCode), mbError, mb_Ok);
connTxt := ' -to ' + E_mail.From.text + ' -f '+ E_mail.To.Text + E_mail.Subject.Text + 'SmtpMail.SmtpServer.text' + ExpandConstant('{tmp}\log.log');
ExpandConstant('{tmp}\log.log');
Log('The Value is connTxt: ' + connTxt );
if Exec(connExe, connTxt, '' , SW_HIDE, ewWaitUntilTerminated, ResultCode) then
begin
MsgBox( 'The '+ E_mail.Subject.Text + ' Email has been sent' , mbInformation, mb_Ok);
result := True;
end;
end;
end;
warning the names where change to address the question and has not been fully test as is.
#TLama is right but why not use the application to send the debug messages?