program ApplicationsAgent;

uses
 Forms, Windows, SysUtils, Classes, Messages, StrUtils;
//  untMain in 'untMain.pas' {Form1};

{$R *.res}

function WriteToFile(NameFile,str1:string):boolean;
//печать строки в файл
var ft:textfile;
   s:string;
   y:boolean;
begin
   s:=NameFile; AssignFile(ft,s);
   try
       if (LeftStr(NameFile,2)<>'\\') And (Copy(NameFile,2,1)<>':') then s := ExtractFilePath(Application.ExeName) + s;
       {$I-}
       if FileExists(s) then Append(ft) else Rewrite(ft);
       {$I+}
       y := IOResult = 0; if y then Writeln(ft,str1);
   except y:=false; end;
   if y then CloseFile(ft); Result:=y;
end;

function ExistExecutingApplication(Alias:string; var hFileMapObj: THandle):THandle;
//Проверка на выполнение приложения по псевдониму Alias
//Результат - Handle приложения которое уже выполняется, 0 - приложение не выполняется
var lpBaseAddress: PChar; //"указатель" на начальный адрес данных
   yExist:boolean;
   i:integer;
//hFileMapObj: THandle; //описатель FileMapping
begin
  Result:=0;
  //создадим FileMapping с именем Alias и передадим его хэндл в глобальную переменную hFileMapObj
  hFileMapObj := CreateFileMapping(MAXDWORD, nil, PAGE_READWRITE, 0, 4, PChar(Alias));
  if (hFileMapObj = 0) then Exit;  //не удалось создать или открыть FileMapping
  yExist:=GetLastError=ERROR_ALREADY_EXISTS;
  //подключим FileMapping к адресному пространству и получим начальный адрес данных
  lpBaseAddress := MapViewOfFile(hFileMapObj, FILE_MAP_WRITE, 0, 0, 0);
  if lpBaseAddress <> nil then begin
     //переменная типа PChar имеет в конце завершающий #0, значит при считывании данных
     //система сама сможет определить, где находится конец нужных данных
     if Not yExist then begin
        //поместим в адресное пространство Handle приложения
         StrPCopy(lpBaseAddress, IntToStr(Application.Handle));
     end else begin
        //считаем из адресного пространства Handle приложения
        TryStrToInt(PChar(lpBaseAddress),i); Result:=i;
     end;
     //отключим FileMapping от адресного пространства
     UnMapViewOfFile(lpBaseAddress);
  end;
end;

var c:Cardinal;
   i:integer;
   hFileMapObj: THandle; //описатель FaleMapping
   yWork:boolean;
   cmd,appfile,appparams:string;
   AppList:TStringList;
   cd: TCopyDataStruct; pcd: PCopyDataStruct;
   Msg: TMsg;
begin
 //Параметры
 cmd:=Trim(System.ParamStr(1)); appfile:=Trim(System.ParamStr(2)); appparams:=Trim(System.ParamStr(3));
 //Проверка на повторный запуск
 c:=ExistExecutingApplication('ApplicationsAgent',hFileMapObj); yWork:=true;
 if (c>0) then begin
    if Trim(appfile)<>'' then begin
       cd.cbData := Length(appfile)+1;
       cd.lpData := PChar(appfile);
       if AnsiUpperCase(cmd)='ADD' then i:=0 else i:=1;
       PostMessage(c, WM_COPYDATA, i, LParam(@cd));
    end;
    yWork:=false;
 end;
 if yWork then begin
    AppList:=TStringList.Create;
    if Trim(appfile)<>'' then begin
       if AnsiUpperCase(cmd)='ADD'
       then AppList.Add(appfile)
       else AppList.Delete(AppList.IndexOf(appfile));
    end;
    while AppList.Count>0 do begin
//        if GetMessage(Msg,0,0,0) then begin
       if PeekMessage(Msg,0,0,0,PM_REMOVE) then begin
//           WriteToFile('qqq.txt',IntToStr(Msg.message)+' -- '+IntToStr(Msg.wParam));
          case Msg.message of
          WM_COPYDATA: begin
                      pcd := PCopyDataStruct(Msg.LParam);
                      appfile := PChar(pcd.lpData);
                      case Msg.wParam of
                      0: //добавить приложение к слежению
                         AppList.Add(appfile);
                      1: //отменить слежение за приложением
                         AppList.Delete(AppList.IndexOf(appfile));
                      end;
                    end;
          end;
       end;
       for i:=0 to AppList.Count-1 do begin
           WriteToFile('qqq.txt',IntToStr(Application.Handle)+' - '+IntToStr(i)+' - '+AppList[i]);
       end;
       Sleep(500);
    end;
    AppList.Free;
 end;
 //освободим объект FileMapping
 CloseHandle(hFileMapObj);
end.