Как увеличить размер часов в трэе?

[GSerg]

Вражины...
Юзают переменные для разных целей... Прям как я...

Фиг знает, смогу ли я это перевести полностью по этой причине... Во всяком случае, сейчас лучше поспать


Принцип:
Имеется библа. Она содержит две процедуры для сабклассинга и функции установки\удаления хука. Ищется трей. Определяется его ThreadID. Ставится хук WH_WNDPROCRET на этот ThreadID. Это вызывает подгрузку библиотеки в адресное простанство трея (собственно, ради этого хук и ставился, сам-то по себе он не нужен). Как только процедура обработки хука получает первое сообщение, она устанавливает 2 сабклассинга: на сам трей и непосредственно на часики. После этого отлов сообщения, указанного tyomitch'ем, труда не составляет

Кстати, прикольный метод внедрения в чужое адресное пространство

[tyomitch]

GSerg, когда переведешь, скажи, через что ты получил то, что переводишь на VB!

Я догадываюсь, через что...
Эх, GSerg, я же сразу говорил - надо хуки, а ты говорил - обойдёшься без них...

[GSerg]

Меня смутило то, что хук не имеет права изменять мессагу. Я не допетрил, что хук - только для протаскивания библы в адресное пространство

[tyomitch]

Самое интересное, что я про этот трюк знал, но забыл тонкости...

Ну что, код-то перевёл целиком?
Длл-ку для хука сможем на VB написать?

[GSerg]

Неее, люди...
Щас добрался до кода subclass callback... Мало того, что там жуткий select case, так ещё и рисование тоже там... Я просто заблужусь в этом страшном дереве. К тому же, нам ведь нужно просто увеличить размер часов Сообщение мы знаем, так что напишем и сами искомый код.

У меня только один вопрос возник - почему они сравнивают hWnd с lResult? Ведь процедуре CallWndProcRet в качестве lParam передаётся указатель на CWPRETSTRUCT. Они берут её первый мембер и сравнивают с hWnd - ну какого фига?..

Код: Выделить всё

Option Explicit

Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_WNDPROC As Long = -4
Private Const WH_CALLWNDPROCRET As Long = 12

Private Type InternalInfo
  hWndTray As Long
  hHook As Long
End Type

Private Type CWPRETSTRUCT
  lResult As Long
  lParam As Long
  wParam As Long
  message As Long
  hWnd As Long
End Type

Private v413578 As InternalInfo
Private v4146BC As Long, v4146B0 As Long, v4146B4 As Long, v4146AC As Long, v4144B4 As Long, v4146C0 As Long, v4146B8 As Long

'v413578 - указатель на структуру InternalInfo. Я убрал один уровень косвенности.
'v4144B4 - то, что даётся хуку в качестве hModule
'v4146B0 - hWnd Shell_TrayWnd
'v4146B4 - ThreadID часиков
'v4146AC - hWnd часиков
'v4146B8 - hWnd окна TChameleonClock
'v4146BC - old clock callback address
'v4146C0 - old tray callback address

' 4129F8 - hook callback address       (-> addressof CallWndProcRet)
' 4126E8 - new clock callback address  (-> addressof ClockCallback)
' 412384 - new tray callback address   (-> addressof TrayCallback)

Public Function SetHook() As Long
  v4146AC = GetClock
  v4146B0 = FindWindow("Shell_TrayWnd", vbNullString)
  If v4146AC Then v4146B4 = GetWindowThreadProcessId(v4146B0, ByVal 0&)
  v413578.hHook = SetWindowsHookEx(WH_CALLWNDPROCRET, &H4129F8, v4144B4, v4146B4) '<- !!!
  SetHook = v413578.hHook
End Function

Private Function CallWndProcRet(ByVal ncode As Long, ByVal wParam As Long, lParam As CWPRETSTRUCT) As Long
  If ncode < 0 Then
    'CallWndProcRet = CallNextHookEx(inf.hHook, ncode, wParam, lParam)
    'Они почему-то возвращают 0...
    'Это против рекомендаций мелкософта, но я менять не стал.
    CallNextHookEx inf.hHook, ncode, wParam, lParam
    CallWndProcRet = 0
  Else
    If v413578.hWndTray = 0 Then
      CallWndProcRet = 0
    Else
      If v4146BC <> 0 Then   'если уже поставили сабклассинг, то выходим
        CallWndProcRet = 0
      Else
        Select Case lParam.lResult 'Какого фига они сравнивают hWnd c lResult???
        Case v4146B0, v4146AC
          v4146AC = GetClock
          v4146B0 = FindWindow("Shell_TrayWnd", vbNullString)
          SetLastError 0
         
          v4146BC = GetWindowLong(v4146AC, GWL_WNDPROC)
          SetWindowLong v4146AC, GWL_WNDPROC, &H4126E8   '<- !!!
         
          v4146C0 = GetWindowLong(v4146B0, GWL_WNDPROC)
          SetWindowLong v4146B0, GWL_WNDPROC, &H412384   '<- !!!
         
          v4146B8 = FindWindow("TChameleonClock", vbNullString) 'да, на дельфи писан...
        End Select
        CallWndProcRet = 0
      End If
    End If
  End If
End Function

Private Function ClockCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
End Function

Private Function TrayCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
End Function


Private Function GetClock() As Long
  If v4146B0 Then GetClock = GetDlgItem(GetDlgItem(v4146B0, &H12F&), &H12F&)
End Function

[A.A.Z.]

А какое сообщение мы знаем?

[GSerg]

А про какое ув. тов. tyomitch говорил?

[A.A.Z.]

А-а-а, WM_CALCMINSIZE-то?

[tyomitch]

Няп это просто ассемблерный дамп, приведённый к синтаксису VB? А где же прогресс?
Вот щас сел бы и стал писать, да завтра вставать рано... А руки так и чешутся...

[GSerg]

Хе-хе

Проблема знаешь в чём? В том, что я никак не могу понять, где вы надыбали описание WM_USER+100. Что через параметры-то идёт? Явно не указатели.

Всё-таки тоже пойду спать.
Хотя день рожденья де-факто начался...

[FaKk2]

Хотя день рожденья де-факто начался...

А че так тихо и в сторону?

Желаю счастья в личной жизни...Пух! (шутка )

Поздравляю от всей души

[alibek]

Хотя день рожденья де-факто начался...

Вот-то ж!
С Днем Варенья тебя! Желающие подергать уши, занимать очередь за мною!

[tyomitch]

Ок, встаю в очередь

[A.A.Z.]

Хотя день рожденья де-факто начался...

Здорово, поздравляю! А у меня 12го был
И сколько тебе стукнуло, если не секрет?

[GSerg]

Не секрет, 22

Касаемо часиков могу доложиться...
Написал простейшую библу, которая реагирует на эту мессагу и ставит размер фиксированным... Долго пытался применить. При каждой попытке вылетал весь таскбар.
Переписал тот же самый код без единого изменения на дельфи. Работает. Не буду скриншот прикладывать, на часы у меня теперь длинные... Я не могу их уменьшить, щас объясню почему...

Так вот.
Во-первых. Естественно, библа на VB использует оператор addressof. Мне так кажется, что компилятор, гад, не включает места применения этого оператора на секцию reloc. Поэтому сейчас нужно попробовать сделать ту же библу методом г-на... на как его... A.A.Z., ты помнишь... Если получится, то делаем вывод о неприменимости моего способа. Если не получится, тогда вообще имеет ли смысл писать библы на VB...

Во-вторых. Функция выгрузки не работает. Не работает, естественно, потому, что после установки хука создаётся новый инстанс библы в адресном пространстве таксбара, и у него там все переменные свои. Поскольку на VB нет возможности объявить переменные, общие для всех библ, то придётся заводить filemaping для этого.

Гемора куча, короче.


Так что, A.A.Z., скомпилируй эту библу тем методом, создай тестовый проектик с единственным вызовом SetHook и, если не рухнет, поизменяй размер таскбара.

А я пойду ребутиться, а то часы длинные, некрасиво...

[GSerg]

Да, библу-то забыл.

Код: Выделить всё

Private hInst As Long, hHook As Long, prevproc As Long, hw As Long

Public Function DllMain(ByVal hInstDll As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
  'TODO:
  'Поместите здесь код инициализации библиотеки.
  Select Case fdwReason
  Case DLL_PROCESS_ATTACH
    '
   
    DllMain = 1
  Case DLL_PROCESS_DETACH
    '
   
  Case DLL_THREAD_ATTACH
    '
   
  Case DLL_THREAD_DETACH
    '
   
  End Select
 
  hInst = hInstDll
End Function

Private Function SetHook() As Long
  If hHook = 0 Then
    hw = GetDlgItem(GetDlgItem(FindWindow("Shell_TrayWnd", vbNullString), &H12F&), &H12F&)
    If hw Then
      hHook = SetWindowsHookEx(WH_CALLWNDPROCRET, AddressOf CallWndProcRet, hInst, GetWindowThreadProcessId(hw, ByVal 0&))
      If hHook Then SetHook = 1
    End If
  End If
End Function

Private Function RemoveHook() As Long
  If prevproc Then SetWindowLong hw, GWL_WNDPROC, prevproc
  If hHook Then UnhookWindowsHookEx hHook
End Function

Public Function ClockCallback(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_USER_PLUS_100 Then ClockCallback = &H300060 Else ClockCallback = CallWindowProc(prevproc, hw, uMsg, wParam, lParam)
End Function

Public Function CallWndProcRet(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If nCode >= 0 Then
    If prevproc = 0 Then
      hw = GetDlgItem(GetDlgItem(FindWindow("Shell_TrayWnd", vbNullString), &H12F&), &H12F&)
      prevproc = SetWindowLong(hw, GWL_WNDPROC, AddressOf ClockCallback)
    End If
  End If
  CallWndProcRet = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

[GSerg]

Хммм....
Меня терзают смутные сомненья...

[GSerg]

Нет.
Не понимаю... Компилятор правильно расставляет адреса и пихает их в reloc... Хук ставится. Библа загружается в адресное пространство, и msvbvm тоже протаскивается, а сабклассинг рушится...

Странно это всё...

[A.A.Z.]

1) Круто А мне - 14
2) Daniel Lo Nigro?
3) Скомпилил, запустил, потом в другом проекте вызвал SetHook => Explorer.exe - обнаружена ошибка

[A.A.Z.]

[A.A.Z.]

GSerg, а на делфи все работает?

[GSerg]

Угу...

Думаю, будет нам с Тёмычем что пообсуждать мылом... Я ему уже отправил...

Ну не понимаю я, почему не работает... Хотя и подозреваю...

[A.A.Z.]

А можно мне тоже делфи-проект?

[GSerg]

Ээээ... Я такую фигню обычно не сохраняю...

Ну ладно, чё ж делать, щас...
Только это куда больше рыба, чем не рыба...

Пять сек...

[A.A.Z.]

Я бы и сам накатал - да вот беда - делфи знаю на 0,00%

[GSerg]

Ну и ... эээ... зачем тебе тогда это? Я ж говорю - код абсолютно идентичен.

[A.A.Z.]

Хотелось бы просто взглянуть на промежуточный результат...

[GSerg]

Код: Выделить всё

library Project1;

uses windows;

const WM_USER_PLUS_100:cardinal=$464;

var prevproc:pointer; hh:HHOOK;


function ClockCallback(hW:HWND; uMsg:cardinal; wPar:WPARAM; lPar:LPARAM):integer;stdcall;
begin
  if umsg=WM_USER_PLUS_100 then result:=$00300060 else result:=callwindowproc(prevproc,hw,umsg,wpar,lpar);
end;

function HookCallback(nCode,wParam,lParam:integer):integer;stdcall;
begin
  if ncode>=0 then begin
    if prevproc=nil then prevproc:=pointer(setwindowlong(getdlgitem(getdlgitem(findwindow('Shell_TrayWnd', nil),$12f),$12f),gwl_wndproc,integer(@ClockCallback)));
  end;
  result:=CallNextHookEx(hh, nCode, wparam,lparam);
end;

function SetHook:integer;stdcall;
begin
  hh:=SetWindowsHookEx(WH_CALLWNDPROCRET,@HookCallback,hInstance,GetWindowThreadProcessId(getdlgitem(getdlgitem(findwindow('Shell_TrayWnd', nil),$12f),$12f),nil));
  result:=integer(hh);
end;

exports SetHook;

begin
end.

[A.A.Z.]

Пасиба!

[GSerg]

Меня снова терзают смутные сомненья... Ну-ка...