Передача строки к уже рабочему экземпляру приложения

Взгляните на tfdeploy .

Это облегченный пакет, который позволяет вам развертывать модели тензорного потока как вызываемый объект, используя numpy (что является более разумной зависимостью)

.

11
задан lukeck 21 October 2008 в 03:52
поделиться

4 ответа

Вы не должны создавать отображение файла при использовании 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;

Измените по мере необходимости для отправки других данных.

12
ответ дан 3 December 2019 в 04:54
поделиться

Я закончил тем, что сохранил дескриптор 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');

AppInstanceControl.pas

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, который похож на него, намного более надежно устанавливает фокус на рабочий экземпляр сначала.

2
ответ дан 3 December 2019 в 04:54
поделиться

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

Код ниже работ в 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.

Весь код выпущен к общественному достоянию и может использоваться без и соображения лицензирования.

8
ответ дан 3 December 2019 в 04:54
поделиться

Почему Вы не используете DDE? Смотрите на ссылки, возвращенные этим поиском: http://www.google.com/search?q=delphi+dde

1
ответ дан 3 December 2019 в 04:54
поделиться
Другие вопросы по тегам:

Похожие вопросы: