Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> чужое приложение WindowsForms10.Window.8.app, в поисках таблицы dspTestSeqGrid 
:(
    Опции темы
bikovrm
Дата 13.5.2018, 20:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 10.10.2010

Репутация: нет
Всего: нет



Во первых: Спасибо. Вы, ну, ооооочень сильно помогли.  Писал на форуме и не надеялся что ктото поможет.
Во вторых, хотел узнать как я могу вас отблагодарить?
И еще .. хочу разобраться полностью в вашем коде. Откуда вы взяли эти смещения, олькой вытягивали?:
const
      ArrFieldOffset = 752; 
и    oldvmtSelfPtr    = -88;
      oldvmtClassName    = -56;
      oldvmtInstanceSize = -52;
 smile 
А вообще, не хотел наглеть, но мне еще нужны данные из компонента TAngularMetter «ТАЙМЕР». Там сейчас значения "--s" и меняются уже при работе железа, отсчитывается время в обратном порядке. Думал заняться этим компонентом как то на досуге.
PM MAIL   Вверх
bems
Дата 14.5.2018, 03:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3399
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



Цитата(bikovrm @  13.5.2018,  20:40 Найти цитируемый пост)
хотел узнать как я могу вас отблагодарить?

"спасибо" достаточно

Цитата(bikovrm @  13.5.2018,  20:40 Найти цитируемый пост)
ArrFieldOffset = 752; 

да, вытаскивал дебагером

Цитата(bikovrm @  13.5.2018,  20:40 Найти цитируемый пост)
oldvmtSelfPtr    = -88;
oldvmtClassName    = -56;
oldvmtInstanceSize = -52;

эти константы объявлены в System.pas только называются без слова old
они иногда изменяются между версиями дельфи и соответственно в моей версии значения уже другие. поэтому я и приписал туда old
чтение данных из VMT класса я использую только для уверенности что я попал куда нужно, так что можно и их убрать

Добавлено через 9 минут и 4 секунды
ок, посмотрю на таймер


--------------------
Обижено школьников: 8
PM MAIL   Вверх
bems
Дата 16.5.2018, 01:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3399
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



проверь на железе
Код

program ReadFields;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, Winapi.Windows;

type
  TTopLevelWindow = record
    Wnd: HWND;
    hProcess: THandle;
  end;

  TFindWinControlCbRec = record
    Wnd: HWND;
    ClassName: String;
    SeqIndex: Integer;
  end;

  TField = record
    FieldName,
    TypeName: String;
    FieldOffset: Cardinal;
  end;

const
  oldvmtSelfPtr      = -88;
  oldvmtTypeInfo     = -72;
  oldvmtFieldTable   = -68;
  oldvmtClassName    = -56;
  oldvmtInstanceSize = -52;

  function GetProcessHandleFromHwnd(Wnd: HWND): THandle; stdcall; external 'oleacc.dll';

  function FindTopLevelWindow(const WndClass: String): TTopLevelWindow;
  begin
    Result.Wnd := FindWindow(PChar(WndClass), nil);
    if Result.Wnd = 0
       then raise Exception.Create('Top-level window not found');

    Result.hProcess := GetProcessHandleFromHwnd(Result.Wnd);
    if Result.hProcess = 0 then RaiseLastOsError;
  end;

  function FindWinControlCb(Wnd: HWND; var Rec: TFindWinControlCbRec): BOOL; stdcall;
  var
    ClassName: String;
    Len: Integer;
  begin
    Result := True;
    SetLength(ClassName, Length(Rec.ClassName) + 1);
    Len := GetClassName(Wnd, @ClassName[1], Length(ClassName) + 1);
    if Len = 0 then RaiseLastOsError;

    SetLength(ClassName, Len);
    if AnsiSameText(ClassName, Rec.ClassName)
       then begin
            Dec(Rec.SeqIndex);
            if Rec.SeqIndex < 0
               then begin
                    Rec.Wnd := Wnd;
                    Result := False
                    end;
            end;
  end;

  function FindWinControl(const TopWnd: HWND; const WinControlClass: String;
    SeqIndex: Integer): DWORD;
  var
    RM_GetObjectInstance: UINT;
    PID: DWORD;
    Rec: TFindWinControlCbRec;
  begin
    Rec.Wnd := 0;
    Rec.ClassName := WinControlClass;
    Rec.SeqIndex := SeqIndex;
    EnumChildWindows(TopWnd, @FindWinControlCb, LPARAM(@Rec));
    if Rec.Wnd = 0
       then raise Exception.Create('Control not found');

    if GetWindowThreadProcessId(Rec.Wnd, PID) = 0
       then RaiseLastOsError;

    RM_GetObjectInstance := RegisterWindowMessage('DelphiRM_GetObjectInstance');
    Result := DWORD(SendMessage(Rec.Wnd, RM_GetObjectInstance, WPARAM(PID), 0));
  end;

  function ReadString(hProcess: THandle; Ptr: DWORD): String;
  var
    Str: ShortString;
    BytesRead: SIZE_T;
  begin
    if not ReadProcessMemory(hProcess, Pointer(Ptr), @Str[0], SizeOf(Str[0]),
         BytesRead)
       then RaiseLastOsError;

    Inc(Ptr, SizeOf(Str[0]));
    if not ReadProcessMemory(hProcess, Pointer(Ptr), @Str[1], Length(Str),
         BytesRead)
       then RaiseLastOsError;

    Result := String(Str)
  end;

  procedure EnumFields(hProcess: THandle; VMT: DWORD; Cb: TFunc<TField, Boolean>);

    procedure ReadPPTypeInfo(pPtr: DWORD; var Fld: TField);
    var
      dw: DWORD;
      BytesRead: SIZE_T;
      tk: TTypeKind;
      ElSize: Integer;
    begin
      if not ReadProcessMemory(hProcess, Pointer(pPtr), @dw, SizeOf(dw), BytesRead)
         then RaiseLastOsError;

      if not ReadProcessMemory(hProcess, Pointer(dw), @tk, SizeOf(tk), BytesRead)
         then RaiseLastOsError;

      Inc(dw, SizeOf(tk));
      Fld.TypeName := ReadString(hProcess, dw);

      if ((Fld.TypeName = '') or (Fld.TypeName[1] = ':')) and (tk = tkDynArray)
         then begin
              Inc(dw, 1 + Length(Fld.TypeName));
              Fld.TypeName := 'array of ';

              if not ReadProcessMemory(hProcess, Pointer(dw), @ElSize,
                   SizeOf(ElSize), BytesRead)
                 then RaiseLastOsError;

              Inc(dw, SizeOf(Integer)); // elSize: Integer
              if not ReadProcessMemory(hProcess, Pointer(dw), @pPtr, SizeOf(pPtr),
                   BytesRead)
                 then RaiseLastOsError;

              if pPtr = 0
                 then Fld.TypeName := Format('%s<%d byte(s)>', [Fld.TypeName, ElSize])
                 else begin
                      if not ReadProcessMemory(hProcess, Pointer(pPtr), @dw, SizeOf(dw),
                           BytesRead)
                         then RaiseLastOsError;

                      Inc(dw, SizeOf(tk));
                      Fld.TypeName := Fld.TypeName + ReadString(hProcess, dw);
                      end;
              end;
    end;

  var
    dw, TypeInfo: DWORD;
    BytesRead: SIZE_T;
    Count: Word;
    i: Integer;
    Fld: TField;
  begin
    if not ReadProcessMemory(hProcess, PByte(VMT) + oldvmtFieldTable, @dw,
         SizeOf(dw), BytesRead)
       then RaiseLastOsError;

    if not ReadProcessMemory(hProcess, Pointer(dw), @Count, SizeOf(Count), BytesRead)
       then RaiseLastOsError;

    if Count <> 0
       then raise Exception.Create('Old-style TVmtFieldEntry is not supported');

    Inc(dw, SizeOf(Count));
    Inc(dw, SizeOf(DWORD)); // ClassTab: PVmtFieldClassTab

    if not ReadProcessMemory(hProcess, Pointer(dw), @Count, SizeOf(Count), BytesRead)
       then RaiseLastOsError;

    Inc(dw, SizeOf(Count));
    for i := 1 to Count do
      begin
      Inc(dw); // Flags: Byte;
      if not ReadProcessMemory(hProcess, Pointer(dw), @TypeInfo, SizeOf(TypeInfo),
           BytesRead)
         then RaiseLastOsError;

      ReadPPTypeInfo(TypeInfo, Fld);
      Inc(dw, SizeOf(TypeInfo));
      if not ReadProcessMemory(hProcess, Pointer(dw), @Fld.FieldOffset,
           SizeOf(Fld.FieldOffset), BytesRead)
         then RaiseLastOsError;

      Inc(dw, SizeOf(Fld.FieldOffset));
      Fld.FieldName := ReadString(hProcess, dw);
      if not Cb(Fld) then Break;

      Inc(dw, 1 + Length(Fld.FieldName));
      if not ReadProcessMemory(hProcess, Pointer(dw), @Count, SizeOf(Count), BytesRead)
         then RaiseLastOsError;

      Inc(dw, Count); // TAttrData
      end;
  end;

  procedure DumpFields(hProcess: THandle; VMT: DWORD);
  begin
    EnumFields(hProcess, VMT, function (Fld: TField): Boolean
      begin
        Result := True;
        writeln(Fld.FieldName, ': ', Fld.TypeName, ' @ ', Fld.FieldOffset);
      end);
  end;

  function FindFieldOffset(hProcess: THandle; VMT: DWORD;
    const FldName: String): DWORD;
  var
    FldPtr: DWORD;
  begin
    FldPtr := 0;
    EnumFields(hProcess, VMT, function (Fld: TField): Boolean
      var
        InstSize: DWORD;
        BytesRead: SIZE_T;
      begin
        Result := not AnsiSameText(Fld.FieldName, FldName);
        if not Result
           then begin
                FldPtr := Fld.FieldOffset;
                if not ReadProcessMemory(hProcess, PByte(VMT) + oldvmtInstanceSize,
                     @InstSize, SizeOf(InstSize), BytesRead)
                   then RaiseLastOsError;

                if Fld.FieldOffset > InstSize
                   then raise Exception.Create('Instance too small');
                end;
      end);

    Result := FldPtr;
    if Result = 0
       then raise Exception.Create('Field not found')
  end;

  function GetVmtClassName(hProcess: THandle; VMT: DWORD): String;
  var
    dw: DWORD;
    BytesRead: SIZE_T;
  begin
    if not ReadProcessMemory(hProcess, PByte(VMT) + oldvmtClassName, @dw,
         SizeOf(dw), BytesRead)
       then RaiseLastOsError;

    Result := ReadString(hProcess, dw)
  end;

  function FindVmt(hProcess: THandle; Obj: DWORD): DWORD;
  var
    BytesRead: SIZE_T;
    dw: DWORD;
    tk: TTypeKind;
  begin
    if not ReadProcessMemory(hProcess, Pointer(Obj), @Result, SizeOf(Result),
         BytesRead)
       then RaiseLastOsError;

    if not ReadProcessMemory(hProcess, PByte(Result) + oldvmtSelfPtr, @dw,
         SizeOf(dw), BytesRead)
       then RaiseLastOsError;

    if dw <> Result
       then raise Exception.Create('vmtSelfPtr not found');

    if not ReadProcessMemory(hProcess, PByte(Result) + oldvmtTypeInfo, @dw,
         SizeOf(dw), BytesRead)
       then RaiseLastOsError;

    if not ReadProcessMemory(hProcess, Pointer(dw), @tk, SizeOf(tk), BytesRead)
       then RaiseLastOsError;

    if tk <> tkClass
       then raise Exception.Create('VMT is present but TTypeInfo.Kind <> tkClass');

    Inc(dw, SizeOf(tk));
    if not AnsiSameText(GetVmtClassName(hProcess, Result), ReadString(hProcess, dw))
       then raise Exception.Create('ClassName mismatch')
  end;

  procedure DumpArrayOfDouble(hProcess: THandle; ArrFld: DWORD);
  var
    BytesRead: SIZE_T;
    ArrPtr: DWORD;
    Len, i: Integer;
    Arr: array of Double;
  begin
    if not ReadProcessMemory(hProcess, Pointer(ArrFld), @ArrPtr,
         SizeOf(ArrPtr), BytesRead)
       then RaiseLastOsError;

    if not ReadProcessMemory(hProcess, Pointer(ArrPtr - SizeOf(Len)), @Len,
         SizeOf(Len), BytesRead)
       then RaiseLastOsError;

    SetLength(Arr, Len);
    if not ReadProcessMemory(hProcess, Pointer(ArrPtr), @Arr[0],
         SizeOf(Arr[0]) * Len, BytesRead)
       then RaiseLastOsError;

    for i := 0 to Len div 2 - 1 do
      writeln(Arr[i * 2], '     ', Arr[i * 2 + 1]);
  end;

  function ReadBoolean(hProcess: THandle; Fld: DWORD): Boolean;
  var
    BytesRead: SIZE_T;
  begin
    if not ReadProcessMemory(hProcess, Pointer(Fld), @Result,
         SizeOf(Result), BytesRead)
       then RaiseLastOsError;
  end;

  procedure DumpDouble(hProcess: THandle; Fld: DWORD);
  var
    BytesRead: SIZE_T;
    Dbl: Double;
  begin
    if not ReadProcessMemory(hProcess, Pointer(Fld), @Dbl,
         SizeOf(Dbl), BytesRead)
       then RaiseLastOsError;

    writeln(Dbl)
  end;

const
  FlowDiagramClassName = 'TFlowDiagram';
  AngularMetterClassName = 'TAngularMetter';
var
  TopWnd: TTopLevelWindow;
  Ctrl, Fld, VMT: DWORD;
begin
  try
    TopWnd := FindTopLevelWindow('TFormARMDStensdMain');
    try
      writeln(FlowDiagramClassName, ':');
      Ctrl := FindWinControl(TopWnd.Wnd, FlowDiagramClassName, 0);
      VMT := FindVmt(TopWnd.hProcess, Ctrl);
      if not AnsiSameText(FlowDiagramClassName, GetVmtClassName(TopWnd.hProcess, VMT))
         then raise Exception.Create('ClassName mismatch');

      //DumpFields(TopWnd.hProcess, VMT);
      Fld := Ctrl + FindFieldOffset(TopWnd.hProcess, VMT, 'FVolumeMeasured');
      DumpArrayOfDouble(TopWnd.hProcess, Fld);

      writeln(AngularMetterClassName, ':');
      Ctrl := FindWinControl(TopWnd.Wnd, AngularMetterClassName, 0);
      VMT := FindVmt(TopWnd.hProcess, Ctrl);
      if not AnsiSameText(AngularMetterClassName, GetVmtClassName(TopWnd.hProcess, VMT))
         then raise Exception.Create('ClassName mismatch');

      //DumpFields(TopWnd.hProcess, VMT);
      Fld := Ctrl + FindFieldOffset(TopWnd.hProcess, VMT, 'FValueClear');
      if ReadBoolean(TopWnd.hProcess, Fld)
         then writeln('-')
         else begin
              Fld := Ctrl + FindFieldOffset(TopWnd.hProcess, VMT, 'FValuePos');
              DumpDouble(TopWnd.hProcess, Fld);
              end;
    finally
      CloseHandle(TopWnd.hProcess)
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln
end.



--------------------
Обижено школьников: 8
PM MAIL   Вверх
bikovrm
Дата 19.5.2018, 15:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 10.10.2010

Репутация: нет
Всего: нет



Извиняюсь что сразу не ответил, срочно лепил программу в кучу и разбирался в Вашем коде.
У меня просто слов нету, это шедевр, почти универсальный метод чтения подобных компонентов. Компонент TAngularMetter прочитался с первого раза. Порвали как тузик грелку. Я сомневаюсь что смог бы такое написать. Исчезла привязка к версии программы, все на поиске полей компонента.
Я так понял что в  FindWinControl(TopWnd.Wnd, AngularMetterClassName, 0),  0 - это порядковый номер компонента.
 smile 
Не понял с процедурой ReadBoolean, что она проверяет - FValueClear активность компонента TAngularMetter?
Как Вы узнали с каких полей (FVolumeMeasured, FValueClear, FValuePos) читать, делали запись в память по адресу?
Посоветуйте пож. что почитать, по поводу структуры (архитектуры) памяти, и вообще о том как Вы находите эти смещения. Потому что мои познания по работе с памятью сводится к отсеву на подобие артмани и разной мелочи.
PM MAIL   Вверх
bems
Дата 19.5.2018, 19:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3399
Регистрация: 5.1.2006

Репутация: 21
Всего: 88



Цитата(bikovrm @  19.5.2018,  15:37 Найти цитируемый пост)
Я так понял что в  FindWinControl(TopWnd.Wnd, AngularMetterClassName, 0),  0 - это порядковый номер компонента.
ну да. к сожалению порядок обнаружения окон EnumChildWindows зависит от z-порядка, поэтому компоненты находятся разные в зависимости от того какая вкладка активна в программе. Если хочется совсем красиво, то можно для каждого TWinControl  доставать поле FName предка TComponent и сверять имена компонентов с тем что нужно найти.

Цитата(bikovrm @  19.5.2018,  15:37 Найти цитируемый пост)
Не понял с процедурой ReadBoolean, что она проверяет - FValueClear активность компонента TAngularMetter?
Как Вы узнали с каких полей (FVolumeMeasured, FValueClear, FValuePos) читать, делали запись в память по адресу?

среди published-свойств компонента я нашел свойство ValueVar: Variant у которого есть геттер и сеттер. с помощью Иды я заглянул в геттер  и увидел что он обращается к двум полям. сначала проверяет равен ли байт нулю и если равен то делает что-то с другим полем, рассматривая его как Double. я записал смещения этих полей и получил имена с помощью процедуры DumpFields. и действительно одно оказалось Boolean а другое Double.
Что касается FVolumeMeasured, то я тоже сначала получил смещение в отладчике/дизассемблере, но уже не помню как я на него натолкнулся тогда.

Цитата(bikovrm @  19.5.2018,  15:37 Найти цитируемый пост)
Посоветуйте пож. что почитать, по поводу структуры (архитектуры) памяти
всё что используется в этой демке получено из исходников Vcl/Rtl. В юните System структура VMT, а в TypInfo структуры описания полей. даж не знаю что тут еще читать. ну гугл еще smile



--------------------
Обижено школьников: 8
PM MAIL   Вверх
bikovrm
Дата 3.9.2018, 20:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 10.10.2010

Репутация: нет
Всего: нет



 smile 
Хочу ещё у Вас спросить, не знаете можно ли как то сохранить рисунок из программы (в переменную tbitmap или в объект Image), кроме как снять скрин по координатам (так как сверху может быть окно другой программы или список сместиться - могут спрятаться поля).
По результатам роботы программы высвечивается галочка или крестик в объекте 'System.Drawing.Bitmap'
софт 
user posted image

Это сообщение отредактировал(а) bikovrm - 5.9.2018, 15:49

Присоединённый файл ( Кол-во скачиваний: 0 )
Присоединённый файл  ReadBMP.rar 54,49 Kb
PM MAIL   Вверх
Google
  Дата 25.9.2018, 13:46 (ссылка)  





  Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.0712 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.