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

Поиск:

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


Новичок



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

Репутация: нет
Всего: нет
Пожалуйста помогите!!! smile  При получении данных из чужой программы, нужно прочитать данные из контейнера .NET - WindowsForms10.Window.8.app.0.378734a - таблицу dspTestSeqGrid. Уже перепробовал разнообразную реализацию, но пока не нашел решения этой проблемы. 
   У меня есть стороннее приложение WindowsForms10  (рис 1), и мне нужно получить доступ к данным в виде сетки этого приложения (прочитать) из моего приложения созданного в Delphi. 
   При использовании программы Spy ++ она не видит этих элементов (рис 2). Но программа Ranorex Spy видит все необходимые поля и четает данные (рис 3 и 4).
   При рекурсивном переборе всех елементов с использованием FindWindow, FindWindowEx, EnumChildWindows и EnumChildFunc дает мне доступ только к главному окну, но не видит содержимое контейнера. 

h := FindWindow(NIL,'HK1400 EUI/EUP');
if h <> 0 then   
begin
EnumChildWindows(h, @EnumChildFunc, 0);
...
function EnumChildFunc(Child: HWND; lParam : Longint) : BOOL; stdcall;
var szClass : array[0..63] of Char;
    s       : array[Byte]  of Char;
begin
  GetClassName(Child, szClass, SizeOf(szClass));
...
End;

   Так же на сайте разработчика программы Ranorex Spy нашол код (для их среды програмирования) для получения доступа к таблице:
https://www.ranorex.com/blog/element-based-...istcs-controls/
Цитата

Ranorex.Form form = Application.FindForm("My Styleable Application", SearchMatchMode.MatchExact, "WindowsForms10.Window.8.app.0.378734a   #2", false, 5000);
form.Activate();      

// Find child by control name
control = form.FindClassName("WindowsForms10.Window.8.app.0.378734a");
control.Focus();
// Find table element
Element table = control.Element.FindChild(Role.Table,"ultraGrid1");
Element[] rows = table.FindChildren(Role.Row);
Console.WriteLine("RowCount: " + rows.Length.ToString());

int i = 0;
int j = 0;
foreach ( Element row in rows )
{
    Element[] cells = row.FindChildren(Role.Cell);
    foreach (Element cell in cells)
    {
        if (cell.State == State.Invisible)
              continue;
        Mouse.MoveToElement(cell);
        cell.Value = "Cell: " + i.ToString() + "," + j.ToString();
        j++;
    }
    j = 0;
    i++;
    // open sub node
    row.DoDefaultAction();
    Element[] subRows = row.FindChildren(Role.Row);
    Console.WriteLine("SubRows: " + subRows.Length.ToString());
    int k = 0;
    int l = 0;
    foreach (Element subRow in subRows)
    {
        Element[] rowCells = subRow.FindChildren(Role.Cell);
        foreach (Element cell in rowCells)
        {
             if (cell.State == State.Invisible)
                   continue;
             Mouse.MoveToElement(cell);
             cell.Value = "Sub Cell: " + k.ToString() + "," + l.ToString();
             l++;
        }
        k++;
        l=0;
    }
    k=0;
    // close sub node
    row.DoDefaultAction();
}

   Пожалуйста, помогите получить доступ к таблице (содержащему данные сетки) и навигации по ней. 
   Желательно с реализацией в Delphi.
user posted image
user posted image
user posted image
user posted image
PM MAIL   Вверх
bems
Дата 2.5.2018, 00:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 21
Всего: 88
а софтину где скачать? и запустится ли она без железки?


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


Новичок



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

Репутация: нет
Всего: нет
без железа запустится, а скачать можно : https://drive.google.com/open?id=1ykLp9maQm...oEBhVtu5tWSEldV

использование в доке
PM MAIL   Вверх
bems
Дата 5.5.2018, 05:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 21
Всего: 88
вот чтение грида, кнопки я никакие не нажимаю, так что для проверки кода форму сначала нужно привести в правильное состояние вручную

Код

program HkRead;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, Winapi.Windows, Winapi.oleacc, System.Win.ComObj,
  Winapi.ActiveX, System.Variants;

  function FindTopLevelWindow: IAccessible;
  var
    Wnd: HWND;
    hRes: HResult;
  begin
    Wnd := FindWindow('WindowsForms10.Window.8.app.0.33c0d9d', 'HK1400 EUI/EUP');
    if Wnd = 0 then RaiseLastOsError;

    Result := nil;
    hRes := AccessibleObjectFromWindow(Wnd, OBJID_CLIENT, IAccessible, Result);
    if hRes <> S_OK then OleError(hRes)
  end;

  function GetChild(Parent: IAccessible; ChildIdOrIface: OleVariant): IAccessible;
  var
    idispChild: IDispatch;
    hRes: HResult;
    Role: OleVariant;
  begin
    if VarIsNumeric(ChildIdOrIface)
       then begin
            idispChild := nil;
            hRes := Parent.Get_accChild(ChildIdOrIface, idispChild);
            case hRes of
              S_OK:;
              S_FALSE: Exit(nil);
              else OleError(hRes)
            end
            end
       else idispChild := IDispatch(ChildIdOrIface);

    Result := idispChild as IAccessible
  end;

  function EnumChildren(Acc: IAccessible; Cb: TFunc<IAccessible, IAccessible>): IAccessible;
  var
    hRes: HResult;
    Count, i: Integer;
    ev: IEnumVARIANT;
    Children: array of OleVariant;
    Child: IAccessible;
  begin
    Result := nil;
    hRes := Acc.Get_accChildCount(Count);
    if hRes <> S_OK then OleError(hRes);
    if Count = 0 then Exit;

    ev := Acc as IEnumVARIANT;
    hRes := ev.Reset;
    if hRes <> S_OK then OleError(hRes);

    SetLength(Children, Count);
    hRes := ev.Next(Count, Children[0], DWORD(Count));
    if hRes <> S_OK then OleError(hRes);

    for i := 0 to Count - 1 do
      begin
      Child := GetChild(Acc, Children[i]);
      if Assigned(Child)
         then begin
              Result := Cb(Child);
              if Assigned(Result) then Exit
              end;
      end;
  end;

  function FindChildTable(Acc: IAccessible): IAccessible;
  begin
    Result := EnumChildren(Acc, function(Child: IAccessible): IAccessible
      var
        hRes: HResult;
        Role: OleVariant;
      begin
        hRes := Child.Get_accRole(CHILDID_SELF, Role);
        if hRes <> S_OK then OleError(hRes);

        if Role = ROLE_SYSTEM_TABLE
           then Result := Child
           else Result := FindChildTable(Child)
      end);
  end;

  procedure PrintTable(Acc: IAccessible);
  begin
    EnumChildren(Acc, function(Child: IAccessible): IAccessible
      var
        hRes: HResult;
        Value: WideString;
      begin
        Result := nil;
        EnumChildren(Child, function(Grandchild: IAccessible): IAccessible
          begin
          hRes := Grandchild.Get_accValue(CHILDID_SELF, Value);
          if hRes <> S_OK then OleError(hRes);
          write(Value, '|')
          end);
        writeln
      end);
  end;

var
  Acc: IAccessible;
begin
  try
    CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
    Acc := FindTopLevelWindow;
    Acc := FindChildTable(Acc);
    PrintTable(Acc)
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln
end.



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


Новичок



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

Репутация: нет
Всего: нет
это в RAD Studio? Какую версию вы использовали? 
PM MAIL   Вверх
bems
Дата 5.5.2018, 12:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

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


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


Новичок



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

Репутация: нет
Всего: нет
Спасибо. Переварил. Очень помогло. smile 
PM MAIL   Вверх
bikovrm
Дата 8.5.2018, 08:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
А с диаграммой разобраться не поможете? Нужно прочитать данные из первой колонки. 
Тут вообще не читается поле с данными, они являются частью диаграммы и в свойствах не описываются. 
И описание компонента TFlowDiagram вообще в нэте нет.
На данный момент если не получится, думаю прейдётся искать в памяти и читать из неё. smile 

программа,   обновление

user posted image
PM MAIL   Вверх
bems
Дата 8.5.2018, 11:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 21
Всего: 88
я не вижу тут лёгкого способа вычитать значение. можно было бы попробовать получить поинтер на компонент из HWND диаграмы и прочитать значение из компонента, но тут две проблемы:
1. если при обновлении прогриаммы поменяется структура компонента в памяти, то всё поломается
2. если при обновлении программы изменится версия делфей/билдера или целевая платформа билда, то всё снова поломается


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


Новичок



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

Репутация: нет
Всего: нет
если поломается при обновлении, не чего страшного, можно будет поправить, главное как туда залезть и прочитать значение из компонента. И обновление не критично можно на него и забить.

обновление в графике происходит с железа, но.. 
На закладке "расход ctrl+f4" можно самому в ручную менять значение в ячейке "см3:"
PM MAIL   Вверх
bems
Дата 8.5.2018, 13:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 21
Всего: 88
ну ок, попробую


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


Эксперт
****


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

Репутация: 21
Всего: 88
как-то так. показывает значения для первой попавшейся диаграммы. это как раз та,  которую можно редактировать вручную
Код

program ReadDiagram;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Winapi.Windows, Winapi.ImageHlp, Generics.Collections, 
  Winapi.TlHelp32;

type
  TSymbols = class
  strict private
    FProcess: THandle;
    FModules: TDictionary<String, DWORD>;
    FSymToFind: String;
    FFindSymResult: DWORD;

    function GetSymAddress(const Module, Symbol: String): DWORD;
    class function EnumSymbolsCallback(SymbolName: PAnsiChar; SymbolAddress,
      SymbolSize: ULONG; Symbols: TSymbols): BOOL; stdcall; static;
  public
    constructor Create(hProcess: THandle);
    destructor Destroy; override; 
    function FindProc(Origin: Pointer; const Module, Proc: String): Integer;
  end;

  TFindDiagramCallbackRec = record
    Result : HWND;
    SeqNum: Integer;
  end;
  PFindDiagramCallbackRec = ^TFindDiagramCallbackRec;

const
  Push    = $68;
  Call    = $E8;
  PushEax = $50;

  ArrFieldOffset = 752;
  DiagramClassName = 'TFlowDiagram';
  
  constructor TSymbols.Create(hProcess: THandle);
  const 
    TH32CS_SNAPMODULE32 = $00000010;
  var
    hSnapshot: THandle;
    Entry: TModuleEntry32;
    PID: DWORD;
  begin    
    if not SymInitialize(hProcess, nil, False)
       then RaiseLastOsError;

    FProcess := hProcess;
    PID := GetProcessId(hProcess);
    if PID = 0 then RaiseLastOsError;
           
    FModules := TDictionary<String, DWORD>.Create;
    hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE or TH32CS_SNAPMODULE32, PID);
    if hSnapshot = INVALID_HANDLE_VALUE then RaiseLastOsError;
    
    try
      FillChar(Entry, SizeOf(Entry), 0);
      Entry.dwSize := SizeOf(Entry);
      if not Module32First(hSnapshot, Entry)
         then RaiseLastOsError;
         
      repeat
        FModules.AddOrSetValue(UpperCase(String(Entry.szModule)), Entry.hModule)
      until not Module32Next(hSnapshot, Entry);
    finally
      CloseHandle(hSnapshot)
    end;    
  end;

  destructor TSymbols.Destroy;
  begin
    if FProcess <> 0
       then SymCleanup(FProcess);
    
    FreeAndNil(FModules);
    inherited;
  end;

  class function TSymbols.EnumSymbolsCallback(SymbolName: PAnsiChar;
    SymbolAddress, SymbolSize: ULONG; Symbols: TSymbols): BOOL;
  begin
    Result := not AnsiSameText(String(SymbolName), Symbols.FSymTofind);
    if not Result 
       then Symbols.FFindSymResult := SymbolAddress
  end;

  function TSymbols.GetSymAddress(const Module, Symbol: String): DWORD;
  var
    ImageBase: DWORD;
  begin
    ImageBase := FModules[UpperCase(Module)];
    if SymLoadModule(FProcess, 0, @AnsiString(Module)[1], nil, ImageBase, 0) = 0
       then RaiseLastOsError;

    FFindSymResult := 0;
    FSymToFind := Symbol;
    if not SymEnumerateSymbols(FProcess, ImageBase, @EnumSymbolsCallback, Self)
       then RaiseLastOsError;

    if FFindSymResult = 0
       then raise Exception.Create('Symbol not found');

    Result := FFindSymResult
  end;

  function TSymbols.FindProc(Origin: Pointer; const Module, Proc: String): Integer;
  begin
    Result := GetSymAddress(Module, Proc) - UIntPtr(Origin)
  end;
  
  function FindDiagramCallback(Wnd: HWND; var Rec: TFindDiagramCallbackRec): BOOL; stdcall;
  var
    ClassName: String;
    Len: Integer;
  begin
    Result := True;
    SetLength(ClassName, Length(DiagramClassName) + 1);
    Len := GetClassName(Wnd, @ClassName[1], Length(ClassName) + 1);
    if Len = 0 then RaiseLastOsError;

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

  function FindComponentWnd: HWND;
  var
    Rec: TFindDiagramCallbackRec;
  begin
    Result := FindWindow('TFormARMDStensdMain', nil);
    if Result = 0 then RaiseLastOsError;

    Rec.Result := 0;
    Rec.SeqNum := 1; // первую попавшуюся диаграму
    EnumChildWindows(Result, @FindDiagramCallback, LPARAM(@Rec));
    if Rec.Result = 0
       then raise Exception.Create('Diagram not found');

    Result := Rec.Result
  end;

  function IsProcessWow64(hProcess: THandle): BOOL;
  begin
    if not IsWow64Process(hProcess, Result)
       then RaiseLastOsError
  end;

  function IsWindowsX32: Boolean;
  begin
    {$IFDEF CPUX64}
    Result := False
    {$ELSE}
    Result := not IsProcessWow64(GetCurrentProcess)
    {$ENDIF}
  end;
  
  function GetWindowProc(Wnd: HWND; hProcess: THandle): DWORD;
  const
    GetWindowLongNames: array [Boolean] of String = (
      'GetWindowLongA', 'GetWindowLongW');
  type
    TRgc = packed record
      Push1: Byte;
      Index: LONG;
      Push2: Byte;
      Wnd1: DWORD;
      Call1: Byte;
      x32GetWindowLong: Integer;
      PushEax: Byte;
      Push3: Byte;
      CurrentThread: DWORD;
      Call2: Byte;
      TerminateThread: Integer;
      LastByte: Byte;
    end;
    
  var
    Rgc: TRgc;
    pRgc: ^TRgc;
    hThread: THandle;
    TID: Cardinal;
    Written: SIZE_T;
    Sym: TSymbols;
  begin
    if not IsWindowsX32 and not IsProcessWow64(hProcess)
       then raise Exception.Create('Target platform must be Win32');

    pRgc := VirtualAllocEx(hProcess, nil, SizeOf(TRgc), MEM_COMMIT, 
      PAGE_EXECUTE_READWRITE);
    if pRgc = nil then RaiseLastOsError;

    try
      Sym := TSymbols.Create(hProcess);
      try
        Rgc.Push1 := Push;
        Rgc.Index := GWL_WNDPROC;
        Rgc.Push2 := Push;
        Rgc.Wnd1 := Wnd;
        Rgc.Call1 := Call;
        Rgc.x32GetWindowLong := Sym.FindProc(@pRgc.PushEax, user32, 
          GetWindowLongNames[IsWindowUnicode(Wnd)]);
        Rgc.PushEax := PushEax;
        Rgc.Push3 := Push;
        Rgc.CurrentThread := GetCurrentThread;
        Rgc.Call2 := Call;
        Rgc.TerminateThread := Sym.FindProc(@pRgc.LastByte, kernel32, 'TerminateThread');
      finally
        FreeAndNil(Sym)
      end;

      if not WriteProcessMemory(hProcess, pRgc, @Rgc, SizeOf(TRgc), Written)
         then RaiseLastOsError;
      
      hThread := CreateRemoteThread(hProcess, nil, 0, pRgc, nil, 0, TID);
      if hThread = 0 then RaiseLastOsError;

      try
        if WaitForSingleObject(hThread, INFINITE) <> WAIT_OBJECT_0
           then RaiseLastOsError;
      
        if not GetExitCodeThread(hThread, Result)
           then RaiseLastOsError
      finally
        CloseHandle(hThread)
      end;
    finally
      VirtualFreeEx(hProcess, pRgc, 0, MEM_RELEASE)
    end;

    if Result = 0 
       then raise Exception.Create('Unknown error on target side');
  end;

  function OpenWindowProcess(Wnd: HWND): THandle;
  var
    PID: DWORD;
  begin
    if GetWindowThreadProcessId(Wnd, PID) = 0
       then RaiseLastOsError;

    Result := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or 
      PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION or PROCESS_CREATE_THREAD, 
      False, PID);
    if Result = 0 then RaiseLastOsError
  end;

  function FindDiagramComponent(hProcess: THandle; WndProc: DWORD): DWORD;
  const
    oldvmtSelfPtr      = -88; 
    oldvmtClassName    = -56; 
    oldvmtInstanceSize = -52;  
  var
    MakeObjInstRec: packed record
      Call: Byte;
      StdWndProcOffset: Integer;
      Code, Data: DWORD
    end;
    NumRead: SIZE_T;
    ClassPtr, dw: DWORD;
    ClassName: ShortString;
  begin
    if not ReadProcessMemory(hProcess, Pointer(WndProc), @MakeObjInstRec, 
         SizeOf(MakeObjInstRec), NumRead)
       then RaiseLastOsError;

    if MakeObjInstRec.Call <> Call
       then raise Exception.Create('WndProc should begin with a CALL');

    Result := MakeObjInstRec.Data;
    if not ReadProcessMemory(hProcess, Pointer(Result), @ClassPtr, 
         SizeOf(ClassPtr), NumRead)
       then RaiseLastOsError;

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

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

    if not ReadProcessMemory(hProcess, PByte(ClassPtr) + oldvmtInstanceSize, @dw,
         SizeOf(dw), NumRead)
       then RaiseLastOsError;    
    
    if dw < ArrFieldOffset
       then raise Exception.Create('Instance is too small');     

    if not ReadProcessMemory(hProcess, PByte(ClassPtr) + oldvmtClassName, @dw,
         SizeOf(dw), NumRead)
       then RaiseLastOsError;
    
    if not ReadProcessMemory(hProcess, Pointer(dw), @ClassName, 
         Length(DiagramClassName) + 1, NumRead)
       then RaiseLastOsError;    

    if (Length(ClassName) <> Length(DiagramClassName)) or
       not AnsiSameText(String(ClassName), DiagramClassName)
       then raise Exception.Create('Wrong class name');
  end;

  procedure PrintArray(hProcess: THandle; ComponentPtr: DWORD);
  var
    ArrPtr: DWORD;
    NumRead: SIZE_T;
    Len, i: Integer;
    Arr: array of Double;
  begin
    Inc(ComponentPtr, ArrFieldOffset);
    if not ReadProcessMemory(hProcess, Pointer(ComponentPtr), @ArrPtr, 
         SizeOf(ArrPtr), NumRead)
       then RaiseLastOsError;  

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

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

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

var
  Wnd: HWND;
  hProcess: THandle;

begin
  try
    Wnd := FindComponentWnd;
    hProcess := OpenWindowProcess(Wnd);
    try
      PrintArray(hProcess, FindDiagramComponent(hProcess, GetWindowProc(Wnd, hProcess)));
    finally
      CloseHandle(hProcess)
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln
end.



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


Новичок



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

Репутация: нет
Всего: нет
Спасибо, вы просто ШАМАН. smile 
Я как раз закончил с чтением значения из памяти, но это гораздо лучше. Щас буду разбираться.
PM MAIL   Вверх
bems
Дата 9.5.2018, 16:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 21
Всего: 88
так и это чтение из памяти. если хочется избавиться от жестко забитого смещения поля в объекте, то можешь попытаться читать InitTable объекта в поисках динамического массива даблов. впрочем он наверное там не один, и номер массива тогда придется захардкодить smile


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


Эксперт
****


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

Репутация: 21
Всего: 88
вот еще более короткий вариант не требующий CreateRemoteThread. при сокращении пала смертью храбрых проверка на разрядность целевого процесса, ну и черт с ней smile

Код

program ReadDiagram;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, Winapi.Windows;

type
  TFindDiagramCallbackRec = record
    Result : HWND;
    SeqNum: Integer;
  end;
  PFindDiagramCallbackRec = ^TFindDiagramCallbackRec;

const
  ArrFieldOffset = 752;
  DiagramClassName = 'TFlowDiagram';

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

  function FindDiagramCallback(Wnd: HWND; var Rec: TFindDiagramCallbackRec): BOOL; stdcall;
  var
    ClassName: String;
    Len: Integer;
  begin
    Result := True;
    SetLength(ClassName, Length(DiagramClassName) + 1);
    Len := GetClassName(Wnd, @ClassName[1], Length(ClassName) + 1);
    if Len = 0 then RaiseLastOsError;
    SetLength(ClassName, Len);
    if AnsiSameText(ClassName, DiagramClassName)
       then begin
            Dec(Rec.SeqNum);
            if Rec.SeqNum = 0
               then begin
                    Rec.Result := Wnd;
                    Result := False
                    end;
            end;
  end;

  function FindComponentWnd: HWND;
  var
    Rec: TFindDiagramCallbackRec;
  begin
    Result := FindWindow('TFormARMDStensdMain', nil);
    if Result = 0
       then raise Exception.Create('Top-level window not found');

    Rec.Result := 0;
    Rec.SeqNum := 1; // первую попавшуюся диаграму
    EnumChildWindows(Result, @FindDiagramCallback, LPARAM(@Rec));
    if Rec.Result = 0
       then raise Exception.Create('Diagram not found');

    Result := Rec.Result
  end;

  function OpenWindowProcess(Wnd: HWND): THandle;
  begin
    Result := GetProcessHandleFromHwnd(Wnd);
    if Result = 0 then RaiseLastOsError;
  end;

  function FindDiagramComponent(Wnd: HWND; hProcess: THandle): DWORD;
  const
    oldvmtSelfPtr      = -88;
    oldvmtClassName    = -56;
    oldvmtInstanceSize = -52;
  var
    NumRead: SIZE_T;
    ClassPtr, dw, RM_GetObjectInstance, PID: DWORD;
    ClassName: ShortString;
  begin
    if GetWindowThreadProcessId(Wnd, PID) = 0
       then RaiseLastOsError;

    RM_GetObjectInstance := RegisterWindowMessage('DelphiRM_GetObjectInstance');
    Result := DWORD(SendMessage(Wnd, RM_GetObjectInstance, WPARAM(PID), 0));
    if not ReadProcessMemory(hProcess, Pointer(Result), @ClassPtr,
         SizeOf(ClassPtr), NumRead)
       then RaiseLastOsError;

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

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

    if not ReadProcessMemory(hProcess, PByte(ClassPtr) + oldvmtInstanceSize, @dw,
         SizeOf(dw), NumRead)
       then RaiseLastOsError;

    if dw < ArrFieldOffset
       then raise Exception.Create('Instance is too small');

    if not ReadProcessMemory(hProcess, PByte(ClassPtr) + oldvmtClassName, @dw,
         SizeOf(dw), NumRead)
       then RaiseLastOsError;

    if not ReadProcessMemory(hProcess, Pointer(dw), @ClassName,
         Length(DiagramClassName) + 1, NumRead)
       then RaiseLastOsError;

    if (Length(ClassName) <> Length(DiagramClassName)) or
       not AnsiSameText(String(ClassName), DiagramClassName)
       then raise Exception.Create('Wrong class name');
  end;

  procedure PrintArray(hProcess: THandle; ComponentPtr: DWORD);
  var
    ArrPtr: DWORD;
    NumRead: SIZE_T;
    Len, i: Integer;
    Arr: array of Double;
  begin
    Inc(ComponentPtr, ArrFieldOffset);
    if not ReadProcessMemory(hProcess, Pointer(ComponentPtr), @ArrPtr,
         SizeOf(ArrPtr), NumRead)
       then RaiseLastOsError;

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

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

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

var
  Wnd: HWND;
  hProcess: THandle;
begin
  try
    Wnd := FindComponentWnd;
    hProcess := OpenWindowProcess(Wnd);
    try
      PrintArray(hProcess, FindDiagramComponent(Wnd, hProcess));
    finally
      CloseHandle(hProcess)
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln
end.



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


Новичок



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

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


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 12
Регистрация: 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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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

Это сообщение отредактировал(а) bikovrm - 22.10.2018, 20:16
PM MAIL   Вверх
bikovrm
Дата 22.10.2018, 20:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Пожалуйста, не могли бы Вы помочь мне ещё раз. 
Нужно прочитать  TCategoryButtons, в котором количество строк может быть разным.
user posted image
Уже задолбался в нём ковыряться.   smile  

прога: 

В проге нужно "открыть тест-план F9", -> закладка "пользовательский тест-план" и открыть какой нибуть.
В компоненте TCategoryButtons появится список тестов который и нужно прочитать.
------------------
Если читать Вашим методом, то можно получить список полей:
Код

FButtonFlow : TCatButtonFlow @ 664
FCollapsedHeight : Integer @ 668
FDownButton : TButtonItem @ 672
FDragButton : TButtonItem @ 676
FHotButton : TButtonItem @ 680
FDragCategory : TButtonCategory @ 684
FDragStartPos : TPoint @ 688
FDragStarted : Boolean @ 696
FDragImageList : TDragImageList @ 700
FGradientDirection : TGradientDirection @ 704
FBackGradientDirection : TGradientDirection @ 705
FGutterSize : Integer @ 708
FScrollSize : Integer @ 712
FSideBufferSize : Integer @ 716
FImageChangeLink : TChangeLink @ 720
FImages : TCustomImageList @ 724
FInsertLeft : TBaseItem @ 728
FInsertTop : TBaseItem @ 732
FInsertRight : TBaseItem @ 736
FInsertBottom : TBaseItem @ 740
FIgnoreUpdate : Boolean @ 744
FScrollBarMax : Integer @ 748
FScrollBarPos : Integer @ 752
FPageAmount : Integer @ 756
FButtonCategories : TButtonCategories @ 760
FButtonOptions : TCatButtonOptions @ 764
FButtonWidth : Integer @ 768
FButtonHeight : Integer @ 772
FBorderStyle : TBorderStyle @ 776
FSelectedItem : TBaseItem @ 780
FFocusedItem : TBaseItem @ 784
FMouseInControl : Boolean @ 788
FScrollBarShown : Boolean @ 789
FBackgroundGradientColor : TColor @ 792
FHotButtonColor : TColor @ 796
FSelectedButtonColor : TColor @ 800
FRegularButtonColor : TColor @ 804
FInplaceEdit : TCustomEdit @ 808
FPanPoint : TPoint @ 812
FOnButtonClicked : TCatButtonEvent @ 824
FOnCategoryClicked : TCatButtonCategoryEvent @ 832
FOnCopyButton : TCatButtonCopyEvent @ 840
FOnSelectedButtonChange : TCatButtonEvent @ 848
FOnSelectedCategoryChange : TCatButtonCategoryEvent @ 856
FOnHotButton : TCatButtonEvent @ 864
FOnGetHint : TCatButtonGetHint @ 872
FOnDrawIcon : TCatButtonDrawIconEvent @ 880
FOnDrawText : TCatButtonDrawEvent @ 888
FOnDrawButton : TCatButtonDrawEvent @ 896
FOnBeforeDrawButton : TCatButtonDrawEvent @ 904
FOnAfterDrawButton : TCatButtonDrawEvent @ 912
FOnReorderButton : TCatButtonReorderEvent @ 920
FOnEditing : TCatButtonEditingEvent @ 928
FOnEdited : TCatButtonEditedEvent @ 936
FOnCancelEdit : TCatButtonCancelEditEvent @ 944
FOnReorderCategory : TCategoryReorderEvent @ 952
FOnCategoryCollapase : TCategoryCollapseEvent @ 960


  Кинув на форму компонент CategoryButtons1, посмотрел что поля нужно добавлять в "Categories -> (TButtonCategories)". В прочитанных выше полях это скорее всего "FButtonCategories : TButtonCategories @ 760". А дальше не могу найти смещение.
  Пробовал также найти эти поля через "указатели на указатели" (как в артмани или Cheat Engine), но именно в этом объекте некоторые строки через время все равно теряются, меняется смещение. 

Нашаманьте пож. ещё раз smile 

Это сообщение отредактировал(а) bikovrm - 25.10.2018, 10:21
PM MAIL   Вверх
STest69
  Дата 24.1.2020, 10:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Цитата(bems @ 14.5.2018,  03:28)


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

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


Здравствуйте. Так получилось что мое приложение состоит в основном из Label-ов и графика, подскажите как именно вы узнали смещение? 
PM MAIL   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "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.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




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


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

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