var AtomText: array[0..31] of Char;

procedure LookForInstance;
var
 InstanceWindow : hWnd;
 AppName : array[0..30] of char;
 FoundAtom : TAtom;
begin
 // помещаем имя приложения в AtomText
 StrFmt(AtomText, 'OnlyOne%s', [Copy(Application.Title,1,20)]);
 // Проверяем, не создано ли уже атома с таким именем приложения
 FoundAtom := GlobalFindAtom(AtomText);
 if FoundAtom <> 0 then  // эта копия приложения уже запущена
 begin
  StrFmt(AppName,'%s', [Application.Title]);
  // изменяем текущий заголовок, чтобы FindWindow не видела его
  Application.ShowMainForm := false;
  Application.Title := 'destroy me';
  // ищем предыдущую копию приложения
  InstanceWindow := FindWindow(nil,AppName);
  // Передаём фокус на предыдущую копию приложения
  // завершаем текущую копию
  Application.Terminate;
  if InstanceWindow <> 0 then
  if IsIconic(InstanceWindow) then
  ShowWindow(InstanceWindow,SW_RESTORE)
  else SetForegroundWindow(InstanceWindow);
 end;
 // создаём глобальный атом, чтобы предотвратить запуск другой копии приложения
 FoundAtom := GlobalAddAtom(AtomText);
end;


constructor TForm.Create(AOwner: TComponent);
begin
 inherited;
 LookForInstance;
 ...
end;

destructor TForm.Destroy;
var
 FoundAtom : TAtom;
 ValueReturned : word;
begin
 // не забудьте удалить глобальный атом
 FoundAtom := GlobalFindAtom(AtomText);
 if FoundAtom <> 0 then ValueReturned := GlobalDeleteAtom(FoundAtom);
 inherited Destroy;
end;

begin

 if HPrevInst <> 0 then

  begin

  ActivateInstance;

  Halt;

  end;

end;

unit PrevInst;

interface

uses

 WinProcs,

 WinTypes,

 SysUtils;

type

 PHWnd = ^HWnd;

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;

procedure ActivateInstance;

implementation

function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;

var

 ClassName: array[0..30] of char;

begin

 Result := true;

 if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then

  begin

  GetClassName(Wnd, ClassName, 30);

  if STRIComp(ClassName, 'TApplication') = 0 then

  begin

  TargetWindow^ := Wnd;

  Result := false;

  end;

  end;

end;

procedure ActivateInstance;

var

 PrevInstWnd: HWnd;

begin

 PrevInstWnd := 0;

 EnumWindows(@EnumApps, LongInt(@PrevInstWnd));

 if PrevInstWnd <> 0 then

  if IsIconic(PrevInstWnd) then

  ShowWindow(PrevInstWnd, SW_Restore)

  else

  BringWindowTo(PrevInstWnd);

end;

end.