Topic: Close program at a specific time - code snippets

I've hit a problem where users are forgetting to close the program when they leave work. This is partly due to the fact the IT department forbid PC's from being shutdown and must only go to screenlock.

Here is my code for people who would like to fiddle or use it as is in their own program. There is a time span during which the program will automatically close. This is to allow for some flexibility in the event someone stays later or doesn't finish on time.

It also allows for someone staying back to still use the program if they forget to untick the timepickers, it will just close during the timespan but not afterwards.

The call to the procedures are run in a timer called every 20 seconds at the moment. The reference to 'ClearLogs' is a procedure that deletes the user from the database tables user log entry.

The auto close code:

procedure AutoCloseSet;
var
    TmeCompare : string;
begin   {if timedate pickers are unchecked, this code is ignored}
    if (frmAutoCloseSet.dtCloseSpanBegin.Checked) or (frmAutoCloseSet.dtCloseSpanEnd.Checked) then
    begin
       TmeCompare := TimeToStr(Time); //Time now
       if (TmeCompare > TimeToStr(frmAutoCloseSet.dtCloseSpanBegin.DateTime)) and  (TmeCompare < TimeToStr(frmAutoCloseSet.dtCloseSpanEnd.DateTime)) then
       begin
         ClearLogs;  //delete user from user logs table
         frmMain.Close;   //close the program
      end;
    end;
end;

The set up form has two date time pickers where the user can choose their own time span for auto close or untick the option all together.

This form has:

procedure frmAutoCloseSet_OnShow (Sender: TObject; Action: string);
begin   {Add one hour onto begin time span when form first opens. This is to prevent the possibility of Autoclosing before time has beenset}
    frmAutoCloseSet.dtCloseSpanBegin.DateTime := frmAutoCloseSet.dtCloseSpanBegin.DateTime + EncodeTime(1,0,0,0);
end;

The timer code:

procedure OnTimer;
begin

     iSeconds := iSeconds + 1;
     
     AutocloseSet;
     if iSeconds > 30 then
     begin
       // other code here requiring timer
          iSeconds := 0;
     end;
end;

Timer set up in main form onshow:

 Timer := TTimer.Create (frmMain);
     Timer.Interval := 20000;
     Timer.Enabled := True;
     Timer.OnTimer := @OnTimer;

Hope that might be useful for someone.

On a clear disk you can seek forever

Re: Close program at a specific time - code snippets

To give users a warning that the program is about to close add this line between ClearLgs and frmMain.Close.

MessageDlgTimeOut('Closing program','WARNING',1,10000);


The flaw with this code at the moment, is that it needs to be set each time the program is started, So the start... finish times either need to be entered into a table or added to the settings.ini file or as a registry entry.

On a clear disk you can seek forever

Re: Close program at a specific time - code snippets

Looks very useful. Thanks

Re: Close program at a specific time - code snippets

Thanks Alan,


I have added some code to make the times permanent by storing them in the _user table.

To this end, two extra columns are added to the table. In my case

closeStart and CloseEnd both of type TIME.

To save the time from the date pickers I've used the OnExit event, which requires clicking out of the date time picker. On reflection it is probably better to either test for the enter key being pressed or create two buttons that update the database. However, the current code is:

procedure frmAutoCloseSet_dtCloseSpanEnd_OnExit (Sender: TObject);
begin
  SQLExecute('UPDATE  _user SET closeEnd = "'+TimeToStr(frmAutoCloseSet.dtCloseSpanEnd.DateTime)+'" WHERE username = "'+ application.User.Username +'"');
end;

procedure frmAutoCloseSet_dtCloseSpanBegin_OnExit (Sender: TObject);
begin
  frmMain.lbTimeClose.Caption :=  frmMain.lbTimeClose.Caption + TimeToStr(frmAutoCloseSet.dtCloseSpanBegin.DateTime);
  SQLExecute('UPDATE  _user SET closeStart = "'+TimeToStr(frmAutoCloseSet.dtCloseSpanBegin.DateTime)+'" WHERE username = "'+ application.User.Username +'"');
end;

In the main forms OnShow event the following code is used. Note, if a default time is set in the database for all users, the Try...Except....End construct is not needed.  Without this as the database and code currently stand, you will get an error informing you that datetime cannot be ''''' if no time has been saved to the database.


try
     frmAutoCloseset.dtCloseSpanBegin.DateTime := strToDateTime(SQLExecute('SELECT closeStart FROM _user WHERE username = "'+application.User.Username+'"'));
     frmAutoCloseset.dtCloseSpanEnd.DateTime := strToDateTime(SQLExecute('SELECT closeEnd FROM _user WHERE username = "'+application.User.Username+'"'));
     frmMain.lbTimeClose.Caption :=  frmMain.lbTimeClose.Caption + TimeToStr(frmAutoCloseSet.dtCloseSpanBegin.DateTime);
   except
     frmAutoCloseset.dtCloseSpanBegin.DateTime :=  Time;
     frmAutoCloseset.dtCloseSpanEnd.DateTime := (Time + 1);
     frmMain.lbTimeClose.Caption :=  frmMain.lbTimeClose.Caption + ' ';
   end;
On a clear disk you can seek forever

Re: Close program at a specific time - code snippets

Hello CDB, I am interest to your   Close program at a specific time - code snippets script.
But I don't know  how do I make the project.  can you give me this sample project ?
thanks a lot

from
agusecc

6 (edited by CDB 2020-12-04 22:46:50)

Re: Close program at a specific time - code snippets

Sorry for the delay Agusec, 

Here is a bare bones example.  I've only used one date picker in this example, and the code is activated by the button click, rather than the on_exit in the sample code above.


The current code assumes you have set your Windows clock to display 24 hour time, otherwise this code will close your program twice a day

Post's attachments

Attachment icon agusec.zip 340 kb, 261 downloads since 2020-12-04 

On a clear disk you can seek forever