Работа с чужим приложением

Barsdg · #1 21.06.2013, 14:15

Доброе время суток уважаемые программисты.
Суть вопроса в следующем:

Есть процедура считывания с чужого листа ListView или syslistview32 в свой TStringGrid

Код:

procedure GetListViewGrid(ALVHandle: HWND; AColumnCount, AItemCount: Integer;
  ADataGrid: TStringGrid);
const
  cchTextMax=255;
var
  hProcess: THandle;
  dwProcessID: DWORD;
  dwWriten: DWORD;
  LVItemCount: Integer;
  i, j, nTextLength: Integer;
  pLVItem: ^LV_ITEM;
  LVItem: LV_ITEM;
  pszText: PChar;
  svText: ShortString;
begin
  if ALVHandle=0 then
    Exit;
  // Получаем количество строк
  LVItemCount := ListView_GetItemCount(ALVHandle);
  if AItemCount>LVItemCount then
    Exit;
  if AItemCount>0 then
    LVItemCount := AItemCount;
  // Получаем ID процесса, которому принадлежит найденное окно
  dwProcessID := 0;
  GetWindowThreadProcessId(ALVHandle, @dwProcessID);
  if dwProcessID=0 then
    ExitProcess(GetLastError);
  // Открываем процесс
  //hProcess := 0;
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, dwProcessID);
  if hProcess=0 then
    ExitProcess(GetLastError);
  // Выделяем в нем память под текстовый буффер
  pszText := VirtualAllocEx(hProcess, nil, cchTextMax, MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
  // Выделяем в нем память под структуру LVITEM
  pLVItem := VirtualAllocEx(hProcess, nil, SizeOf(LV_ITEM), MEM_COMMIT or MEM_TOP_DOWN,
    PAGE_READWRITE);

  // Устанавливаем колич строк и столбцов в TStringGrid
  ADataGrid.RowCount := LVItemCount;
  ADataGrid.ColCount := AColumnCount;

  // Заполняем структуру
  ZeroMemory(@LVItem, SizeOf(LV_ITEM));
  LVItem.Mask := LVIF_TEXT;
  LVItem.pszText := pszText;
  LVItem.cchTextMax := cchTextMax;

  // Считываем строки
  for i := 0 to LVItemCount do
  begin
    LVItem.iSubItem := 0;
    // Пишем ее в память удаленного процесса
    if not WriteProcessMemory(hProcess, pLVItem, @LVItem, SizeOf(LV_ITEM), dwWriten) then
      Exit;
    nTextLength := sendMessage(ALVHandle, LVM_GETITEMTEXT, i, Integer(pLVItem));
    // Читаем результат
    ZeroMemory(@svText, cchTextMax);
    ReadProcessMemory(hProcess, LVItem.pszText, @svText[1], nTextLength, dwWriten);
    // заполняем строки TStringGrid
    ADataGrid.Cells[1, i+1] := StrPas(PChar(@svText[1]));
    // Считываем столбцы
    for j := 0 to AColumnCount do
    begin
      LVItem.iSubItem := j;
      // Пишем ее в память удаленного процесса
      if not WriteProcessMemory(hProcess, pLVItem, @LVItem, SizeOf(LV_ITEM), dwWriten) then
        Exit;
      nTextLength := sendMessage(ALVHandle, LVM_GETITEMTEXT, i, Integer(pLVItem));
      // Читаем результат
      ZeroMemory(@svText, cchTextMax);
      ReadProcessMemory(hProcess, LVItem.pszText, @svText[1], nTextLength, dwWriten);
      // заполняем столбцы TStringGrid
      ADataGrid.Cells[j, i] := StrPas(PChar(@svText[1]));
    end;
  end;

  // Освобождаем ранее выделенную память
  VirtualFreeEx(hProcess, pszText, 0, MEM_RELEASE);
  VirtualFreeEx(hProcess, pLVItem, 0, MEM_RELEASE);
  // Закрываем описатель процесса
  CloseHandle(hProcess);
end;

и ее вызов

Код:

...
d := FindWindowEx(H3, 0, 'ListView20WndClass', nil);
GetListViewGrid(d, 2, 0, FindComponent(Format('StringGrid%d', [q])) as TStringGrid);
...

Проблема в том, что в Delphi7, ячейки моих StringGrid'ов заполняются, а в DelphiXE ячейки StringGrid'ов становятся ПУСТЫМИ.

(Предварительно ячейки моих StringGrid'ов заполнены нулями)

NumLock · #2 21.06.2013, 14:22

ну так приставка Wide как обычно в таких случаях...

Barsdg · #3 21.06.2013, 14:55

Цитата:

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

ну так приставка Wide как обычно в таких случаях...

Не понимаю, к чему это?

NumLock · #4 21.06.2013, 15:28

String - WideString, Char - WideChar, PChar - PWideChar

Barsdg · #5 21.06.2013, 15:56

Цитата:

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

String - WideString, Char - WideChar, PChar - PWideChar

Все равно пустые.
Мне кажется что дело не в кодировке.

NumLock · #6 23.06.2013, 09:12

а что ты сделал, что не помогает? SendMessageW() тоже не помогло что-ли?

Barsdg · #7 24.06.2013, 09:11

Цитата:

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

а что ты сделал, что не помогает? SendMessageW() тоже не помогло что-ли?

В самой процедуре, в объявлениях переменных вместо pszText: PChar; и svText: ShortString; подставлял:
WideChar, PWideChar, WideString, AnsiString.

Программа либо вылетала, либо также пустые строки

NumLock · #8 24.06.2013, 09:31

а PAnsiChar, либо SendMessage с правильной буковкой на конце в память получают значение?

Barsdg · #9 24.06.2013, 11:53

Цитата:

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

а PAnsiChar, либо SendMessage с правильной буковкой на конце в память получают значение?

Я извиняюсь за глупый вопрос, но как это проверить?

icWasya · #10 24.06.2013, 12:16

Все API-функции, которые потенциально могут работать со строками, имеют два названия, для однобайтовых строк и для двучбайтовых, с буквой A и с буквой W на конце. Например SendMessageA и SendMessageW. До D2009 по умолчанию, в функции без этой буквы на конце, подразумевалась буква A, начиная с D2009 подразумевается буква W. То есть если пишем SendMessage, то в D7 вызывается функция SendMessageA, а в DelphiXE - вызывается функция SendMessageW. (см Windows.pas). И соответственно в первую нужно подавать PAnsiChar, а во вторую PWideChar. Когда в одной программе используются и Ansi и Wide строки, нужно явно указывать, какую именно функцию собираетесь вызывать.

Barsdg · #11 24.06.2013, 12:31

Цитата:

Все API-функции, которые потенциально могут работать со строками, имеют два названия, для однобайтовых строк и для двучбайтовых, с буквой A и с буквой W на конце. Например SendMessageA и SendMessageW. До D2009 по умолчанию, в функции без этой буквы на конце, подразумевалась буква A, начиная с D2009 подразумевается буква W. То есть если пишем SendMessage, то в D7 вызывается функция SendMessageA, а в DelphiXE - вызывается функция SendMessageW. (см Windows.pas). И соответственно в первую нужно подавать PAnsiChar, а во вторую PWideChar. Когда в одной программе используются и Ansi и Wide строки, нужно явно указывать, какую именно функцию собираетесь вызывать.

Спасибо понятно.
Заменил везде в процедуре PChar на PWideChar и SendMessage на SendMessageW. Результат не изменился.

icWasya · #12 24.06.2013, 14:17

А то приложение, - из которого читаешь, юникодовое?

Barsdg · #13 24.06.2013, 14:34

Цитата:

А то приложение, - из которого читаешь, юникодовое?

Чем это можно проверить?
повторюсь, но подробнее: процедура срабатывает в версии Portable Turbo Delphi Lite "Borland® Delphi® for Microsoft® Windows™ Version 10.0.2558.35231 Update 2 Copyright © 2005 Borland® Software Corporation"

icWasya · #14 24.06.2013, 17:11

Я просто предлагаю попробывать написать две версии- Ansi и Wide.
Только не забыть, что структура типа LV_ITEM тоже существует в двух вариантах - LV_ITEMA и LV_ITEMW

Barsdg · #15 25.06.2013, 09:17

Цитата:

Я просто предлагаю попробывать написать две версии- Ansi и Wide.
Только не забыть, что структура типа LV_ITEM тоже существует в двух вариантах - LV_ITEMA и LV_ITEMW

Пробовал и Ansi и Wide, StringGrid (предварительно заполнены нулями) по прежнему становятся пустыми.

Вот с Wide (может я что-то пропустил):

Код:

procedure GetListViewGrid(ALVHandle: HWND; AColumnCount, AItemCount: Integer;
ADataGrid: TStringGrid);
const
cchTextMax=255;
var
hProcess: THandle;
dwProcessID: DWORD;
dwWriten: DWORD;
LVItemCount: Integer;
i, j, nTextLength: Integer;
pLVItem: ^LV_ITEMW;
LVItem: LV_ITEMW;
pszText: PWideChar;
svText: ShortString;
begin
if ALVHandle=0 then
Exit;
// Получаем количество строк
LVItemCount := ListView_GetItemCount(ALVHandle);
if AItemCount>LVItemCount then
Exit;
if AItemCount>0 then
LVItemCount := AItemCount;
// Получаем ID процесса, которому принадлежит найденное окно
dwProcessID := 0;
GetWindowThreadProcessId(ALVHandle, @dwProcessID);
if dwProcessID=0 then
ExitProcess(GetLastError);
// Открываем процесс
hProcess := 0;
hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, dwProcessID);
if hProcess=0 then
ExitProcess(GetLastError);
// Выделяем в нем память под текстовый буффер
pszText := VirtualAllocEx(hProcess, nil, cchTextMax, MEM_COMMIT or MEM_TOP_DOWN, PAGE_READWRITE);
// Выделяем в нем память под структуру LVITEM
pLVItem := VirtualAllocEx(hProcess, nil, SizeOf(LV_ITEMW), MEM_COMMIT or MEM_TOP_DOWN,
PAGE_READWRITE);
// Устанавливаем колич строк и столбцов в TStringGrid
ADataGrid.RowCount := LVItemCount;
ADataGrid.ColCount := AColumnCount;
// Заполняем структуру
ZeroMemory(@LVItem, SizeOf(LV_ITEMW));
LVItem.Mask := LVIF_TEXT;
LVItem.pszText := pszText;
LVItem.cchTextMax := cchTextMax;
// Считываем строки
for i := 0 to LVItemCount do
begin
LVItem.iSubItem := 0;
// Пишем ее в память удаленного процесса
if not WriteProcessMemory(hProcess, pLVItem, @LVItem, SizeOf(LV_ITEMW), dwWriten) then
Exit;
nTextLength := sendMessageW(ALVHandle, LVM_GETITEMTEXT, i, Integer(pLVItem));
// Читаем результат
ZeroMemory(@svText, cchTextMax);
ReadProcessMemory(hProcess, LVItem.pszText, @svText[1], nTextLength, dwWriten);
// заполняем строки TStringGrid
ADataGrid.Cells[1, i+1] := StrPas(PWideChar(@svText[1]));
// Считываем столбцы
for j := 0 to AColumnCount do
begin
LVItem.iSubItem := j;
// Пишем ее в память удаленного процесса
if not WriteProcessMemory(hProcess, pLVItem, @LVItem, SizeOf(LV_ITEMW), dwWriten) then
Exit;
nTextLength := sendMessageW(ALVHandle, LVM_GETITEMTEXT, i, Integer(pLVItem));
// Читаем результат
ZeroMemory(@svText, cchTextMax);
ReadProcessMemory(hProcess, LVItem.pszText, @svText[1], nTextLength, dwWriten);
// заполняем столбцы TStringGrid
ADataGrid.Cells[j, i] := StrPas(PWideChar(@svText[1]));
end;
end;
// Освобождаем ранее выделенную память
VirtualFreeEx(hProcess, pszText, 0, MEM_RELEASE);
VirtualFreeEx(hProcess, pLVItem, 0, MEM_RELEASE);
// Закрываем описатель процесса
CloseHandle(hProcess);
end;

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо NumLock за это полезное сообщение:
Barsdg (25.06.2013)

Этот пользователь сказал Спасибо icWasya за это полезное сообщение:
Barsdg (25.06.2013)