Взгляните на tfdeploy
.
Это облегченный пакет, который позволяет вам развертывать модели тензорного потока как вызываемый объект, используя numpy
(что является более разумной зависимостью)
.
Вы не должны создавать отображение файла при использовании WM_COPYDATA. Это - смысл WM_COPYDATA - он делает все это для Вас.
Отправить строку
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;
Измените по мере необходимости для отправки других данных.
Я закончил тем, что сохранил дескриптор MainForm в запись InstanceInfo в файле, отображающем затем отправку сообщения на основной дескриптор формы предыдущего экземпляра, если был тот.
В проекте dpr:
if not AppInstanceControl.RestoreIfRunning(Application.Handle) then
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFormMain, FormMain);
SetRunningInstanceMainFormHandle(FormMain.Handle);
Application.Run;
end else
SendMsgToRunningInstanceMainForm('Message string goes here');
type
PInstanceInfo = ^TInstanceInfo;
TInstanceInfo = packed record
PreviousHandle: THandle;
PreviousMainFormHandle: THandle;
RunCounter: integer;
end;
procedure SetRunningInstanceMainFormHandle(const AMainFormHandle: THandle);
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^.PreviousMainFormHandle := AMainFormHandle;
end;
end;
procedure SendMsgToRunningInstanceMainForm(const AMsg: string);
var
LCopyDataStruct : TCopyDataStruct;
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));
LCopyDataStruct.dwData := 0; //string
LCopyDataStruct.cbData := 1 + Length(AMsg);
LCopyDataStruct.lpData := PChar(AMsg);
SendMessage(UInstanceInfo^.PreviousMainFormHandle, WM_COPYDATA, Integer(Application.Handle), Integer(@LCopyDataStruct));
end;
end;
Это, кажется, работает надежно. Я собирался отправить полный источник, но я хотел бы включить часть кода gabr, который похож на него, намного более надежно устанавливает фокус на рабочий экземпляр сначала.
Оказывается, что это действительно трудно сделать надежно. Я просто провел два часа, пытаясь вытащить все незначительные сбои из пятиминутного решения :( Кажется, работает теперь, все же.
Код ниже работ в D2007 оба с новым стилем (MainFormOnTaskbar = Верный) и подход старого стиля. Поэтому я полагаю, что это будет также работать в более старой версии Delphi. Это было протестировано с приложением в минимизированном и нормальном состоянии.
Тестовый проект доступен по http://17slon.com/krama/ReActivate.zip (меньше чем 3 КБ).
Для чтения онлайн, индексируя цели и резервное копирование, все важные единицы присоединяются ниже.
program ReActivate;
uses
Forms,
GpReActivator,
raMain in 'raMain.pas' {frmReActivate};
{$R *.res}
begin
if ReactivateApplication(TfrmReActivate, WM_REACTIVATE) then
Exit;
Application.Initialize;
Application.MainFormOnTaskbar := True;
// Application.MainFormOnTaskbar := False;
Application.CreateForm(TfrmReActivate, frmReActivate);
Application.Run;
end.
unit raMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
WM_REACTIVATE = WM_APP;
type
TfrmReActivate = class(TForm)
private
public
procedure ReActivate(var msg: TMessage); message WM_REACTIVATE;
end;
var
frmReActivate: TfrmReActivate;
implementation
{$R *.dfm}
uses
GpReactivator;
{ TfrmReActivate }
procedure TfrmReActivate.ReActivate(var msg: TMessage);
begin
GpReactivator.Activate;
end;
end.
unit GpReActivator;
interface
uses
Classes;
procedure Activate;
function ReActivateApplication(mainFormClass: TComponentClass; reactivateMsg: cardinal):
boolean;
implementation
uses
Windows,
Messages,
SysUtils,
Forms;
type
TProcWndInfo = record
ThreadID : DWORD;
MainFormClass: TComponentClass;
FoundWindow : HWND;
end; { TProcWndInfo }
PProcWndInfo = ^TProcWndInfo;
var
fileMapping : THandle;
fileMappingResult: integer;
function ForceForegroundWindow(hwnd: THandle): boolean;
var
foregroundThreadID: DWORD;
thisThreadID : DWORD;
timeout : DWORD;
begin
if GetForegroundWindow = hwnd then
Result := true
else begin
// Windows 98/2000 doesn't want to foreground a window when some other
// window has keyboard focus
if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)))) then
begin
// Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
// Converted to Delphi by Ray Lischner
// Published in The Delphi Magazine 55, page 16
Result := false;
foregroundThreadID := GetWindowThreadProcessID(GetForegroundWindow,nil);
thisThreadID := GetWindowThreadPRocessId(hwnd,nil);
if AttachThreadInput(thisThreadID, foregroundThreadID, true) then begin
BringWindowToTop(hwnd); //IE 5.5 - related hack
SetForegroundWindow(hwnd);
AttachThreadInput(thisThreadID, foregroundThreadID, false);
Result := (GetForegroundWindow = hwnd);
end;
if not Result then begin
// Code by Daniel P. Stasinski <dannys@karemor.com>
SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), SPIF_SENDCHANGE);
BringWindowToTop(hwnd); //IE 5.5 - related hack
SetForegroundWindow(hWnd);
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
end;
end
else begin
BringWindowToTop(hwnd); //IE 5.5 - related hack
SetForegroundWindow(hwnd);
end;
Result := (GetForegroundWindow = hwnd);
end;
end; { ForceForegroundWindow }
procedure Activate;
begin
if (Application.MainFormOnTaskBar and (Application.MainForm.WindowState = wsMinimized))
or
((not Application.MainFormOnTaskBar) and (not IsWindowVisible(Application.MainForm.Handle)))
then
Application.Restore
else
Application.BringToFront;
ForceForegroundWindow(Application.MainForm.Handle);
end; { Activate }
function IsTopDelphiWindow(wnd: HWND): boolean;
var
parentWnd: HWND;
winClass : array [0..1024] of char;
begin
parentWnd := GetWindowLong(wnd, GWL_HWNDPARENT);
Result :=
(parentWnd = 0)
or
(GetWindowLong(parentWnd, GWL_HWNDPARENT) = 0) and
(GetClassName(parentWnd, winClass, SizeOf(winClass)) <> 0) and
(winClass = 'TApplication');
end; { IsTopDelphiWindow }
function EnumGetProcessWindow(wnd: HWND; userParam: LPARAM): BOOL; stdcall;
var
procWndInfo: PProcWndInfo;
winClass : array [0..1024] of char;
begin
procWndInfo := PProcWndInfo(userParam);
if (GetWindowThreadProcessId(wnd, nil) = procWndInfo.ThreadID) and
(GetClassName(wnd, winClass, SizeOf(winClass)) <> 0) and
IsTopDelphiWindow(wnd) and
(string(winClass) = procWndInfo.MainFormClass.ClassName) then
begin
procWndInfo.FoundWindow := Wnd;
Result := false;
end
else
Result := true;
end; { EnumGetProcessWindow }
function GetThreadWindow(threadID: cardinal; mainFormClass: TComponentClass): HWND;
var
procWndInfo: TProcWndInfo;
begin
procWndInfo.ThreadID := threadID;
procWndInfo.MainFormClass := mainFormClass;
procWndInfo.FoundWindow := 0;
EnumWindows(@EnumGetProcessWindow, LPARAM(@procWndInfo));
Result := procWndInfo.FoundWindow;
end; { GetThreadWindow }
function ReActivateApplication(mainFormClass: TComponentClass; reactivateMsg: cardinal):
boolean;
var
mappingData: PDWORD;
begin
Result := false;
if fileMappingResult = NO_ERROR then begin // first owner
mappingData := MapViewOfFile(fileMapping, FILE_MAP_WRITE, 0, 0, SizeOf(DWORD));
Win32Check(assigned(mappingData));
mappingData^ := GetCurrentThreadID;
UnmapViewOfFile(mappingData);
end
else if fileMappingResult = ERROR_ALREADY_EXISTS then begin // app already started
mappingData := MapViewOfFile(fileMapping, FILE_MAP_READ, 0, 0, SizeOf(DWORD));
if mappingData^ <> 0 then begin // 0 = race condition
PostMessage(GetThreadWindow(mappingData^, mainFormClass), reactivateMsg, 0, 0);
Result := true;
end;
UnmapViewOfFile(mappingData);
Exit;
end
else
RaiseLastWin32Error;
end; { ReActivateApplication }
initialization
fileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
SizeOf(DWORD), PChar(StringReplace(ParamStr(0), '\', '', [rfReplaceAll, rfIgnoreCase])));
Win32Check(fileMapping <> 0);
fileMappingResult := GetLastError;
finalization
if fileMapping <> 0 then
CloseHandle(fileMapping);
end.
Весь код выпущен к общественному достоянию и может использоваться без и соображения лицензирования.
Почему Вы не используете DDE? Смотрите на ссылки, возвращенные этим поиском: http://www.google.com/search?q=delphi+dde