Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2002.09.23;
Скачать: [xml.tar.bz2];

Вниз

Задачка для любознательных   Найти похожие ветки 

 
Digitman   (2002-08-05 18:14) [0]

Имеется :

работающее приложение DstPrg , построенное в Delphi (например, от 5-й версии и выше) с некоей видимой в момент работы формой Frm (имеющей непустую неизменную Caption) и неким контролом Сtl на ней (не имеющим своего Handle); приложение - без исходников.

Задача :

Иcпользуя ту же версию Делфи, построить во внешнем (по отношению к DstPrg) приложении SrcPrg код, реализующий возможность управления неким published-св-вом (например, Visible) контрола Ctl в выполняющемся приложении DstPrg на той же машине в той же ОС.

Иными словами - в "своем" процессе выполнить последовательность действий, устанавливающую некое св-во Ctl.Visible := True/False для чужого объекта на чужой форме в чужом адр.пространстве чужого процесса заранее известного целевого приложения.

Любопытен сам ход мысли (не готовый код, а последовательность действий в таком алгоритме), со ссылками на достоверные источники информации

Если условия не очень понятны, готов уточнить детали.


 
kull   (2002-08-05 18:35) [1]

А по окнам пробежаться через WinAPI?
{
А вообще зачем это надо?
Нет исходников - не твое.
}


 
Digitman   (2002-08-05 18:39) [2]

>kull

По окнам ? Беги, это условиями не ограничено. Что получишь в результате ? Хэндл окна формы Frm, не более того. А дальше ?



 
kull   (2002-08-05 18:58) [3]


> Хэндл окна формы Frm, не более того


А дальше по дочерним окнам...
Получу handle каждого дочернего окна (контрола).
А имея handle - я имею все окно.

Есть же виндовские функции, с помощью которых можно пробежать по всем окнам и по иж дочерним окнам и т.д.


 
evgeg   (2002-08-05 19:06) [4]

А DstPrg строится с Debug Info или нет?


 
Юрий Зотов   (2002-08-05 23:22) [5]

> kull
Не получится. В условии сказано - "неким контролом Сtl на ней (не имеющим своего Handle)". То есть, речь идет о потомках TGraphicControl (TLabel, TSpeedButton, TImage и т.д.). С точки зрения Delphi это нормальные контролы, с точки зрения Windows - просто рисунки. Естественно, функции API их не обнаруживают.


> Digitman
Похоже, это то, о чем мы когда-то говорили? Если так, то путь решения ясен, но обнародовать его не буду, иначе задача потеряет смысл. Сами придумали - сами и рассказывайте. :о)


 
Igorek   (2002-08-06 01:21) [6]

Digitman © (05.08.02 18:14)
Немного покопался - нарисовал такой код.
procedure TForm1.Button1Click(Sender: TObject);
var
c: TWinControl;
i: Integer;
hw: HWND;
begin
hw := FindWindow("TForm1", "Form1");
c := FindControl(hw);//здесь проблема - с всегда nil
//хотя хендл находится
if c <> nil then
for i := 0 to c.ControlCount-1 do
if c.Controls[i].InheritsFrom(TGraphicControl) then
c.Controls[i].Visible := not c.Controls[i].Visible;
end;

Но почему-то не работает. Докапываться нет охоты - хочу спать.


 
Almaz   (2002-08-06 02:27) [7]


> Digitman © (05.08.02 18:14)

Я бы предложил решить задачку таким образом:
1. Находим Handle формы через FindWindow;
2. Находим указатель на объект, соответствующий этой форме через GetProp.
3. Внедряемся в чужой процесс и используем этот указатель по назначению - т.е. выполняем что-то вроде TImage(TForm(P).FindComponent("Image1")).Visible := False;

Весь код приводить не буду - только изюменку (IMHO здесь это шаг №2):

var
AtomText: array[0..31] of Char;
AlienThreadID: Integer;
AlienProcessID: Integer;
AlienControlAtom: TAtom;
H: THandle;
P: Pointer;
...
H := FindWindow("TForm1", "Form1");
AlienThreadID := GetWindowThreadProcessID(H, @AlienProcessID);
AlienControlAtom := GlobalAddAtom(
StrFmt(AtomText, "ControlOfs%.8X%.8X", [HInstance, AlienThreadID]));
P := Pointer(GetProp(H, MakeIntAtom(AlienControlAtom)));
// P - Указатель на объект Form1. (не в нашем адресном пространстве :)

... // Поехали внедрятся и извращаться


Вот и все. Хотя наверно можно проще.


 
Digitman   (2002-08-06 08:31) [8]

>kull

Нет у контрола хэндла. Не TWinControl он. Ну, пусть это будет, скажем, TLabel.

>Юрий Зотов

Да, то самое) Но придумал не я. Просто фигурировавшая как-то раз задачка на самом деле интересна и не так уж тривиальна, думаю, и многим небесполезно будет знать, как она решается (хотя бы в общих чертах)

>evgeg

Это не столь важно. Ну, пусть будет - с Debug Info

>Igorek

DstPrg - это "чужой", не "твой" процесс.

>Almaz
Отличная идея ! Все верно -"плясать" нужно от получения указателя на Frm в АП DstPrg ! Дальше - уже проще дело пойдет.
Только вот зачем атом создаешь ? Его искать нужно ! Он уже существует - достаточно только локализовать его хэндл, имея Caption формы и зная, что имя атома имеет строго определенный формат :

wndatom:= GlobalFindAtom(StrFmt(AtomText, "Delphi%.8X", [DstProcessId]));

DstFormWinControl:= TWinControl(GetProp(DstFormHWnd, MakeIntAtom(wndatom)));


 
MBo   (2002-08-06 08:50) [9]

>зная, что имя атома имеет строго определенный формат
? откуда узнать ?


 
MBo   (2002-08-06 09:06) [10]

> откуда узнать ?
Пардон, уже разобрался


 
ACR   (2002-08-06 09:24) [11]

какую страшную аляйнскую технологию вы придумали

procedure InitControls;
var
AtomText: array[0..31] of Char;
begin
WindowAtom := GlobalAddAtom(StrFmt(AtomText, "Delphi%.8X",
[GetCurrentProcessID]));
ControlAtom := GlobalAddAtom(
StrFmt(AtomText, "ControlOfs%.8X%.8X", [HInstance, GetCurrentThreadID]));
CanvasList := TThreadList.Create;
InitIMM32;
Mouse := TMouse.Create;
Screen := TScreen.Create(nil);
Application := TApplication.Create(nil);
InitCtl3D;
Application.ShowHint := True;
RegisterIntegerConsts(TypeInfo(TCursor), IdentToCursor, CursorToIdent);
end;



 
Digitman   (2002-08-06 09:34) [12]

Ну, а дальше-то ? Вот, получили мы ссылку на форму в АП целевого процесса DstPrg ... дальше - самое интересное ...

Пусть на форме лежит некий Label1: TLabel ...


 
MBo   (2002-08-06 09:42) [13]

Дык не выходит пока каменный цветок, пытаюсь OpenProcess, ReadProcessMemory


 
Просто Доброжелатель   (2002-08-06 10:28) [14]

Не занимаетесь ли вы фигней?
Это уже не программирование а крякерство.
А это разные вещи.


 
Digitman   (2002-08-06 10:42) [15]

Тебе ли судить, Просто Доброжелатель ? Что-то не видать тебя в иных разделах форума, кроме как в "Потрепаться") ... Хоть бы представился в анкете, кто ты и что ты .... Или - идею представил интересную по задачке, что , imho, гораздо лучше, нежели вставлять никчемные и не по сабжу комментарии


 
kull   (2002-08-06 11:08) [16]

Просто Доброжелатель - это я.

> Тебе ли судить,

1. А судьи кто?

2. А предложение не заниматься ерундой не считаю никчемным.
3. Ну напишу я свои данные в анкете и что дальше, что изменится?

Да, до сих пор в нашей стране жива совковая философия - без бумашки ты букашка, а с анкетой -человек...


 
kull   (2002-08-06 11:13) [17]

Или вы думаете, что если бы сообщение выглядело так:

Anatoly Podgoretsky © (06.08.02 11:08)
Это уже не программирование а крякерство.
А это разные вещи.


То смысл этих строк поменялся бы?
Да у вас здесь ребята авторитарный режим.


 
ACR   (2002-08-06 11:21) [18]

не обращая внимание на доброжелателя давйте продолжим разговор
о том как нм вызвать функцию их адресного пространства другого процесса? IPC?


 
kull   (2002-08-06 11:22) [19]


> о том как нм вызвать функцию их адресного пространства другого
> процесса? IPC?

А зачем ???????


 
Digitman   (2002-08-06 11:24) [20]

>kull

Все с тобой ясно, сударь.


>ACR

так какие будут мысли по поводу ?


 
Ученик   (2002-08-06 11:24) [21]

>Digitman
Если решение будет найдено, то как Вы считаете его стоит публиковать на сайте или речь идет о путях возможного решения ?


 
Digitman   (2002-08-06 11:29) [22]

>Ученик

Просто - о путях возможного решения: реального решения, замечу, не "сказочного")...

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


 
kull   (2002-08-06 11:29) [23]

Вы че ребята, у вас что других проблем нет?
Уже все другие задачи решили, чтобы уже Label-ами баловаться на чужих приложениях.

Зачем?
Ну давайте в ядре еще покопаемся...


 
Задумавшийся   (2002-08-06 11:37) [24]

Может, создать в адресном процессе тело ф-и без параметров
выполняющую SetProp(...), и послать её форме через CM_EXECPROC?

(что-то a la MakeObjectInstance)


 
ACR   (2002-08-06 11:42) [25]

если другой процесс не "расположен к общению" то "трогать" его нельзя это "философия виндовс"

вот интересная статейка:
http://www.delphikingdom.com/mastering/safe/crypt4.htm


 
kull   (2002-08-06 11:48) [26]


> если другой процесс не "расположен к общению" то "трогать"
> его нельзя это "философия виндовс"

Ну вот, хоть одна здравая мысля.


 
Digitman   (2002-08-06 12:01) [27]

>Задумавшийся

С чего ты взял, что форма обрабатывает это сообщение ?

>ACR

Задачка - У-ЧЕБ-НА-Я ! При чем здесь философия ? Я достаточно четко определил ее условия : версия Делфи , в которой построены SrcProg и DstProg - известна и одинакова. Это тебе ни о чем не говорит ? Очень важное условие !


 
Ученик   (2002-08-06 13:56) [28]

>Digitman
Код скрывает все TLabel на чужой форме, публикуем ?


 
Digitman   (2002-08-06 14:04) [29]

>Ученик

Конечно ! О чем речь ! По кр.мере мне прелюбопытно было бы взглянуть на твое решение в коде, хотя я и не настаивал в условиях на этом ..


 
Ученик   (2002-08-06 14:18) [30]

Немного поспешил, код скрывает все не TWinControl, но так уж получилось, что на форме были TLabel-ы, развитие позже, если получится

type
TPrivateControl = class(TComponent)
private
FParent: TWinControl;
FWindowProc: TWndMethod;
FLeft: Integer;
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FControlStyle: TControlStyle;
FControlState: TControlState;
FDesktopFont: Boolean;
FVisible: Boolean;
end;

TPrivateWinControl = class(TControl)
private
FAlignLevel: Word;
FBevelEdges: TBevelEdges;
FBevelInner: TBevelCut;
FBevelOuter: TBevelCut;
FBevelKind: TBevelKind;
FBevelWidth: TBevelWidth;
FBorderWidth: TBorderWidth;
FBrush: TBrush;
FDefWndProc: Pointer;
FDockClients: TList;
FDockManager: IDockManager;
FHandle: HWnd;
FImeMode: TImeMode;
FImeName: TImeName;
FObjectInstance: Pointer;
FParentWindow: HWnd;
FTabList: TList;
FControls: TList;
end;

TPrivateList = class(TObject)
private
FList: PPointerList;
FCount: Integer;
FCapacity: Integer;
end;

function ThreadProc(Params : Pointer): Integer; stdcall;
var
i : Integer;
begin
with TPrivateWinControl(PLongInt(Params)^) do begin
for i := 0 to TPrivateList(FControls).FCount - 1 do
with TPrivateControl(TPrivateList(FControls).FList[i]) do
FVisible := False;
Invalidate
end;
Result := 0
end;

procedure RemoteRunProc(aProcessID : DWord; aProc : TFNThreadStartRoutine;
aParams : Pointer; aParamsSize : DWord);
var
dwRemoteThreadID, dwSize : DWord;
hThread, hProcess : THandle;
Proc, Params : Pointer;
begin
if aProcessID <> 0 then begin
hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or
PROCESS_VM_WRITE or PROCESS_VM_READ, False, aProcessID);
if hProcess <> 0 then try
Proc := VirtualAllocEx(hProcess, nil, $4000, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
if Proc <> nil then try
Params := VirtualAllocEx(hProcess, nil, aParamsSize, MEM_COMMIT, PAGE_READWRITE);
if Params <> nil then try
if WriteProcessMemory(hProcess, Proc, @ThreadProc, $4000, dwSize) and
WriteProcessMemory(hProcess, Params, aParams, aParamsSize, dwSize) then begin
hThread := CreateRemoteThread(hProcess, nil, 0, Proc, Params,
0, dwRemoteThreadID);
if hThread <> 0 then try
ResumeThread(hThread);
WaitForSingleObject(hThread, INFINITE);
finally
CloseHandle(hThread)
end
end
finally
VirtualFreeEx(hProcess, Params, 0, MEM_RELEASE)
end
finally
VirtualFreeEx(hProcess, Proc, 0, MEM_RELEASE)
end
finally
CloseHandle(hProcess)
end
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hWindow : HWnd;
hWndInst : THandle;
dwProcessID : DWord;
ControlAtomString : string;
RM_GetObjectInstance : DWord;
Form : Pointer;
begin
hWindow := StrToInt("$" + Edit1.Text);
if hWindow <> 0 then begin
hWndInst := GetWindowLong(hWindow, GWL_HINSTANCE);
ControlAtomString := Format("ControlOfs%.8X%.8X", [hWndInst,
GetWindowThreadProcessId(hWindow, @dwProcessID)]);
RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
Form := Pointer(SendMessage(hWindow, RM_GetObjectInstance, 0, 0));
RemoteRunProc(dwProcessID, @ThreadProc, @Form, 4);
end
end;




 
DiamondShark   (2002-08-06 14:22) [31]


> версия Делфи , в которой построены SrcProg и DstProg - известна
> и одинакова


Действительно важное условие. Притаком раскладе поступаем так:

1. Окно формы находим без проблем
2. Ставим хук WH_CALLWNDPROC
3. Окну формы посылаем какое-то спец. сообщение, например WM_USER + 123. Срабатывает хук, в процедуре хука фиксируем DLL вызовом LoadLibrary -- мы внедрились со своим кодом в адресное пространство чужого процесса.
4. По хэндлу формы используем находид TForm. Только FindControl из DLL не работает, поэтому надо так (для D5)

function HackFindControl(Handle: HWND): TWinControl;
var
ControlAtom: TAtom;
AtomText: packed array[byte] of char;
begin
ControlAtom := GlobalFindAtom(
StrFmt(AtomText,
"ControlOfs%.8X%.8X",
[GetWindowLong(Handle, GWL_HINSTANCE), GetCurrentThreadID]));
Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)));
end;

5. Версии одинаковые, поэтому смело используем свойство Components, проверку типа IS, приведение типов.

Законченный проект писать влом (за исключением DLL с функцией HackFindControl), но идея ясна.

Помидоры помягче, пожалуйста


 
DiamondShark   (2002-08-06 14:24) [32]

Ученик

А под Win9x ?


 
Ученик   (2002-08-06 14:26) [33]

>DiamondShark
Без наворотов


 
DiamondShark   (2002-08-06 14:36) [34]

Ученик

CreateRemoteThread

Requirements
Windows NT/2000/XP: Included in Windows NT 3.1 and later.
Windows 95/98/Me: Unsupported.
Header: Declared in Winbase.h; include Windows.h.
Library: Use Kernel32.lib.
--------------------

VirtualAllocEx

Requirements
Windows NT/2000/XP: Included in Windows NT 4.0 and later.
Windows 95/98/Me: Unsupported.
Header: Declared in Winbase.h; include Windows.h.
Library: Use Kernel32.lib.



 
Ученик   (2002-08-06 14:42) [35]

>DiamondShark
В Windows 95/98 это все не нужно, даже дата Biosа узнается по прямому адресу


 
Digitman   (2002-08-06 14:56) [36]

>Ученик

Идея ясна. Все навскидку вроде бы красиво и ожидаемо.

А кому сообщение шлешь RM_GetObjectInstance ? Кто его обработает ?

Не совсем понятно так же назначение классов TPrivateControl и TPrivateWinControl в контексте задачи. Вот у <DiamondShark> более, мне кажется, простое решение - св-во Components ведь доступно и корректно работать будет по условиям совместимости версий Делфи ! Или у тебя есть иное мнение ?

>DiamondShark
Ну, пусть это Винтукей будет) Я понял - ты универсальное решение сразу предлагаешь. Что ж , тоже верно, но Маздай пусть пока отдыхает вместе с хуками за неимением CreateRemoteThread() - некрасиво задачка в Маздае получается, хотя и должно работать

В общем, с вашего позволения делаем такое резюме : для решения такой задачки главное - корректно "прописаться" со своим кодом в АП DstPrg (любыми доступными способами), а там, зная ссылку на объект-форму, можно уже вытворять с ней почти все, что угодно.


 
Ученик   (2002-08-06 15:07) [37]

>Digitman

>А кому сообщение шлешь RM_GetObjectInstance ? Кто его обработает ?

procedure TWinControl.DefaultHandler(var Message);
begin
...
if Msg = RM_GetObjectInstance then
Result := Integer(Self)
end;

>Не совсем понятно так же назначение классов TPrivateControl и TPrivateWinControl в контексте задачи.

ControlCount, Controls[i], Visible не работают, необходимо прямое обращение.

>Вот у <DiamondShark> более, мне кажется, простое решение - св->во Components ведь доступно и корректно работать будет по >условиям совместимости версий Делфи ! Или у тебя есть иное >мнение ?

Может быть, но по-моему на Windows NT, 2000, XP работать не будет.


 
Digitman   (2002-08-06 15:26) [38]

>Ученик

procedure TWinControl.DefaultHandler(var Message);
begin
...
if Msg = RM_GetObjectInstance then
Result := Integer(Self)
end;

Откуда взят этот фрагмент ?

>>"по-моему на Windows NT, 2000, XP работать не будет."

Обоснуй



 
Ученик   (2002-08-06 15:31) [39]

>Digitman

>Откуда взят этот фрагмент ?

controls.pas

>Обоснуй
При написании кода возникли проблемы с обращением к Controls, c Components, наверно, будет тоже самое





 
Digitman   (2002-08-06 15:57) [40]

>Ученик

хммм ..

вот то, что я вижу в модуле controls.pas

procedure TWinControl.DefaultHandler(var Message);
begin
if FHandle <> 0 then
begin
with TMessage(Message) do
begin
if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
begin
Result := Parent.Perform(Msg, WParam, LParam);
if Result <> 0 then Exit;
end;
case Msg of
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
begin
SetTextColor(WParam, ColorToRGB(FFont.Color));
SetBkColor(WParam, ColorToRGB(FBrush.Color));
Result := FBrush.Handle;
end;
else
Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;
if Msg = WM_SETTEXT then
SendDockNotification(Msg, WParam, LParam);
end;
end
else
inherited DefaultHandler(Message);
end;

???



Страницы: 1 2 вся ветка

Форум: "Потрепаться";
Текущий архив: 2002.09.23;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.008 c
1-73610
Злой!!!
2002-09-12 12:51
2002.09.23
Перевод строки


3-73553
Ihor Osov'yak
2002-09-03 10:58
2002.09.23
Access & Foregin key


1-73687
kay
2002-09-11 04:42
2002.09.23
Panel


1-73751
Брат
2002-09-11 16:30
2002.09.23
Как програмно открыть общий доступ к папке?


1-73646
Демонов Е.В.
2002-09-10 16:29
2002.09.23
А что если метод в секцию Published ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский