Контроль буфера обмена

[AndrzejX]

Всем привет! Написал простую программку для контроля буфера - содержится ли там определённая текстовая фраза. Программка должна висеть в памяти, но при этом, естественно, не мешать обычной работе. Проверка:

try
 if ClipBoard.asText='Нужная фраза'
  then ...
except
end;

Всё работает. Но при попытке, например при работе в Word'е, поместить что-либо в буфер происходит задержка в несколько секунд. Это не называется "не мешать". Можно ли что-то сделать?

[KORN]

как ты отслеживаешь изменение буфера7

[AndrzejX]

Запускаю цикл и проверяю как в предыдущем посте через каждые 100 мс
Вот прога:

program Bufer;

uses Windows, ClipBrd, ShellAPI;

var Msg: TMsg;

{$R *.res}

begin
while GetMessage(Msg, HInstance, 0, 0) do
 begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
  try
   if ClipBoard.AsText<>'Фраза'
    then ;
  except
  end;
  sleep(100); //если убрать, то загрузка процессора - 50%
 end;
end.

[KORN]

begin
while true do
 begin
  try
   if ClipBoard.AsText<>'Фраза'
    then ;
  except
  end;
  sleep(100); //если убрать, то загрузка процессора - 50%
 end;
end.

а так7

[AndrzejX]

Я с этого начинал. Сейчас ещё разок проверю... Как выясняется, задержка происходит только в первый раз. Затем всё нормально. Так должно быть?

[KORN]

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

[AndrzejX]

Всё это я делал. Но одна задержка устраивает. KORN, спасибо большое!

[Somebody]

uses
  Windows, Messages;
const
  HWND_MESSAGE = HWND(-3);
  WndClassName = 'ClipboardControlWndClass';
var
  hNextWindow: HWND;

function WndProc(hWindow: HWND; Msg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
  hClipboardData: THandle;
  pData: PChar;
begin
  Result := 0;
  case Msg of
    WM_CREATE:
      hNextWindow := SetClipboardViewer(hWindow);
    WM_DESTROY:
    begin
      ChangeClipboardChain(hWindow, hNextWindow);
      PostQuitMessage(0);
    end;
    WM_CLOSE:
      DestroyWindow(hWindow);
    WM_CHANGECBCHAIN:
    begin
      if HWND(wParam) = hNextWindow then
        hNextWindow := HWND(lParam)
      else if hNextWindow <> 0 then
        SendMessage(hNextWindow, Msg, wParam, lParam);
    end;
    WM_DRAWCLIPBOARD:
    begin
      if IsClipboardFormatAvailable(CF_TEXT) and
        OpenClipboard(hWindow) then
      begin
        hClipboardData := GetClipboardData(CF_TEXT);
        if hClipboardData <> 0 then
        begin
          pData := GlobalLock(hClipboardData);
          if pData <> nil then
          begin
            if Pos('Hello', pData) <> 0 then
              Beep(2000, 100);
            GlobalUnlock(hClipboardData);
          end;
        end;
        CloseClipboard();
        if hNextWindow <> 0 then
          SendMessage(hNextWindow, Msg, wParam, lParam);
      end;
    end;
    else
      Result := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;
end;

var
  WindowClass: WNDCLASS;
  Mess: MSG;
begin
  FillChar(WindowClass, SizeOf(WindowClass), 0);
  WindowClass.lpfnWndProc := @WndProc;
  WindowClass.hInstance := hInstance;
  WindowClass.lpszClassName := WndClassName;
  RegisterClass(WindowClass);
  CreateWindow(WndClassName, nil, 0, 0, 0, 0, 0, HWND_MESSAGE, 0, hInstance, nil);
  while GetMessage(Mess, 0, 0, 0) do
    DispatchMessage(Mess);
  halt(Mess.wParam);
end.

[AndrzejX]

Грандиозно! Проблема решена. КАК ЭТО РАБОТАЕТ - буду разбираться. Спасибо.