VPF::Проблема передачи записи через буфер

Khim

Дата 5.9.2011, 16:04 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 9
Регистрация: 13.12.2008

Репутация: нет
Всего: нет

Доброго времени суток!

Запутался. aReserv: String [255]; - пересылаю и получаю фиксированную длину строки. Хотелось бы aReserv: Pointer; aReserv := PChar ('Проверка') пересылается и получается норм. А вот, например:
GetWindowText (Wnd, A, Max_Path);
aReserv := PChar (@A); выдает ошибку.
как мне переслать данные не фиксированной длины?

Заранее спасибо.

Код


unit USendMsg;

interface

Uses
  Windows, Forms, Messages, Clipbrd;


Type
  PRecData = ^TRecData;
  tagRecData = Packed Record
    aFromDll: Boolean; 
    aHandle: LongWord; 
    aMsg: DWord; 
    aReserv: String [255]; 
End;
  TRecData = tagRecData;
  RecData = tagRecdata;


  TMsgForApp = Class
    Procedure CreateForApp;
    Function Hook (Var Msg: TMessage): Boolean;
End;

Var
  WM_RegMsg: PChar;
  DDGData: PChar; 
  CF_DDGDATA: Cardinal; 

  BackReciveProc: Procedure (Msg: DWord; Reserv: String) of object = Nil;
  Procedure SendMsg (Msg: DWord; Const Reserv: String); OverLoad;
  Procedure SendMsg (Const TRD: TRecData); OverLoad; 

implementation

Var
  TMFA: TMsgForApp;
  WM_Msg: DWord;

procedure SendMsg(Msg: DWord; Const Reserv: String);
var
  TRD: TRecdata;
begin
  With TRD Do
  Begin
    aFromDll := Application.MainForm = Nil;
    If aFromDll Then
      aHandle := hInstance
     Else
      aHandle := Application.MainForm.Handle;
    aMsg := Msg;
    aReserv := Reserv;
  End;
  SendMsg (TRD);
end;

Procedure SendMsg (Const TRD: TRecData); 
var
  Hand: THandle;
  DataPtr: Pointer;
Begin
  Hand := GlobalAlloc(GMEM_MOVEABLE, SizeOf(TRecData)); 
  try
    DataPtr := GlobalLock(Hand); 
    try
      Move(TRD, DataPtr^, SizeOf (TRD));
      ClipBoard.Open; 
      try
        ClipBoard.SetAsHandle(CF_DDGDATA, Hand);
      finally
        Clipboard.Close
      end;
    finally
      GlobalUnlock(Hand);
    end;
  except
    GlobalFree(Hand);
    raise;
  end;
  SendMessage (HWnd_BroadCast, WM_MSG, 0, 0);
end;

{ TMsgForApp }

procedure TMsgForApp.CreateForApp;
begin
  Application.HookMainWindow(Hook);
end;

function TMsgForApp.Hook(var Msg: TMessage): Boolean;
var
  Data: THandle;
  DataPtr: Pointer;
  Size: Integer;
  TRD: TRecData;
begin
  Result := False;
  If @BackReciveProc <> Nil Then
  If MSG.Msg = WM_MSG Then
  Begin
    Data := ClipBoard.GetAsHandle(CF_DDGDATA);
    if Data = 0 then
      Exit;
    DataPtr := GlobalLock(Data);
    if SizeOf(TRecData) > GlobalSize(Data) then
      Size := GlobalSize(Data)
    else
      Size := SizeOf(TRecData);
    Move(DataPtr^, TRD, Size);

    IF TRD.aFromDll And (TRD.aHandle = hInstance) Or
      (Not TRD.aFromDll) And (TRD.aHandle = Application.MainForm.Handle) Then
    Begin
      GlobalUnlock (Data);
      Exit;
    End;
{    ShowMessage (IntToStr (TRD.aHandle));
    ShowMessage (IntToStr (TRD.aMsg));
    ShowMessage (PChar (TRD.aReserv));}
    BackReciveProc (TRD.aMsg, TRD.aReserv);
    GlobalUnlock(Data);
  End;
end;

Initialization

  If WM_RegMsg = '' Then
    WM_RegMsg := 'WM_ExMsg';
  WM_MSG := RegisterWindowMessage (WM_RegMsg);
  If DDGData = '' Then
    DDGData := 'CF_ExData';
  CF_DDGDATA := RegisterClipBoardFormat(DDGData);

  TMFA.CreateForApp;

end.

alexnef

Дата 7.9.2011, 21:48 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 28
Регистрация: 14.4.2010

Репутация: нет
Всего: нет

GetWindowText (Wnd, A, Max_Path);

Если А:PChar то конструкция aReserv := PChar (@A) получает указатель на указатель. Попробуй заменить на
aReserv := PChar(A)

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »