unit startup;

interface



// Наша функция возвращает PID найденного процесса

// или 0, если процесс не найден.

function AnotherProcessExists: cardinal;



implementation

// Подключаем модули с системными функциями

Uses Forms, SysUtils, Windows, TlHelp32;



function AnotherProcessExists: cardinal;

var h: Cardinal;

    p: tagPROCESSENTRY32;

    fnd: boolean;

    my_name, pr_name: string;

    my_pid: Cardinal;

begin

  result := 0;

// Узнаём свой PID

  my_pid := GetCurrentProcessId;

// Узнаём имя своего процесса. Обьект Application

// должен быть заранее инициализирован.

  my_name := StrRScan(PChar(Application.ExeName), '');

  delete(my_name, 1, 1);



// Делаем снепшот системы.

  h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  p.dwSize := SizeOf(tagPROCESSENTRY32);

// Находим первый процесс.

  fnd := Process32First(h, p);

// Цикл перебора всех процессов в системе.

  while fnd do

  begin

// Узнаём имя найденного процесса.

    pr_name := StrRScan(p.szExeFile, '');

    if pr_name='' then

       pr_name := p.szExeFile else

       delete(pr_name, 1, 1);

// Проверяем имя найденного процесса и сверяем его PID

// с PID-ом нашего процесса.

    if(pr_name = my_name)and(my_pid<>p.th32ProcessID)then

    begin

// Вторая копия нашей программы уже существует,

// заканчиваем цикл и выходим.

      fnd := false;

      result := p.th32ProcessID;

    end else

// Сходий процесс не найден, продолжаем перебор

      fnd := Process32Next(h, p);

  end;

// Закрываем наш снепшот.

  CloseHandle(h);

end;

end.

Теперь изменим свой проект (project1.dpr) для корректного
завершения нашей программы в случае нахождения ещё одной копии:

program Project1;



uses

// Подключаем наш модуль.

  Forms, startup, Windows,

  Unit1 in 'Unit1.pas' {Form1};



{$R *.res}



begin

// Инициализируем обьект Application для корректной работы.

  Application.Initialize;

// Проверяем процессы, если наша программа уже запущена,

// то выводим сообщение и выходим.

  if AnotherProcessExists>0 then

  begin

    MessageBox(0, 'Another Copy Already Running!', 'Error', 0);

    Application.Terminate;

  end else

// Копии программы нет в памяти - нормальный запуск.

  begin

    Application.CreateForm(TForm1, Form1);

    Application.Run;

  end

end.