////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Unit Name : RemoteRichEditDemo

//  * Purpose   : Демо работы с уделенным RichEdit на примере WordPad

//  * Author    : Александр (Rouse_) Багель

//  * Copyright : © Fangorn Wizards Lab 1998 - 2007

//  * Version   : 1.00

//  * Home Page : http://rouse.drkb.ru

//  ****************************************************************************

//

 

unit RemoteRichEditDemo;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;

 

type

  TForm1 = class(TForm)

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

  end;

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

uses

  ShellAPI, RichEdit;

 

type

  PROCESS_BASIC_INFORMATION = packed record

    ExitStatus: DWORD;

    PebBaseAddress: Pointer;

    AffinityMask: DWORD;

    BasePriority: DWORD;

    uUniqueProcessId: Ulong;

    uInheritedFromUniqueProcessId: Ulong;

  end;

 

  PEnumWindowsProcParam = ^TEnumWindowsProcParam;

  TEnumWindowsProcParam = record

    PID: DWORD;

    AResult: DWORD;

  end;

 

function  NtQueryInformationProcess(

    ProcessHandle : THandle;

    ProcessInformationClass : Byte;

    ProcessInformation : Pointer;

    ProcessInformationLength : ULONG;

    ReturnLength : PULONG

  ): DWORD; stdcall; external 'ntdll.dll';

 

procedure RemoteRichViewDemo;

 

  function EnumWindowsProc(AWnd: THandle; AParam: LPARAM): BOOL; stdcall;

  var

    dwProcessID: DWORD;

  begin

    GetWindowThreadProcessId(AWnd, dwProcessID);

    if dwProcessID = PEnumWindowsProcParam(AParam)^.PID then

    begin

      SetLastError(0);

      PEnumWindowsProcParam(AParam)^.AResult := AWnd;

      Result := False;

    end

    else

      Result := True;

  end;

 

const

  ProcessBasicInformation = 0;

  SampleText = 'Тестовая строка в удаленном RichEdit';

var

  ExecuteInfo: SHELLEXECUTEINFOA;

  Info: PROCESS_BASIC_INFORMATION;

  RichViewHandle: THandle;

  EnumWindowsProcParam: TEnumWindowsProcParam;

  CharFormat: TCharFormat;

  pCharFormat: Pointer;

  dwBytesWriten: DWORD;

begin

  // Запускаем процесс Вордпада

  ZeroMemory(@ExecuteInfo, SizeOf(SHELLEXECUTEINFOA));

  ExecuteInfo.cbSize := SizeOf(SHELLEXECUTEINFOA);

  ExecuteInfo.lpFile := 'wordpad.exe';

  ExecuteInfo.fMask := SEE_MASK_NOCLOSEPROCESS;

  ExecuteInfo.nShow := SW_SHOWNORMAL;

  if not ShellExecuteEx(@ExecuteInfo) then

    RaiseLastOSError;

 

  // Получаем его PID

  if NtQueryInformationProcess(ExecuteInfo.hProcess,

    ProcessBasicInformation, @Info, SizeOf(Info), nil) <> NO_ERROR then

    RaiseLastOSError;

 

  // Немного подождем, пока инициализируются окна процесса

  Sleep(100);

 

  // Ищем его TopLevel окно

  ZeroMemory(@EnumWindowsProcParam, SizeOf(TEnumWindowsProcParam));

  EnumWindowsProcParam.PID := Info.uUniqueProcessId;

  EnumWindows(@EnumWindowsProc, Integer(@EnumWindowsProcParam));

  if EnumWindowsProcParam.AResult = 0 then

    RaiseLastOSError;

 

  // Теперь ищем само окно RichView-а

  RichViewHandle :=

    FindWindowEx(EnumWindowsProcParam.AResult, 0, 'RICHEDIT50W', nil);

 

  // Пишем в нем текст

  SendMessage(RichViewHandle, WM_SETTEXT, 0, Integer(@SampleText[1]));

 

  // Выделяем буквы с девятой по пятнадцатую

  SendMessage(RichViewHandle, EM_SETSEL, 9, 15);

 

  // Далее начинаем работать с паямятью удаленного процесса

  // т.к. EM_SETCHARFORMAT требует указатель на буффер

  // Если не прописать его в удаленное АП, процесс рухнет.

 

  // Выделяем память под структуру

  pCharFormat := VirtualAllocEx(ExecuteInfo.hProcess, nil, SizeOf(TCharFormat),

    MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);

  if pCharFormat <> nil then

  try

 

    // Для изменения стиля выделенного текста

    // необходимо заполнить соответствующую структуру

    // Сначала делаем кусок текста жирным

    ZeroMemory(@CharFormat, SizeOf(TCharFormat));

    CharFormat.cbSize := SizeOf(TCharFormat);

    CharFormat.dwMask := CFM_BOLD;

    CharFormat.dwEffects := CFE_BOLD;

 

    // Теперь необходимо ее переместить в память удаленного процесса

    if not WriteProcessMemory(ExecuteInfo.hProcess,

      pCharFormat, @CharFormat,

      SizeOf(TCharFormat), dwBytesWriten) then

      RaiseLastOSError;

 

    // Вот теперь все готово для изменения стиля текста,

    // отправляем сообщение для изменения

    SendMessage(RichViewHandle, EM_SETCHARFORMAT,

      SCF_SELECTION, Integer(pCharFormat));

 

    // теперь по аналогии сделаем другой

    // кусок текста подчеркнутым и красным

     SendMessage(RichViewHandle, EM_SETSEL, 28, 36);

     CharFormat.dwMask := CFM_UNDERLINE or CFM_COLOR;

     CharFormat.dwEffects := CFE_UNDERLINE;

     CharFormat.crTextColor := clRed;

    if not WriteProcessMemory(ExecuteInfo.hProcess,

      pCharFormat, @CharFormat,

      SizeOf(TCharFormat), dwBytesWriten) then

      RaiseLastOSError;

    SendMessage(RichViewHandle, EM_SETCHARFORMAT,

      SCF_SELECTION, Integer(pCharFormat));

 

  finally

    // Освобождаем ранее выделенную память

    VirtualFreeEx(ExecuteInfo.hProcess, pCharFormat, 0, MEM_RELEASE);

  end;

 

  // Ставим курсор в начало текста и любуемся результатом

  SendMessage(RichViewHandle, EM_SETSEL, 0, 0);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  RemoteRichViewDemo;

end;

 

end.