Browse Source

* Show help-message with default actions when no action is given, IsConsole
is true and there is no OnRun event handler
* Use TCustumApplication.Log method for logging
* Because the logger was freed before exceptions were shown, exceptions were
never logged. Now they are.

git-svn-id: trunk@15588 -

joost 15 years ago
parent
commit
4fc3ef3c18

+ 73 - 43
packages/fcl-extra/src/daemonapp.pp

@@ -329,7 +329,7 @@ Type
   private
     FGUIHandle: THandle;
     FGUIMainLoop: TGuiLoopEvent;
-    FLogger: TEventLog;
+    FEventLog: TEventLog;
     FMapper : TCustomDaemonMapper;
     FOnRun: TNotifyEvent;
     FRunMode: TDaemonRunMode;
@@ -357,20 +357,22 @@ Type
     Procedure CreateServiceMapper(Var AMapper : TCustomDaemonMapper); virtual;
     Procedure CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); virtual;
     Procedure RemoveController(AController : TDaemonController); virtual;
-    procedure SetupLogger;
-    procedure StopLogger;
+    Function GetEventLog: TEventLog; virtual;
     Procedure DoRun; override;
     Property SysData : TObject Read FSysData Write FSysData;
   Public
+    destructor Destroy; override;
     Procedure ShowException(E : Exception); override;
     Function CreateDaemon(DaemonDef : TDaemonDef) : TCustomDaemon;
     Procedure StopDaemons(Force : Boolean);
     procedure InstallDaemons;
     procedure RunDaemons;
     procedure UnInstallDaemons;
+    procedure ShowHelp;
     procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
+    procedure Log(EventType: TEventType; Msg: String); override;
     Property  OnRun : TNotifyEvent Read FOnRun Write FOnRun;
-    Property Logger : TEventLog Read FLogger;
+    Property EventLog : TEventLog Read GetEventLog;
     Property GUIMainLoop : TGuiLoopEvent Read FGUIMainLoop Write FGuiMainLoop;
     Property GuiHandle : THandle Read FGUIHandle Write FGUIHandle;
     Property RunMode : TDaemonRunMode Read FRunMode;
@@ -392,7 +394,7 @@ Procedure DaemonError(Fmt : String; Args : Array of const);
 Resourcestring
   SErrNoServiceMapper           = 'No daemon mapper class registered.';
   SErrOnlyOneMapperAllowed      = 'Not changing daemon mapper class %s with %s: Only 1 mapper allowed.';
-  SErrNothingToDo               = 'Options do not allow determining what needs to be done.';
+  SErrNothingToDo               = 'No command given, use ''%s -h'' for usage.';
   SErrDuplicateName             = 'Duplicate daemon name: %s';
   SErrUnknownDaemonClass        = 'Unknown daemon class name: %s';
   SErrDaemonStartFailed         = 'Failed to start daemon %s : %s';
@@ -404,7 +406,12 @@ Resourcestring
   SErrNoDaemonDefForStatus      = '%s: No daemon definition for status report';
   SErrWindowClass               = 'Could not register window class';
   SErrApplicationAlreadyCreated = 'An application instance of class %s was already created.';
-  
+  SHelpUsage                    = 'Usage: %s [command]';
+  SHelpCommand                  = 'Where command is one of the following:';
+  SHelpInstall                  = 'To install the program as a service';
+  SHelpUnInstall                = 'To uninstall the service';
+  SHelpRun                      = 'To run the service';
+
 { $define svcdebug}
 
 {$ifdef svcdebug}
@@ -647,12 +654,12 @@ end;
 
 procedure TCustomDaemon.LogMessage(Msg: String);
 begin
-  Application.Logger.Error(Msg);
+  Application.Log(etInfo,Msg);
 end;
 
 function TCustomDaemon.GetLogger: TEventLog;
 begin
-  Result:=Application.Logger;
+  Result:=Application.EventLog;
 end;
 
 procedure TCustomDaemon.SetStatus(const AValue: TCurrentStatus);
@@ -756,6 +763,7 @@ Var
 
 begin
   FrunMode:=drmInstall;
+  EventLog.RegisterMessageFile('');
   SysStartInstallDaemons;
   try
     FMapper.DoOnInstall;
@@ -787,6 +795,7 @@ Var
 
 begin
   FrunMode:=drmUnInstall;
+  EventLog.UnRegisterMessageFile;
   SysStartUnInstallDaemons;
   Try
     FMapper.DoOnUnInstall;
@@ -810,6 +819,15 @@ begin
   end;
 end;
 
+procedure TCustomDaemonApplication.ShowHelp;
+begin
+  writeln(Format(SHelpUsage,[ParamStr(0)]));
+  writeln(SHelpCommand);
+  writeln('  -i --install   '+SHelpInstall);
+  writeln('  -u --uninstall '+SHelpUnInstall);
+  writeln('  -r --run       '+SHelpRun);
+end;
+
 procedure TCustomDaemonApplication.CreateForm(InstanceClass: TComponentClass;
   var Reference);
   
@@ -830,6 +848,11 @@ begin
   end;
 end;
 
+procedure TCustomDaemonApplication.Log(EventType: TEventType; Msg: String);
+begin
+  EventLog.Log(EventType,Msg);
+end;
+
 Procedure TCustomDaemonApplication.RunDaemons;
 
 Var
@@ -855,57 +878,65 @@ begin
   end;
 end;
 
-procedure TCustomDaemonApplication.SetupLogger;
+function TCustomDaemonApplication.GetEventLog: TEventLog;
 
 begin
-  FLogger:=TEventlog.Create(Self);
-  FLogger.RegisterMessageFile('');
+  if not assigned(FEventLog) then
+    begin
+    FEventLog:=TEventlog.Create(Self);
+    FEventLog.RaiseExceptionOnError:=true;
+    FEventLog.RegisterMessageFile('');
+    end;
+  result := FEventLog;
 end;
 
-procedure TCustomDaemonApplication.StopLogger;
+destructor TCustomDaemonApplication.Destroy;
 
 begin
-  Flogger.Active:=False;
-  FreeAndNil(Flogger);
+  if assigned(FEventLog) then
+    FEventLog.Free;
 end;
 
 procedure TCustomDaemonApplication.DoRun;
 
 begin
-  SetupLogger;
-  Try
-    try
-      If Not Assigned(MapperClass) then
-        DaemonError(SErrNoServiceMapper);
-      CreateServiceMapper(FMapper);
-      If InstallRun then
-        InstallDaemons
-      else If UnInstallRun then
-        UnInstallDaemons
-      else if RunDaemonsRun then
-        RunDaemons
-      else if Assigned(OnRun) then
-       OnRun(Self)
+  try
+    If Not Assigned(MapperClass) then
+      DaemonError(SErrNoServiceMapper);
+    CreateServiceMapper(FMapper);
+    if InstallRun then
+      InstallDaemons
+    else If UnInstallRun then
+      UnInstallDaemons
+    else if RunDaemonsRun then
+      RunDaemons
+    else if Assigned(OnRun) then
+     OnRun(Self)
+    else if HasOption('h','help') then
+      begin
+      if IsConsole then
+        ShowHelp;
+      end
+    else
+      begin
+      if IsConsole then
+        ShowHelp
       else
-        DaemonError(SErrNothingToDo);
-      {$ifdef svcdebug}DebugLog('Terminating');{$endif svcdebug}
-      Terminate;
-      {$ifdef svcdebug}DebugLog('Terminated');{$endif svcdebug}
-    except
-      Terminate;
-      Raise
-    end;
-  Finally
-    StopLogger;
+        DaemonError(SErrNothingToDo,[ParamStr(0)]);
+      end;
+    {$ifdef svcdebug}DebugLog('Terminating');{$endif svcdebug}
+    Terminate;
+    {$ifdef svcdebug}DebugLog('Terminated');{$endif svcdebug}
+  except
+    Terminate;
+    Raise
   end;
 end;
 
 procedure TCustomDaemonApplication.ShowException(E: Exception);
 begin
-  If assigned(Flogger) then
-    FLogger.Error(E.Message)
-  else
-   inherited ShowException(E)
+  Log(etError,E.Message);
+  inherited ShowException(E)
 end;
 
 Procedure TCustomDaemonApplication.CreateDaemonInstance(Var ADaemon : TCustomDaemon; DaemonDef : TDaemonDef); 
@@ -1185,7 +1216,6 @@ begin
         S:=SStatus[ACode]
       else
         S:=Format(SCustomCode,[ACode]);
-      Application.Logger.Error(SControlFailed,[S,E.Message]);
       end;
   end;
 end;

+ 1 - 1
packages/fcl-extra/src/unix/daemonapp.inc

@@ -196,7 +196,7 @@ begin
     With FDaemon do
       S:=Format(SDaemonStatus,[Definition.DisplayName,
                                CurrentStatusNames[Status]]);
-  Application.Logger.Info(S);
+  Application.Log(etInfo,S);
 end;
 
 { ---------------------------------------------------------------------

+ 7 - 8
packages/fcl-extra/src/win/daemonapp.inc

@@ -37,8 +37,7 @@ begin
   If (Nil<>lpContext) then
     TDaemonController(lpContext).Controller(dwControl,dwEventType,lpEventData)
   else
-    If Assigned(Application.Logger) then
-      Application.Logger.Error(SerrNoControlContext,[dwControl,dwEventType,ptrint(lpEventData)]);
+    Application.Log(etError,Format(SerrNoControlContext,[dwControl,dwEventType,ptrint(lpEventData)]));
 end;
 
 Procedure ServiceMainEntry(Argc : DWord; Args : Pchar); stdcall;
@@ -427,7 +426,7 @@ begin
     {$ifdef svcdebug}DebugLog('SysRun Terminating');{$endif svcdebug}
     Terminate;
     If (RV<>0) then
-      Logger.Error(SErrServiceManagerStartFailed,[SysErrorMessage(RV)]);
+      Log(etError,Format(SErrServiceManagerStartFailed,[SysErrorMessage(RV)]));
   Finally
     FreeMem(P);
   end;
@@ -504,7 +503,7 @@ begin
     FParams.Add(StrPas(Args[I]));
   H:=RegisterServiceCtrlHandlerEx(Args[0],@ServiceControlHandlerEntry,Self);
   if (H=0) then
-    Application.Logger.Error(SErrRegisterHandler,[getlasterror]);
+    Application.Log(etError,Format(SErrRegisterHandler,[getlasterror]));
   FSysData:=TSCMData.Create(H);
   FDaemon.Status:=csStartPending;
   Try
@@ -567,13 +566,13 @@ Const
 begin
   If not Assigned(FDaemon) then
     begin
-    Application.Logger.Error(SErrNoDaemonForStatus,[Name]);
+    Application.Log(etError,Format(SErrNoDaemonForStatus,[Name]));
     Exit;
     end;
   DD:=FDaemon.Definition;
   If not Assigned(DD) then
     begin
-    Application.Logger.Error(SErrNoDaemonDefForStatus,[Name]);
+    Application.Log(etError,Format(SErrNoDaemonDefForStatus,[Name]));
     Exit;
     end;
   DD.LogStatusReport:=True;
@@ -583,7 +582,7 @@ begin
     With FDaemon do
       begin
       S:=Format(SDaemonStatus,[Definition.DisplayName, CurrentStatusNames[Status]]);
-      Application.Logger.Info(S);
+      Application.Log(etInfo,S);
       {$ifdef svcdebug}DebugLog(S);{$endif svcdebug}
       end;
   FillChar(SS,SizeOf(SS),0);
@@ -609,7 +608,7 @@ begin
     else
       dwWin32ExitCode := WB.Win32ErrCode;
     if not SetServiceStatus(TSCMData(FSysData).FHandle, SS) then
-      Application.Logger.Error(SysErrorMessage(GetLastError));
+      Application.Log(etError,SysErrorMessage(GetLastError));
   end;
 end;