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

Поиск:

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


Новичок



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


Эксперт
****


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

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



а софтину где скачать? и запустится ли она без железки?


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


Новичок



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

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



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

использование в доке

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


Эксперт
****


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

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



вот чтение грида, кнопки я никакие не нажимаю, так что для проверки кода форму сначала нужно привести в правильное состояние вручную

Код

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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



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


Эксперт
****


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

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



10.2


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


Новичок



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

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



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


Новичок



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

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



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

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

user posted image

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


Эксперт
****


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

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



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


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


Новичок



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

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



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

обновление в графике происходит с железа, но.. 
На закладке "расход ctrl+f4" можно самому в ручную менять значение в ячейке "см3:"

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


Эксперт
****


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

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



ну ок, попробую


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


Эксперт
****


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

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



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

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 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



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


Эксперт
****


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

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



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


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


Эксперт
****


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

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



вот еще более короткий вариант не требующий 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   Вверх
Google
  Дата 26.5.2018, 20:52 (ссылка)  





  Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "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.1047 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


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

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