//////////////////////////////////////////////////////////
//
// Name        : TlplOnlyOne
// Author      : Christian Aaangel (C.Aaangel@Mailexcite.com)
// Group       : System
// Purpose     : Allow only one program instance
// Version     : 1.01
// Last update : 28 December 2000
//
//////////////////////////////////////////////////////////
//
// What's new:
// 1.00 - initial Release
// 1.01 - Added Override ability
//
//////////////////////////////////////////////////////////
unit lplOnlyOne;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
  TExecute = (pcAutomatic, pcManual);
  TOverride = Procedure (sender: TObject) of Object;
  TAlreadyRunning = Procedure (sender: TObject; ProgramRunning: HWND) of Object;
  TlplOnlyOne = class(TComponent)
  private
   fOverride: TOverride;
   fAlreadyRunning: TAlreadyRunning;
   fOverrideStr: String;
   fExecute: TExecute;
   fTimer: TTimer;
   Procedure SetOverrideStr(Value: String);
   Procedure ExecuteTimer(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    Property OverrideStr: String Read fOverrideStr Write SetOverrideStr;
    Property OnOverride: TOverride Read fOverride Write fOverride;
    Property OnRunning: TAlreadyRunning Read fAlreadyRunning Write fAlreadyRunning;
    Property PerformCheck: TExecute read fExecute Write fExecute;
    Procedure Execute;
  end;

procedure Register;

implementation

const
  AllowedInstances = 1;
  OverrideStr = '/MultipleInstances';

var
  MyAppName, MyClassName: array[0..255] of Char;
  NumFound: Integer;
  LastFound: HWND;

function LookAtAllWindows(Handle: HWND; Temp: LongInt): BOOL; stdcall;
var
  WindowName, ClassName: Array[0..255] of Char;
begin
  // Go get the windows class name
  if GetClassName(Handle, ClassName, SizeOf(ClassName)) > 0 then
    // Is the window class the same ?
    if StrComp(ClassName, MyClassName) = 0 then
      // Get its window caption
      if GetWindowText(Handle, WindowName, SizeOf(WindowName)) > 0 then
        // Does this have the same window title ?
        if StrComp(WindowName, MyAppName) = 0 then
          begin
            inc(NumFound);
            // Are the handles different ?
            if Handle <> Application.Handle then
              // Save it so we can bring it to the top later.
              LastFound := Handle;
          end;
  result := true;
end;

procedure Register;
begin
  RegisterComponents('LPL Tools', [TlplOnlyOne]);
end;

Procedure TlplOnlyOne.SetOverrideStr(Value: String);
Begin
 If Value > '' Then begin
  If Value[1] <> '/' then Value := '/' + Value;
  fOverrideStr := Value;
 end
  else fOverrideStr := '';
End;

Procedure TlplOnlyOne.ExecuteTimer(Sender: TObject);
Begin
 fTimer.Enabled := False;
 fTimer.Free;
 If (Not (csDesigning in componentstate)) And (fExecute = pcAutomatic) Then Execute;
End;

constructor TlplOnlyOne.Create(AOwner: TComponent);
begin
 inherited create(aOwner);
 fTimer := TTimer.Create(Self);
 fTimer.Interval := 100;
 fTimer.OnTimer := ExecuteTimer;
end;

Destructor TlplOnlyOne.Destroy;
Begin
 inherited destroy;
End;

Procedure TlplOnlyOne.Execute;
Var
 ICount: Integer;
Begin
  NumFound := 0; LastFound := 0;
  // Set Window text, so that it will also detect if the
  // file has been renamed
  SetWindowText(Application.Handle, PChar(Application.Title));
  // Determine what this application'name is.
  GetWindowText(Application.Handle, MyAppName, SizeOf(MyAppName));
  // Now determine the class name for this application
  GetClassName(Application.Handle, MyClassName, SizeOf(MyClassName));
  // Now count how many others out there are Delphi apps with this title
  EnumWindows(@LookAtAllWindows, 0);
  If fOverrideStr <> '' then begin
   For ICount := 1 to paramcount do Begin
    If Uppercase(ParamStr(ICount)) = uppercase(fOverrideStr) then Begin
     Try
      fOverride(Self);
     Except
      on EAccessViolation do begin
       showmessage('Component has overriden itself');
      End;
     End;
     Exit;
    End;
   End;
  End;
//  Showmessage(IntToStr(NumFound));
  if NumFound > AllowedInstances then begin
   Try
    fAlreadyRunning(self, LastFound);
   Except
    on EAccessViolation do begin
     setForeGroundWindow(LastFound);
     Application.Terminate;
    End;
   End;
  end;
End;

end.
