Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
unit runonce;
{
This is run once code by Glenn9999, as suggested by
http://delphi.about.com/od/windowsshellapi/l/aa100703b.htm
The idea behind this code is to try to make a single unit solution that can
handle any "run once" chores, including making the original program come to
the forefront if a copy of it is run. It is meant to be included only *once*
in the main project source.
Sample usage:
RunOnlyOnce('RunOnceDemo'); // must be at the very first.
Application.Initialize;
Application.CreateForm(TForm1, Form1);
// optionally, this call can be included to bring up the form. If used, it must
// appear before Application.Run.
RegisterBringUpForm(Application);
Application.Run;
}
interface
uses windows, forms;
type
TAppMessageClass = class(TObject)
private
FApplication: TApplication; // store it upon register so AppMessage can use it
public
procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
end;
var
FSemaPhore: THandle;
MyMsg: Cardinal;
MyEvents: TAppMessageClass;
OldMessageEvent: TMessageEvent;
procedure RunOnlyOnce(tagID: String);
procedure RegisterBringUpForm(Application: TApplication);
implementation
procedure RunOnlyOnce(tagID: AnsiString);
// this contains code which has a scheme which reveals whether the program has
// been run previously. Detection is done based on the specific tagID passed
// the routine, which should be uniquely defined within the program.
begin
MyMsg := RegisterWindowMessage(PAnsiChar(tagID));
FSemaPhore := CreateMutex(nil, True, PAnsiChar(tagID));
if ((FSemaPhore = 0) or (GetLastError = ERROR_ALREADY_EXISTS)) then
begin
// another copy of this program is running somewhere. Broadcast my message
// to other windows and shut down.
PostMessage(HWND_BROADCAST, MyMsg, 0, 0);
CloseHandle(FSemaPhore);
ExitProcess(0);
end;
end;
procedure RegisterBringUpForm(Application: TApplication);
// this links code into the Application instance which will cause the program
// to bring up its main form when it receives the message to do so in "RunOnlyOnce"
begin
MyEvents.FApplication := Application;
// save old message event.
OldMessageEvent := Application.OnMessage;
// set message event to ours.
Application.OnMessage := MyEvents.AppMessage;
end;
procedure TAppMessageClass.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
// run old message event if one was present.
if Assigned(OldMessageEvent) then
OldMessageEvent(Msg, Handled);
// message handler: If it's my message, then bring the window up.
if Msg.Message = MyMsg then
begin
FApplication.Restore;
SetForeGroundWindow(FApplication.MainForm.Handle);
Handled := true;
end;
end;
initialization
MyEvents := TAppMessageClass.Create;
finalization
MyEvents.Free;
if FSemaPhore <> 0 then
CloseHandle(FSemaPhore);
end.