Вывести текст в любую другую программу

[Kronos913]

Задача такая: вывести текст хранящийся в программе в любую другую программу где сейчас автивен курсор. Речь о возможности отправить текст в любую программу - браузер, клиент телеграма, word, еще что-то.

На практике это позволит иметь еще один буфер, существующий параллельно тому что есть в Винде.

Нерйосеть мне выдала вот код. Код оказался относительно рабочим, но когда количество символов переваливает за 32 килобайта - начинаются сбои. И в целом он работает довольно медленно

Вопрос: если идеи лучше? Может есть возможность отправить напрямую текст, без имитации нажатий на клавиатуру?

procedure SendKeys(const AText: string);
var
  i: Integer;
  Input: array[0..1] of TInput;
  vk: Word;
  ShiftNeeded: Boolean;
begin
  for i := 1 to Length(AText) do
  begin
    vk := VkKeyScan(AText[i]); // Получаем виртуальный код клавиши
    ShiftNeeded := ((vk shr 8) and 1) <> 0; // Проверяем, нужен ли Shift

    // Если нужен Shift — нажимаем его
    if ShiftNeeded then
    begin
      ZeroMemory(@Input[0], SizeOf(TInput));
      Input[0].Itype := INPUT_KEYBOARD;
      Input[0].ki.wVk := VK_SHIFT;
      SendInput(1, Input[0], SizeOf(TInput));
    end;

    // Нажатие символа
    ZeroMemory(@Input[0], SizeOf(TInput));
    Input[0].Itype := INPUT_KEYBOARD;
    Input[0].ki.wVk := vk and $FF;
    SendInput(1, Input[0], SizeOf(TInput));

    // Отпускание символа
    ZeroMemory(@Input[1], SizeOf(TInput));
    Input[1].Itype := INPUT_KEYBOARD;
    Input[1].ki.wVk := vk and $FF;
    Input[1].ki.dwFlags := KEYEVENTF_KEYUP;
    SendInput(1, Input[1], SizeOf(TInput));

    // Если Shift был нажат — отпускаем его
    if ShiftNeeded then
    begin
      ZeroMemory(@Input[0], SizeOf(TInput));
      Input[0].Itype := INPUT_KEYBOARD;
      Input[0].ki.wVk := VK_SHIFT;
      Input[0].ki.dwFlags := KEYEVENTF_KEYUP;
      SendInput(1, Input[0], SizeOf(TInput));
    end;
  end;
end;

[p51x]

32к текста по символьно отправлять в цикле оригинально... Ну вы хоть отправляйте сразу весь массив.

[ARTURK16]

Попробуй так может:

unit ClipboardSender;

interface

uses
  Windows, Messages, SysUtils, Classes, Clipbrd, System.Generics.Collections;

{ 
  Функция SendTextToActiveWindow устанавливает в буфер обмена текст (CF_UNICODETEXT),
  симулирует вставку (Ctrl+V) через SendInput и затем восстанавливает прежнее содержимое.
  Параметр SleepMs позволяет задать задержку после вставки (по умолчанию 50 мс).
}
procedure SendTextToActiveWindow(const Text: string; SleepMs: Cardinal = 50);

implementation

type
  // Структура для хранения данных одного формата из буфера обмена.
  TClipboardData = record
    Format: UINT;
    Data: THandle;
  end;

  // Класс для резервного копирования всех форматов, присутствующих в Clipboard.
  TClipboardBackup = class
  private
    FBackup: TList<TClipboardData>;
  public
    constructor Create;
    destructor Destroy; override;
    procedure BackupClipboard;
    procedure RestoreClipboard;
  end;

{ Функция копирует данные из Clipboard для указанного формата,
  возвращая новый дескриптор памяти с копией данных. }
function CopyClipboardData(Format: UINT): THandle;
var
  hData: THandle;
  pData, pCopy: Pointer;
  DataSize: SIZE_T;
begin
  Result := 0;
  hData := GetClipboardData(Format);
  if hData <> 0 then
  begin
    pData := GlobalLock(hData);
    if pData <> nil then
    begin
      DataSize := GlobalSize(hData);
      Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, DataSize);
      if Result <> 0 then
      begin
        pCopy := GlobalLock(Result);
        if pCopy <> nil then
        begin
          Move(pData^, pCopy^, DataSize);
          GlobalUnlock(Result);
        end
        else
        begin
          GlobalFree(Result);
          Result := 0;
        end;
      end;
      GlobalUnlock(hData);
    end;
  end;
end;

{ TClipboardBackup }

constructor TClipboardBackup.Create;
begin
  inherited Create;
  FBackup := TList<TClipboardData>.Create;
end;

destructor TClipboardBackup.Destroy;
var
  DataRec: TClipboardData;
begin
  // Освобождаем память для тех форматов, данные которых так и не были переданы системе.
  for DataRec in FBackup do
  begin
    if DataRec.Data <> 0 then
      GlobalFree(DataRec.Data);
  end;
  FBackup.Free;
  inherited;
end;

procedure TClipboardBackup.BackupClipboard;
var
  Format: UINT;
  DataHandle: THandle;
  DataRec: TClipboardData;
begin
  { Предполагается, что буфер обмена уже открыт.
    Перебираем все доступные форматы и копируем данные. }
  Format := 0;
  while True do
  begin
    Format := EnumClipboardFormats(Format);
    if Format = 0 then Break;
    DataHandle := CopyClipboardData(Format);
    if DataHandle <> 0 then
    begin
      DataRec.Format := Format;
      DataRec.Data := DataHandle;
      FBackup.Add(DataRec);
    end;
  end;
end;

procedure TClipboardBackup.RestoreClipboard;
var
  i: Integer;
  DataRec: TClipboardData;
begin
  if not OpenClipboard(0) then Exit;
  try
    EmptyClipboard;
    // Передаём данные каждого формата обратно в Clipboard.
    for i := 0 to FBackup.Count - 1 do
    begin
      DataRec := FBackup[i];
      if DataRec.Data <> 0 then
      begin
        // При успешном вызове SetClipboardData система übernimmt владение памятью.
        if SetClipboardData(DataRec.Format, DataRec.Data) <> 0 then
          FBackup[i].Data := 0; // Обнуляем дескриптор, чтобы не освобождать его позже.
      end;
    end;
  finally
    CloseClipboard;
  end;
end;

{ Симуляция вставки через SendInput (Ctrl+V). }
procedure SimulatePaste;
var
  Inputs: array[0..3] of TInput;
begin
  ZeroMemory(@Inputs, SizeOf(Inputs));
  // Нажатие Ctrl
  Inputs[0].Itype := INPUT_KEYBOARD;
  Inputs[0].ki.wVk := VK_CONTROL;
  Inputs[0].ki.dwFlags := 0;
  // Нажатие V
  Inputs[1].Itype := INPUT_KEYBOARD;
  Inputs[1].ki.wVk := Ord('V');
  Inputs[1].ki.dwFlags := 0;
  // Отпускание V
  Inputs[2].Itype := INPUT_KEYBOARD;
  Inputs[2].ki.wVk := Ord('V');
  Inputs[2].ki.dwFlags := KEYEVENTF_KEYUP;
  // Отпускание Ctrl
  Inputs[3].Itype := INPUT_KEYBOARD;
  Inputs[3].ki.wVk := VK_CONTROL;
  Inputs[3].ki.dwFlags := KEYEVENTF_KEYUP;
  SendInput(Length(Inputs), Inputs[0], SizeOf(TInput));
end;

{ Основная процедура. }
procedure SendTextToActiveWindow(const Text: string; SleepMs: Cardinal = 50);
var
  ClipBackup: TClipboardBackup;
  hGlobal: THandle;
  pGlobal: Pointer;
  DataSize: Integer;
begin
  ClipBackup := TClipboardBackup.Create;
  try
    { 1. Сохраняем текущее содержимое буфера обмена }
    if not OpenClipboard(0) then
      raise Exception.Create('Не удалось открыть Clipboard для резервного копирования.');
    try
      ClipBackup.BackupClipboard;
    finally
      CloseClipboard;
    end;

    { 2. Устанавливаем новый текст в буфер обмена (используем CF_UNICODETEXT) }
    if not OpenClipboard(0) then
      raise Exception.Create('Не удалось открыть Clipboard для установки текста.');
    try
      EmptyClipboard;
      DataSize := (Length(Text) + 1) * SizeOf(WideChar);
      hGlobal := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, DataSize);
      if hGlobal = 0 then
        raise Exception.Create('GlobalAlloc не удалось выделить память.');
      pGlobal := GlobalLock(hGlobal);
      if pGlobal = nil then
      begin
        GlobalFree(hGlobal);
        raise Exception.Create('GlobalLock не удалось получить указатель.');
      end;
      try
        StringToWideChar(Text, PWideChar(pGlobal), Length(Text) + 1);
      finally
        GlobalUnlock(hGlobal);
      end;
      if SetClipboardData(CF_UNICODETEXT, hGlobal) = 0 then
      begin
        GlobalFree(hGlobal);
        raise Exception.Create('Не удалось установить данные в Clipboard.');
      end;
      { После успешного SetClipboardData, hGlobal теперь принадлежит Clipboard. }
    finally
      CloseClipboard;
    end;

    { 3. Симулируем вставку (Ctrl+V) в активное окно }
    SimulatePaste;

    { 4. Ждём, чтобы целевое приложение успело обработать вставку }
    Sleep(SleepMs);

    { 5. Восстанавливаем исходное содержимое буфера обмена }
    if not OpenClipboard(0) then
      raise Exception.Create('Не удалось открыть Clipboard для восстановления.');
    try
      EmptyClipboard;
      ClipBackup.RestoreClipboard;
    finally
      CloseClipboard;
    end;
  finally
    ClipBackup.Free;
  end;
end;

end.

[Arigato]

Сообщение от ARTURK16

Попробуй так может

Автор хотел сделать альтернативный буфер обмена, а вы используете стандартный. В теории это может создать проблемы общего доступа, если к буферу будет обращаться другая программа.