paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 04:59:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Introduced ExceptionExitCode

Browse Source 
git-svn-id: trunk@33052 -
This commit is contained in:
michael 2016-02-05 15:30:58 +00:00
parent aa0ec8c0e5
commit ee8652a983
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-base/src/custapp.pp
View File

@ -40,6 +40,7 @@ Type
FOptionChar : Char;
FCaseSensitiveOptions : Boolean;
FStopOnException : Boolean;
FExceptionExitCode : Integer;
function GetEnvironmentVar(VarName : String): String;
function GetExeName: string;
Function GetLocation : String;
@ -64,6 +65,7 @@ Type
procedure Run;
procedure ShowException(E: Exception);virtual;
procedure Terminate; virtual;
procedure Terminate(AExitCode : Integer) ; virtual;
// Extra methods.
function FindOptionIndex(Const S : String; Var Longopt : Boolean; StartAt : Integer = -1) : Integer;
Function GetOptionValue(Const S : String) : String;
@ -97,6 +99,7 @@ Type
Property OptionChar : Char Read FoptionChar Write FOptionChar;
Property CaseSensitiveOptions : Boolean Read FCaseSensitiveOptions Write FCaseSensitiveOptions;
Property StopOnException : Boolean Read FStopOnException Write FStopOnException;
Property ExceptionExitCode : Longint Read FExceptionExitCode Write FExceptionExitCode;
Property EventLogFilter : TEventLogTypes Read FEventLogFilter Write FEventLogFilter;
Property SingleInstance: TBaseSingleInstance read GetSingleInstance;
Property SingleInstanceClass: TBaseSingleInstanceClass read FSingleInstanceClass write SetSingleInstanceClass;
@ -311,7 +314,7 @@ begin
FOnException(Sender,Exception(ExceptObject));
end;
If FStopOnException then
FTerminated:=True;
Terminate(ExceptionExitCode);
end;
@ -358,8 +361,16 @@ begin
end;
procedure TCustomApplication.Terminate;
begin
Terminate(0);
end;
procedure TCustomApplication.Terminate(AExitCode : Integer) ;
begin
FTerminated:=True;
If (AExitCode<>0) then
ExitCode:=AExitCode;
end;
function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;