Форум программистов [Powered by Invision Power Board]

Код

unit MainUnit;

interface

uses
 Windows, Messages, Graphics, Controls, Forms, ComCtrls,
 StdCtrls, Classes, SysUtils, Dialogs;

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Button1: TButton;
   Memo1: TMemo;
   Edit2: TEdit;
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Button1Click(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

uses RichEdit;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
{$DEFINE DEBUG_FIND}
var
 MainWindowHandle, RichEditWHandle: THandle;
 ProcessID : Cardinal;
 ProcessHandle : THandle;
 StructTextEx: TGetTextEx;
 StructTextLength: TGetTextLengthEx;
 PStructTextLength, PStructTextEx, PTextBuffer: Pointer;
 BytesWriten, RichEditTextLength: DWORD;
 TextBuffer: array of Char;
begin

 {$IFDEF DEBUG_FIND}
   // Заполняем данные для отладки
   // В качестве примера работаем с WordPad-ом
   Edit1.Text := "Document - WordPad";
   Edit2.Text := "RICHEDIT50W";
 {$ENDIF}

 // Ищем окно
 MainWindowHandle := FindWindow(nil , PChar(Edit1.Text));
 if MainWindowHandle = 0 then RaiseLastOSError;
 RichEditWHandle := FindWindowEx(MainWindowHandle, 0, PChar(Edit2.Text), nil);
 if RichEditWHandle = 0 then RaiseLastOSError;

 // Узнаем ID процесса
 GetWindowThreadProcessId(MainWindowHandle, @ProcessID);
 if ProcessID = 0 then RaiseLastOSError;

 // Открываем процесс
 ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID);
 if ProcessHandle = 0 then RaiseLastOSError;
 try

   // Выделяем в нем память под структуру TGetTextLengthEx
   PStructTextLength := VirtualAllocEx(ProcessHandle, nil,
     SizeOf(TGetTextLengthEx), MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
   if PStructTextLength = nil then RaiseLastOSError;
   try

     // Подготавливаем структуру...
     StructTextLength.flags := GTL_NUMBYTES or GTL_USECRLF;
     StructTextLength.codepage := CP_ACP;

     // ...и пишем ее в память процесса
     if not WriteProcessMemory(ProcessHandle, PStructTextLength,
       @StructTextLength, SizeOf(TGetTextLengthEx),
       BytesWriten) then RaiseLastOSError;
     if BytesWriten <> SizeOf(TGetTextLengthEx) then RaiseLastOSError;

     // Отправляем сообщение удаленному RichEdit,
     // чтобы узнать необходимый размер буффера
     RichEditTextLength := SendMessage(RichEditWHandle,
       EM_GETTEXTLENGTHEX , Integer(PStructTextLength), 0);

   finally
     // Освобождаем выделенную под TGetTextLengthEx память
     VirtualFreeEx(ProcessHandle, PStructTextLength, 0, MEM_RELEASE);
   end;

   // Выделяем память под структуру TGetTextEx
   PStructTextEx := VirtualAllocEx(ProcessHandle, nil,
     SizeOf(TGetTextEx), MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
   if PStructTextEx = nil then RaiseLastOSError;
   try

     // Подготавливаем структуру...
     ZeroMemory(@StructTextEx, SizeOf(TGetTextEx));
     StructTextEx.flags := GT_USECRLF;
     StructTextEx.cb := RichEditTextLength;

     // ...и пишем ее в память процесса
     if not WriteProcessMemory(ProcessHandle, PStructTextEx,
       @StructTextEx, SizeOf(TGetTextEx),
       BytesWriten) then RaiseLastOSError;
     if BytesWriten <> SizeOf(TGetTextEx) then RaiseLastOSError;

     // Выделяем память под текстовый буффер
     PTextBuffer := VirtualAllocEx(ProcessHandle, nil,
     RichEditTextLength, MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
     if PTextBuffer = nil then RaiseLastOSError;
     try

       // отправляем сообщение
       SendMessage(RichEditWHandle, EM_GETTEXTEX, Integer(PStructTextEx),
         Integer(PTextBuffer));

       // Читаем, то, что у нас скопировалось
       SetLength(TextBuffer, RichEditTextLength);
       if not ReadProcessMemory(ProcessHandle, PTextBuffer, @TextBuffer[0],
         RichEditTextLength, BytesWriten) then RaiseLastOSError;

       Memo1.Text := String(TextBuffer);

     finally
       // Освобождаем выделенную под тестовый буффер память
       VirtualFreeEx(ProcessHandle, PTextBuffer, 0, MEM_RELEASE);
     end;

   finally
     // Освобождаем выделенную под TGetTextEx память
     VirtualFreeEx(ProcessHandle, PStructTextEx, 0, MEM_RELEASE);
   end;

 finally
   // Закрываем процесс
   CloseHandle(ProcessHandle);
 end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 ReleaseCapture;
 SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
end;

end.