Гость
Форумы / Delphi [игнор отключен] [закрыт для гостей] / SendMesssage по-китайски :) / 25 сообщений из 53, страница 1 из 3
24.12.2021, 12:25
    #40122690
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Приложение слушатель delphi 10.3 VCL:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

const
   MY_MESSAGE = WM_USER + 42;

type
  TForm1 = class(TForm)


  procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MessageReceiver(var msg: TMessage);
var
 txt: PChar;
begin
  //Получение сообщения
  txt := PChar(msg.lParam);
  msg.Result := 1;
  ShowMessage(txt);
end;

end.



Приложение отправитель delphi 10.4 VCL:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
var
  h: HWND;
  txt: string;
begin
  txt := '123';
  var winTitle := '1212';
  h:=FindWindow(nil, PWideChar(winTitle));
  if h <> 0
    then caption := 'Нашел ' + winTitle
    else caption := 'НЕТ ' + winTitle;

  SendMessage(h, MY_MESSAGE, 0, DWORD(PChar(txt)));



Если в одном приложении делать, все нормально, если в разных, то на получателе выходят китайские кракозябры

Можно как-т победить?
...
Рейтинг: 0 / 0
24.12.2021, 12:43
    #40122701
Barmaley57
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
И что ты хочешь прочитать по данному адресу в адресном пространстве приложения-получателя?
...
Рейтинг: 0 / 0
24.12.2021, 12:45
    #40122702
Barmaley57
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
В догонку: WM_COPYDATA спасает в таких случаях
...
Рейтинг: 0 / 0
24.12.2021, 12:51
    #40122705
ъъъъъ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox,

ну ты даёшь. :)
Отправляешь в другое приложение адрес своей строки, и...?
...
Рейтинг: 0 / 0
24.12.2021, 13:06
    #40122715
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Barmaley57
В догонку: WM_COPYDATA спасает в таких случаях


Не понял, как юзать это? Можно примерчик?
...
Рейтинг: 0 / 0
24.12.2021, 13:10
    #40122718
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
...
Рейтинг: 0 / 0
24.12.2021, 13:10
    #40122719
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
ъъъъъ
antox,

ну ты даёшь. :)
Отправляешь в другое приложение адрес своей строки, и...?


Надеялся на получение строки :)
...
Рейтинг: 0 / 0
24.12.2021, 13:11
    #40122721
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox
Надеялся на получение строки :)
Разные адресные пространства.
...
Рейтинг: 0 / 0
24.12.2021, 13:28
    #40122727
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)


Отправляем:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
var
 aCopyData: TCopyDataStruct;
 hTargetWnd: HWND;
begin
 with aCopyData do
 begin
   dwData := 0;
   cbData := StrLen(PChar(edtText.text)) + 1;
   lpData := PChar(edtText.text)
 end;
 // Search window by the window title
// Fenster anhand des Titelzeilentext suchen
//hTargetWnd := FindWindowEx(0, 0, nil, PChar('WM_COPYDATA-Receiver'));
hTargetWnd := FindWindowEx(0, 0, nil, PChar('1212'));
 if hTargetWnd <> 0 then
   SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@aCopyData))
 else
   ShowMessage('No Recipient found!');




Получаем:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
type
  TForm1 = class(TForm)
    lbl1: TLabel;

  procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;

  procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
 sText: array[0..99] of Char;
begin
   // generate text from parameter
  // anzuzeigenden Text aus den Parametern generieren
  StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
   // write received text
  // Empfangenen Text ausgeben
  lbl1.Caption := sText;
end;



Результат нестабильный :) То кусок строки получит, то крокозябры, то цифру вместо нескольких букв
...
Рейтинг: 0 / 0
24.12.2021, 13:29
    #40122728
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Нужно какое-то гарантированное средство передать строку из одного приложения в другое :)
...
Рейтинг: 0 / 0
24.12.2021, 13:34
    #40122729
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Пример небось не юникодный.
Явно длина строки при передаче режется.
Адаптируй.
...
Рейтинг: 0 / 0
24.12.2021, 13:42
    #40122732
ъъъъъ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox
Нужно какое-то гарантированное средство передать строку из одного приложения в другое :)

Что ты мучаешься, COM используй.
...
Рейтинг: 0 / 0
24.12.2021, 14:00
    #40122738
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
// для передачи строки между программами
function GlobalNewString(const Text: string): NativeInt;
var l: Integer;
    p: pointer;
begin
    l := Length(Text)*SizeOfChar;
    if L > SizeOfChar then begin
        Result := GlobalAlloc(GHND, l+SizeOfChar);
        if LongBool(Result) then begin
            {$HINTS OFF}
            p := GlobalLock(Result);
            {$HINTS ON}
            Move(Pointer(Text)^, Pointer(p)^, l);
            GlobalUnlock(Result);
        end
    end else
        Result := 0;
end;

// для передачи строки между программами
function GlobalFreeString(var P: NativeInt): String;
var ps: pointer;
begin
    if LongBool(P) then begin
        {$HINTS OFF}
        ps := GlobalLock(P);
        {$HINTS ON}
        SetLength(Result, Length(PChar(ps)));
        Move(Pointer(ps)^, Pointer(Result)^, Length(Result)*SizeOfChar);
        GlobalUnlock(P);
        P := GlobalFree(P);
    end;
end;
...
Рейтинг: 0 / 0
24.12.2021, 14:18
    #40122745
Softologic
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
wadman
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
// для передачи строки между программами
function GlobalFreeString(var P: NativeInt): String;
var ps: pointer;
begin
    if LongBool(P) then begin
        {$HINTS OFF}
        ps := GlobalLock(P);
        {$HINTS ON}
        SetLength(Result, Length(PChar(ps)));
        Move(Pointer(ps)^, Pointer(Result)^, Length(Result)*SizeOfChar);
        GlobalUnlock(P);
        P := GlobalFree(P);
    end;
end;



А GlobalFreeString делается на стороне приложения-получателя или в исходном?
...
Рейтинг: 0 / 0
24.12.2021, 14:40
    #40122752
GunSmoker
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Вот это жесть в голове...

Рекомендую подтянуть матчасть:
https://www.gunsmoker.ru/2011/04/windows.html
https://www.transl-gunsmoker.ru/2009/09/pchars.html
...
Рейтинг: 0 / 0
24.12.2021, 14:49
    #40122759
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Softologic
А GlobalFreeString делается на стороне приложения-получателя или в исходном?


Судя по ЭТОМУ ТОПИКУ на стороне получателя
...
Рейтинг: 0 / 0
24.12.2021, 14:50
    #40122760
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
ъъъъъ
antox
Нужно какое-то гарантированное средство передать строку из одного приложения в другое :)

Что ты мучаешься, COM используй.


Есть подозрение, что это единственный надежный способ, не подкидывать же файл :) Хотя...
...
Рейтинг: 0 / 0
24.12.2021, 15:00
    #40122764
Мимопроходящий
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox
Есть подозрение, что это единственный надежный способ, не подкидывать же файл :) Хотя...
всё украдено до нас! ©
начни отсюда: https://docs.microsoft.com/en-us/windows/win32/ipc/interprocess-communications
...
Рейтинг: 0 / 0
24.12.2021, 15:01
    #40122766
Barmaley57
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox
Код: pascal
1.
cbData := StrLen(PChar(edtText.text)) + 1;

Ёперный театр!
MSDNcbData

Type: DWORD

The size, in bytes, of the data pointed to by the lpData member.
...
Рейтинг: 0 / 0
24.12.2021, 15:02
    #40122768
Barmaley57
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Отправлять только с помощью SendMessage!
Надеюсь понятно почему?
...
Рейтинг: 0 / 0
24.12.2021, 15:26
    #40122779
antox
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
antox


Отправляем:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
var
 aCopyData: TCopyDataStruct;
 hTargetWnd: HWND;
begin
 with aCopyData do
 begin
   dwData := 0;
   cbData := StrLen(PChar(edtText.text)) + 1;
   lpData := PChar(edtText.text)
 end;
 // Search window by the window title
// Fenster anhand des Titelzeilentext suchen
//hTargetWnd := FindWindowEx(0, 0, nil, PChar('WM_COPYDATA-Receiver'));
hTargetWnd := FindWindowEx(0, 0, nil, PChar('1212'));
 if hTargetWnd <> 0 then
   SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@aCopyData))
 else
   ShowMessage('No Recipient found!');




Получаем:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
type
  TForm1 = class(TForm)
    lbl1: TLabel;

  procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;

  procedure MessageReceiver(var msg: TMessage); message MY_MESSAGE;

  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMCopyData(var Msg: TWMCopyData);
var
 sText: array[0..99] of Char;
begin
   // generate text from parameter
  // anzuzeigenden Text aus den Parametern generieren
  StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
   // write received text
  // Empfangenen Text ausgeben
  lbl1.Caption := sText;
end;



Результат нестабильный :) То кусок строки получит, то крокозябры, то цифру вместо нескольких букв


Разобрался, неверно считал длину данных :)

При отправке вместо

Код: pascal
1.
cbData := StrLen(PChar(edtText.text)) + 1;



надо

Код: pascal
1.
cbData := (Length(edtText.text) + 1) * Sizeof(Char);



Теперь надо между VCL в FMX попробовать
...
Рейтинг: 0 / 0
24.12.2021, 15:26
    #40122780
X-Cite
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Если 10.3 то не надо заморачиваться со строками, гоняем байты, конвертируем в нужные строки..
Можно прям из стринга в стринг копировать, если лень лишние байты выделять
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
procedure TForm2.Button1Click(Sender: TObject);
var
  CopyDataStruct: TCopyDataStruct;
  s: string;
  Bytes: TBytes;
begin
  CopyDataStruct := Default(TCopyDataStruct);
  s := 'Привет Мама. Я ел раков.';
  CopyDataStruct.dwData := 1;
  Bytes := TEncoding.Unicode.GetBytes(s);
  CopyDataStruct.cbData := Length(Bytes);
  CopyDataStruct.lpData := @Bytes[0];
  SendMessage(RemoteHandle, WM_COPYDATA, Handle, LPARAM(@CopyDataStruct))
end;

procedure TForm2.WMCopyData(var aMessage: TWMCopyData);
var
  Bytes: TBytes;
begin
  SetLength(Bytes, aMessage.CopyDataStruct^.cbData);
  Move(aMessage.CopyDataStruct^.lpData^, Bytes[0], Length(Bytes));
  ShowMessage(TEncoding.Unicode.GetString(Bytes));
end;
...
Рейтинг: 0 / 0
24.12.2021, 15:26
    #40122781
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Softologic
wadman
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
// для передачи строки между программами
function GlobalFreeString(var P: NativeInt): String;
var ps: pointer;
begin
    if LongBool(P) then begin
        {$HINTS OFF}
        ps := GlobalLock(P);
        {$HINTS ON}
        SetLength(Result, Length(PChar(ps)));
        Move(Pointer(ps)^, Pointer(Result)^, Length(Result)*SizeOfChar);
        GlobalUnlock(P);
        P := GlobalFree(P);
    end;
end;




А GlobalFreeString делается на стороне приложения-получателя или в исходном?

Не имеет значения.
...
Рейтинг: 0 / 0
24.12.2021, 15:32
    #40122784
X-Cite
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
Из строки в строку можно так
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
procedure TForm2.Button1Click(Sender: TObject);
var
  CopyDataStruct: TCopyDataStruct;
  s: string;
begin
  CopyDataStruct := Default(TCopyDataStruct);
  s := 'Привет Мама. Я ел раков.';
  CopyDataStruct.dwData := 1;
  CopyDataStruct.cbData := Length(s) * StringElementSize(s);
  CopyDataStruct.lpData := PChar(s);
  SendMessage(RemoteHandle, WM_COPYDATA, Handle, LPARAM(@CopyDataStruct))
end;

procedure TForm2.WMCopyData(var aMessage: TWMCopyData);
var
  s: string;
begin
  SetLength(s, aMessage.CopyDataStruct^.cbData div StringElementSize(s));
  Move(aMessage.CopyDataStruct^.lpData^, PChar(s)^, aMessage.CopyDataStruct^.cbData);
  ShowMessage(s);
end;
...
Рейтинг: 0 / 0
24.12.2021, 15:32
    #40122786
rgreat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SendMesssage по-китайски :)
X-Cite,

StringElementSize(s);

Экая хрень....
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / SendMesssage по-китайски :) / 25 сообщений из 53, страница 1 из 3
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]