Рассматривать задачу будем на конкретном примере некого приложения.
Опишем предметную область и постановку задачи:
необходимо чтобы наше приложение, зарегистрировав себя как протокол в системе 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('testprojectshellopencommand',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('testprojectshellopencommand',true);
reg.WriteString(",application.ExeName+' %1?);
reg.CloseKey;
end;
reg.RootKey:=HKEY_current_user;
reg.OpenKey('softwaretestproject',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('softwaretestproject',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('softwaretestproject',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('testprojectshellopencommand',true);
reg.WriteString(",application.ExeName+' %1?);
reg.CloseKey;
end;
reg.RootKey:=HKEY_current_user;
reg.OpenKey('softwaretestproject',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('softwaretestproject',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 и увидим как на нашей запущенной форме покажется этот текст.
Надеюсь что эта информация пригодится вам.
Автор: Квэнди