我有一个应用程序,可以检测是否有另一个应用程序运行的实例,如果找到一个,则退出。这部分似乎可靠地工作。我的应用程序采用命令行参数,我想传递给已经运行的实例。到目前为止,我有以下代码:
program Project1;
uses
...
AppInstanceControl in 'AppInstanceControl.pas';
if not AppInstanceControl.RestoreIfRunning(Application.Handle) then
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFormMain, FormMain);
Application.Run;
end;
end.
unit AppInstanceControl;
interface
uses
Windows,
SysUtils;
function RestoreIfRunning(const AAppHandle: THandle; const AMaxInstances: integer = 1): boolean;
implementation
uses
Messages;
type
PInstanceInfo = ^TInstanceInfo;
TInstanceInfo = packed record
PreviousHandle: THandle;
RunCounter: integer;
end;
var
UMappingHandle: THandle;
UInstanceInfo: PInstanceInfo;
UMappingName: string;
URemoveMe: boolean = True;
function RestoreIfRunning(const AAppHandle: THandle; const AMaxInstances: integer = 1): boolean;
var
LCopyDataStruct : TCopyDataStruct;
begin
Result := True;
UMappingName := StringReplace(
ParamStr(0),
'\',
'',
[rfReplaceAll, rfIgnoreCase]);
UMappingHandle := CreateFileMapping($FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(TInstanceInfo),
PChar(UMappingName));
if UMappingHandle = 0 then
RaiseLastOSError
else
begin
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
UInstanceInfo := MapViewOfFile(UMappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));
UInstanceInfo^.PreviousHandle := AAppHandle;
UInstanceInfo^.RunCounter := 1;
Result := False;
end
else //already runing
begin
UMappingHandle := OpenFileMapping(
FILE_MAP_ALL_ACCESS,
False,
PChar(UMappingName));
if UMappingHandle <> 0 then
begin
UInstanceInfo := MapViewOfFile(UMappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));
if UInstanceInfo^.RunCounter >= AMaxInstances then
begin
URemoveMe := False;
if IsIconic(UInstanceInfo^.PreviousHandle) then
ShowWindow(UInstanceInfo^.PreviousHandle, SW_RESTORE);
SetForegroundWindow(UInstanceInfo^.PreviousHandle);
end
else
begin
UInstanceInfo^.PreviousHandle := AAppHandle;
UInstanceInfo^.RunCounter := 1 + UInstanceInfo^.RunCounter;
Result := False;
end
end;
end;
end;
if (Result) and (CommandLineParam <> '') then
begin
LCopyDataStruct.dwData := 0; //string
LCopyDataStruct.cbData := 1 + Length(CommandLineParam);
LCopyDataStruct.lpData := PChar(CommandLineParam);
SendMessage(UInstanceInfo^.PreviousHandle, WM_COPYDATA, Integer(AAppHandle), Integer(@LCopyDataStruct));
end;
end; (*RestoreIfRunning*)
initialization
finalization
//remove this instance
if URemoveMe then
begin
UMappingHandle := OpenFileMapping(
FILE_MAP_ALL_ACCESS,
False,
PChar(UMappingName));
if UMappingHandle <> 0 then
begin
UInstanceInfo := MapViewOfFile(UMappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));
UInstanceInfo^.RunCounter := -1 + UInstanceInfo^.RunCounter;
end
else
RaiseLastOSError;
end;
if Assigned(UInstanceInfo) then UnmapViewOfFile(UInstanceInfo);
if UMappingHandle <> 0 then CloseHandle(UMappingHandle);
end.
procedure TFormMain.WMCopyData(var Msg: TWMCopyData);
var
LMsgString: string;
begin
Assert(Msg.CopyDataStruct.dwData = 0);
LMsgString := PChar(Msg.CopyDataStruct.lpData);
//do stuff with the received string
end;
我很确定问题是我正在尝试将消息发送到正在运行的应用程序实例的句柄,但是尝试在主窗体上处理消息。我想我有两个选择:
A)从应用程序的句柄以某种方式获取其主窗体的句柄并在那里发送消息。
B)处理在应用程序而不是主表单级别接收消息。
我不确定如何去做。有更好的方法吗?
发布于 2018-08-23 14:58:16
发送字符串
procedure IPCSendMessage(target: HWND; const message: string);
var
cds: TCopyDataStruct;
begin
cds.dwData := 0;
cds.cbData := Length(message) * SizeOf(Char);
cds.lpData := Pointer(@message[1]);
SendMessage(target, WM_COPYDATA, 0, LPARAM(@cds));
end;
接收字符串
procedure TForm1.WMCopyData(var msg: TWMCopyData);
var
message: string;
begin
SetLength(message, msg.CopyDataStruct.cbData div SizeOf(Char));
Move(msg.CopyDataStruct.lpData^, message[1], msg.CopyDataStruct.cbData);
// do something with the message e.g.
Edit1.Text := message;
end;
根据需要修改以发送其他数据。
发布于 2018-08-23 15:40:38
请查看此搜索返回的链接:http://www.google.com/search?q=delphi+dde
https://stackoverflow.com/questions/-100000645
复制相似问题