1cloud
» Общение между запущенными копиями своих программ. Borland Delphi. Win Api. . Блог программистов


Блог программистов




20071 Mar

Общение между запущенными копиями своих программ.

Рассматривать задачу будем на конкретном примере некого приложения.

Опишем предметную область и постановку задачи:

необходимо чтобы наше приложение, зарегистрировав себя как протокол в системе Windows, позволяло при нажатии на ссылкуу вида testproject:\\xxxxx запустило наше приложение (если оно не запущено) и передало ему параметры ссылки. Если же приложение уже запущено, то нам не обходимо запущеной копии приложения сообщить параметры ссылки.

Ну чтож, задачу описали, приступим к реализации.

Для примера я буду использовать BDS 2006.

Создадим новый проект.

Сначала нам необходимо зарегистрироваться в реестре, чтобы система воспринимала правильно наши ссылки, поэтому:

в uses главной формы дописываем модуль registry

в событии onactivate главной формы пишем:

procedure Tfstart.FormActivate(Sender: TObject);
var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_Classes_Root;
if not(reg.KeyExists(‘testproject’)) then
begin
reg.OpenKey(‘testproject’,true);
reg.WriteString(”,’URL:testproject Protocol’);
reg.WriteString(‘URL Protocol’,”);
reg.OpenKey(‘DefaultIcon’,true);
reg.WriteString(”,application.ExeName);
reg.CloseKey;
reg.OpenKey(‘testproject\shell\open\command’,true);
reg.WriteString(”,application.ExeName+’ %1′);
reg.CloseKey;
end;
reg.Free;
end;

Соответственно мы имеем зарегистрированный в системе протокол под названием testproject.

Проверить это можно достаточно простым способом:

Открываем любой браузер и в адресной строке набираем “testproject:\\eee” и запустится ваша программа.

Теперь продолжим. Нам необходимо опеределять запущена ли наша программа уже или нет. Для решения подобной задачи существует множество способов, но я предпочитаю способ с использованием mutex-ов. Не буду сейчас вдавать в подробности описания мьютексов и их использования. Итак, заходим в код самого нашего проекта и пишем там:

program testproject;

uses
Forms,windows,
Ustart in ‘Ustart.pas’ {fstart};

{$R *.res}
var HM: THandle;
function Check: boolean;
begin
HM := OpenMutex(MUTEX_ALL_ACCESS, false, ‘TestProjectMutex’);
Result := (HM <> 0);
if HM = 0 then HM := CreateMutex(nil, false, ‘TestProjectMutex’);
end;

begin
Application.Initialize;
Application.CreateForm(Tfstart, fstart);
Application.Run;
end.

Итак, в результате у нас есть функция, возвращающая true если копия проекта запущена и false если это первая копия.

Теперь далее: нам необходимо понять запущено ли приложение с сылки или просто кто- то запустил наш exe.

Проверяется это достаточно просто: при запуске с сылки в наше приложение будет передан параметр коммандной строки, в котором будет сдержаться полностью строка ссылки, поэтому нам необходимо здесь обработать только один вариант: когда программа запущена с сылки и это уже не первая копия программы, т.е. пишем условие:

if (check)and(paramcount>0) then

begin

end;

Итак, что же мы будем делать если такой процесс уже есть? Нам соответсвенно необходимо каким- то образом сообщить запущенному процессу те параметры, которые нам передали. Отсюда встает вопрос: нам необходимо знать Handle нашего уже запущенного приложения. Здесь все подвластно исключительно вашей фантазии, так как сделать это можно сколь угодно множеством способов. Я выберу далеко не лучший, но для примера: я буду хранить handle в реестре. для этого модифицируем сначала onactivate нашей главной формы:

procedure Tfstart.FormActivate(Sender: TObject);
var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_Classes_Root;
if not(reg.KeyExists(‘testproject’)) then
begin
reg.OpenKey(‘testproject’,true);
reg.WriteString(”,’URL:testproject Protocol’);
reg.WriteString(‘URL Protocol’,”);
reg.OpenKey(‘DefaultIcon’,true);
reg.WriteString(”,application.ExeName);
reg.CloseKey;
reg.OpenKey(‘testproject\shell\open\command’,true);
reg.WriteString(”,application.ExeName+’ %1′);
reg.CloseKey;
end;
reg.RootKey:=HKEY_current_user;
reg.OpenKey(‘software\testproject’,true);
reg.WriteInteger(‘handle’,fstart.Handle);
reg.CloseKey;

reg.Free;
end;

далее добавим обработчик события CloseQuery нашей формы:

procedure Tfstart.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_current_user;
reg.OpenKey(‘software\testproject’,true);
reg.WriteInteger(‘handle’,0);
reg.CloseKey;
reg.Free;
end;

таким образом при закрытии программы мы будем обнулять наш handle.

теперь вернемся к коду нашего проекта. Итак, нам необходимо если это не первая копия приложения, прочитать handle и отправить ему сообщение с параметрами коммандной строки. Приведу сразу код:

program testproject;

uses
Forms,windows,registry,sysutils,messages,
Ustart in ‘Ustart.pas’ {fstart};

{$R *.res}
var HM,HForm: THandle;
reg:tregistry;
ParamCmd:TCopyDataStruct;

function Check: boolean;
begin
HM := OpenMutex(MUTEX_ALL_ACCESS, false, ‘TestProjectMutex’);
Result := (HM <> 0);
if HM = 0 then HM := CreateMutex(nil, false, ‘TestProjectMutex’);
end;
begin
if (check)and(paramcount>0) then
begin

{Читаем handle запущенного приложения}

reg:=tregistry.Create;
reg.RootKey:=HKEY_current_user;
reg.OpenKey(‘software\testproject’,true);
HForm:=reg.ReadInteger(‘handle’);
reg.CloseKey;
reg.Free;

{Состовляем структуру данных ParamCmd}

with ParamCmd do
begin
dwData := 0;
cbdata:=strlen(pchar(paramstr(1)))+1;
lpData:=pchar(paramstr(1));
end;

{Посылаем сообщение запущеной программе}

SendMessage(HForm, WM_COPYDATA,application.Handle,longint(@ParamCmd));
Exit;
end;
Application.Initialize;
Application.CreateForm(Tfstart, fstart);
Application.Run;
end.

Вот собственно и почти все. Сейчас наше приложение умеет уже обрабатывать полученные данные и отправлять ихзапущенной копии приложения.

Но нам так же необходимо, чтобы наша запущенная копия получила эти данные, поэтому дополним код модуля нашей основной формы:

unit Ustart;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,registry, StdCtrls;

type
Tfstart = class(TForm)
Label1: TLabel;
procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
protected
procedure Getmessage(var msg: TWMCopyData); message WM_COPYDATA;

private
{ Private declarations }
public
{ Public declarations }
end;

var
fstart: Tfstart;

implementation

{$R *.dfm}

procedure Tfstart.FormActivate(Sender: TObject);
var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_Classes_Root;
if not(reg.KeyExists(‘testproject’)) then
begin
reg.OpenKey(‘testproject’,true);
reg.WriteString(”,’URL:testproject Protocol’);
reg.WriteString(‘URL Protocol’,”);
reg.OpenKey(‘DefaultIcon’,true);
reg.WriteString(”,application.ExeName);
reg.CloseKey;
reg.OpenKey(‘testproject\shell\open\command’,true);
reg.WriteString(”,application.ExeName+’ %1′);
reg.CloseKey;
end;
reg.RootKey:=HKEY_current_user;
reg.OpenKey(‘software\testproject’,true);
reg.WriteInteger(‘handle’,fstart.Handle);
reg.CloseKey;
reg.Free;
if paramcount>0 then
label1.Caption:=paramstr(1); //Если это первая копия программы то мы можем сразу смело обрабатывать наши параметры

end;

procedure Tfstart.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_current_user;
reg.OpenKey(‘software\testproject’,true);
reg.WriteInteger(‘handle’,0);
reg.CloseKey;
reg.Free;
end;
procedure tfstart.Getmessage(var msg: TWMCopyData);
var
sText: array[0..99] of Char;
begin
StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData); //Преобразуем полученные данные в строку

label1.Caption:=stext;
end;

end.

Вот собственно и все можем достаточно просто проверить:

Запустим первую копию нашего приложения, а затем в браузере наберем testproject:\\TEST и увидим как на нашей запущенной форме покажется этот текст.

Надеюсь что эта информация пригодится вам.

Комментарии

  1. March 2nd, 2007 | 10:33

    Это статья опубликована в рассылке ))

  2. Spok
    March 3rd, 2007 | 15:47

    Обращаю Ваше внимание на то, что в данной статье присутствует грубейшая ошибка, сводящая на “НЕТ” саму идею межпроцессной синхронизации, в следующем коде:

    var HM: THandle;
    function Check: boolean;
    begin
    HM := OpenMutex(MUTEX_ALL_ACCESS, false, ‘TestProjectMutex’);
    Result := (HM 0);
    if HM = 0 then HM := CreateMutex(nil, false, ‘TestProjectMutex’);
    end;

    (сначала – OpenMutex. Потом принятие решения на основе OpenMutex – HM0 , а потом выводы на осное решения – CreateMutex. А что будет, если другой поток будет исполняться с опозданием, например, ровно на одну инструкцию процессора? ). В подобных случаях необходимо сразу создавать мьютекс (CreateMutex) и принимать решение на основании возвращённого значения и значения кода ошибки в GetLastError() (уничтожая его посредством CloseHandle, если он оказывается ненужным (т.е. во втором… (не первом) ) экземпляре запущенной программы).

  3. Квэнди
    March 4th, 2007 | 09:23

    А теперь прочитайте смысл статьи и для каких целей здесь используется Mutex ) речь идет не о распределении потоков.

  4. altera
    February 14th, 2008 | 16:23

    А если произойдёт аварийное выключение программы, свет выключат или комп на restart выйдет…. в реестре останится handel!
    И нельзя ли просто отправить строку (string) без преобразований?

  5. altera
    August 9th, 2011 | 10:03

    Я тупой или не понимаю смысла(( Как можно без реестра еще передавать хендл запущенной ранее программы?! Вместо StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData); можно написать для строк так
    var
    sStr : Pointer;
    begin
    sStr := msg.CopyDataStruct^.lpData;
    label1.Caption:=PChar(PStr);
    end;

  6. February 7th, 2012 | 16:22

    Я НОВИЧЕК.КУДА, НА КАКОЙ ЛИСТ.?ХОЧУ С САМОГО НАЧАЛА.

Ответить

 


1cloud