For everybody thats need to limit the instance number of your application:

uses SysUtils, TLHelp32;
 
function AppRunningCount(const AExeName: string): integer;
var
  hSnap: THandle;
  p32: TProcessEntry32;
begin
  Result := 0;
  hSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  p32.dwSize := Sizeof(TProcessEntry32);
  Process32First(hSnap, p32);
  repeat
    if SameText(AExeName, ExtractFileName(p32.szExeFile)) then
      inc(Result);
  until not Process32Next(hSnap, p32);
  CloseHandle(hSnap);
end;

Use:

// On DPR
// Limit to 1 instance
begin 
  if AppRunningCount(ExtractFileName(ParamStr(0))) = 1 then
  begin
  // Application codes
  end;
end.

Explaining more about this approach:
In a situation of multiples logons at the same machine the Mutex cannot provide a correctly singleton structure because the mutex handle still only under the local scope of the user. So the way to control the instance number is counting the number of times the process appear on the process list of the machine.

A light for everybody. First of all, I’ll use two other usefull functions I posted on this site:

And now the magic:

uses Windows, TLHelp32;
 
type
  TWalkOnHandlesCallback = function(AHwnd, AParentHWnd: HWND;
    AClass, AText: string; AFlag: Integer): boolean of object;
 
function WalkOnHandles(AParent: HWND; AFlag: integer;
  ACallback: TWalkOnHandlesCallback): Integer;
var
  CurrHWnd: HWND;
begin
  Result := 0;
  CurrHWnd := GetTopWindow(AParent);
  while CurrHWnd <> 0 do
  begin
    Result := Result + 1;
    if Assigned(ACallback) then
      if not ACallback(CurrHWnd, AParent,
        GetHwndClass(CurrHWnd), GetHwndText(CurrHWnd), AFlag) then
        Break;
    CurrHWnd := GetNextWindow(CurrHWnd, GW_HWNDNEXT);
  end;
end;
 
function WalkOnHandlesOfExe(AExeName: string; AFlag: integer;
  ACallback: TWalkOnHandlesCallback): Integer;
var
  PID, CheckPID: DWord;
  hSnapShot: THandle;
  ProcessEntry: TProcessEntry32;
  CurrHWnd: HWND;
begin
  Result := 0;
  PID := 0;
  hSnapShot := CreateToolhelp32Snapshot((TH32CS_SNAPALL), 0);
  ProcessEntry.dwSize := SizeOf(TProcessEntry32);
  Process32First(hSnapShot, ProcessEntry);
  repeat
    if ProcessEntry.szExeFile = AExeName then
    begin
      PID := ProcessEntry.th32ProcessID;
      Break;
    end;
  until Process32Next(hSnapShot, ProcessEntry) = false;
  CloseHandle(hSnapShot);
 
  if PID > 0 then
  begin
    CurrHWnd := GetTopWindow(GetDesktopWindow);
    while CurrHWnd <> 0 do
    begin
      Result := Result + 1;
      GetWindowThreadProcessID(CurrHWnd, @CheckPID);
      if CheckPID = PID then
        if Assigned(ACallback) then
          if not ACallback(CurrHWnd, 0,
            GetHwndClass(CurrHWnd), GetHwndText(CurrHWnd), AFlag) then
            Break;
      CurrHWnd := GetNextWindow(CurrHWnd, GW_HWNDNEXT);
    end;
  end;
end;

Now let me explain what this big code do.

This code its only a light, a simple idea, about how you can navigate through the Windows Objects (Handle) from everywhere.

A simple example:

  TForm1 = class(TForm)
    mmoLog: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    function WalkCall(AHwnd, AParentHWnd: HWND;
      AClass, AText: string; AFlag: Integer): boolean;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WalkOnHandlesOfExe('delphi32.exe', 0, WalkCall);
end;
 
function TForm1.WalkCall(AHwnd, AParentHWnd: HWND; AClass,
  AText: string; AFlag: Integer): boolean;
begin
  Result := True;
  mmoLog.Lines.Add(stringofChar(' ', AFlag)  + Format('%d: [ %s ] %s', [AHwnd, AClass, AText]));
  WalkOnHandles(AHwnd, AFlag + 2, WalkCall);
end;

This example will list all Windows Objects on the Delphi application and will result a idented log on the mmoLog.

Simple uhm?

This code below implement a singleton structure for the aplication, and that need to be implemented on the DPR file of the project:

uses Windows;
 
function AppSingleton(ACheckPath: boolean = false): boolean;
var
  s: string;
  i, iLast: Cardinal;
begin
  s := ParamStr(0);
  iLast := 1;
  case Integer(ACheckPath) of
    0: for i := 1 to Length(s) do if s[i] = '\' then iLast := i;
    1: for i := 1 to Length(s) do if s[i] in [':','\','.',' '] then s[i] := '_';
  end;
  Result := (CreateMutex(nil, true, PChar(Cardinal(@s) + (iLast - 1))) <> 0) and
    (GetLastError = 0);
end;

I use the CreateMutex API that works as a semaphore, if open, the application is unique, if closed the application is already running.

I wrote a condition to check the full path of the application for the Mutex call, so if you want to check the full path use the funciotn with param as True, the default is False and the check will be only on the application exe name.

A little detail about checking the functionality of this function:
Under debug mode the checkout on full path mode will fail and more then one application can be raised. This problem is because the relationship of the application with other program, so the CreateMutex API understand the Process ID is diferent from others.

Get some Shell Folder from Current User or All User ( System ):

uses Registry;
 
type
  TShellFolderType = (
    // User
    sftAppData, sftCookies, sftDesktop, sftFavorites,
    sftNetHood, sftPersonal, sftPrintHood, sftRecent, sftSendTo, sftStartMenu,
    sftTemplates, sftPrograms, sftStartup, sftLocalSettings, sftLocalAppData,
    sftCache, sftHistory, sftMyPictures, sftFonts, sftMyMusic, sftCDBurning,
    sftMyVideo, sftAdminTools,
    // System
    sftCommonAppData, sftCommonPrograms, sftCommonDocuments, sftCommonDesktop,
    sftCommonStartMenu, sftCommonPictures, sftCommonMusic, sftCommonVideo,
    sftCommonFavorites, sftCommonStartup, sftCommonTemplates,
    sftCommonAdminTools, sftCommonPersonal);
 
 
function GetShellFolder(AShellFolderType: TShellFolderType): string;
begin
  with TRegistry.Create do
  begin
    if AShellFolderType <= sftAdminTools then
      RootKey := HKEY_CURRENT_USER
    else
      RootKey := HKEY_LOCAL_MACHINE;
 
    OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', True);
    case AShellFolderType of
      sftAppData       : Result := ReadString('AppData');
      sftCookies       : Result := ReadString('Cookies');
      sftDesktop       : Result := ReadString('Desktop');
      sftFavorites     : Result := ReadString('Favorites');
      sftNetHood       : Result := ReadString('NetHood');
      sftPersonal      : Result := ReadString('Personal');
      sftPrintHood     : Result := ReadString('PrintHood');
      sftRecent        : Result := ReadString('Recent');
      sftSendTo        : Result := ReadString('SendTo');
      sftStartMenu     : Result := ReadString('Start Menu');
      sftTemplates     : Result := ReadString('Templates');
      sftPrograms      : Result := ReadString('Programs');
      sftStartup       : Result := ReadString('Startup');
      sftLocalSettings : Result := ReadString('Local Settings');
      sftLocalAppData  : Result := ReadString('Local AppData');
      sftCache         : Result := ReadString('Cache');
      sftHistory       : Result := ReadString('History');
      sftMyPictures    : Result := ReadString('My Pictures');
      sftFonts         : Result := ReadString('Fonts');
      sftMyMusic       : Result := ReadString('My Music');
      sftCDBurning     : Result := ReadString('CD Burning');
      sftMyVideo       : Result := ReadString('My Video');
      sftAdminTools    : Result := ReadString('Administrative Tools');
 
      // System
      sftCommonAppData    : Result := ReadString('Common AppData');
      sftCommonPrograms   : Result := ReadString('Common Programs');
      sftCommonDocuments  : Result := ReadString('Common Documents');
      sftCommonDesktop    : Result := ReadString('Common Desktop');
      sftCommonStartMenu  : Result := ReadString('Common Start Menu');
      sftCommonPictures   : Result := ReadString('CommonPictures');
      sftCommonMusic      : Result := ReadString('CommonMusic');
      sftCommonVideo      : Result := ReadString('CommonVideo');
      sftCommonFavorites  : Result := ReadString('Common Favorites');
      sftCommonStartup    : Result := ReadString('Common Startup');
      sftCommonTemplates  : Result := ReadString('Common Templates');
      sftCommonAdminTools : Result := ReadString('Common Administrative Tools');
      sftCommonPersonal   : Result := ReadString('Personal');
    end;                                                     
  end;
end;

Get Windows’s System32 Directory as Path ( \ at end)

var
  WinSystem32PathStr: string = '';
 
function WinSystem32Path: string;
begin
  if WinSystem32PathStr = '' then
  begin
    SetLength(Result, MAX_PATH);
    SetLength(Result, GetSystemDirectory(PChar(Result), MAX_PATH));
    WinSystem32PathStr := Result + '\';
  end;
  Result := WinSystem32PathStr;
end;

Get the Windows Directory as Path ( \ at end ):

var
  WindowsPathStr: string = '';
 
function WindowsPath: string;
begin
  if WindowsPathStr = '' then
  begin
    SetLength(Result, MAX_PATH);
    SetLength(Result, GetWindowsDirectory(PChar(Result), MAX_PATH));
    WindowsPathStr := Result + '\';
  end;
  Result := WindowsPathStr;
end;

Get the program and command line of a shortcurt file (.LNK)

uses ActiveX, ComObj, ShlObj;
 
function GetShortcutCmd(AShortcutPath: string): string;
var
  ShellLink: IUnknown;
  Win32Data: TWin32FindData;
  Buff: array [0..MAX_PATH*2] of Char;
begin
  ShellLink := CreateComObject(CLSID_ShellLink);
  with (ShellLink as IShellLink), (ShellLink as IPersistFile) do
  begin
    Load(PWChar(WideString(AShortcutPath)), 0);
    GetPath(@Buff[0], MAX_PATH, Win32Data, SLGP_UNCPRIORITY);
    GetArguments(@Buff[MAX_PATH], MAX_PATH);
    Result := Trim(PChar(@Buff) + ' ' + PChar(@Buff[MAX_PATH]));
  end;
end;

Get the Class Name of the Window Object ( Handle )

uses Windows;
 
function GetHwndClass(AHandle: HWND): string;
begin
  SetLength(Result, 255);
  GetClassName(AHandle, PChar(Result), 255);
  Result := StrPas(PChar(Result));
end;

The first of a serie of usefull functions, that I’ll provide here.

Get the Text ( Caption ) of a Windows Object ( Handle )

uses Windows;
 
 
function GetHwndText(AHandle: HWND): string;
var
  iLen: integer;
begin
  iLen := GetWindowTextLength(AHandle);
  SetLength(Result, iLen);
  GetWindowText(AHandle, PChar(Result), iLen + 1);
end;