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

[hCORe]

На VB-то?

Обижаешь. M$ QuickBasic 4.5

[Mleha]

Вот аналог часов на Delphi

[A.A.Z.]

Это-то мы и на VB сделали Даже стрелочные Нам бы размер трэя увеличить...

[tyomitch]

Ура! Урра!! А-а-а-а!!!

ЧАСЫ РАСШИРЕНЫ!!

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

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function OpenThread Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Const PROCESS_CREATE_THREAD = &H2&
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_WRITE = &H20&
Private Const SYNCHRONIZE = &H100000
Private Const MEM_RESERVE = &H2000&
Private Const MEM_COMMIT = &H1000&
Private Const MEM_DECOMMIT = &H4000&
Private Const MEM_RELEASE = &H8000&
Private Const PAGE_EXECUTE_READWRITE = &H40&

Sub Main()
Dim hWnd As Long, PID As Long, hProcess As Long
Dim pStub As Long, TID As Long, hThread As Long
hWnd = GetDlgItem(GetDlgItem(FindWindow("Shell_TrayWnd", vbNullString), &H12F&), &H12F&)
GetWindowThreadProcessId hWnd, PID
hProcess = OpenProcess(PROCESS_CREATE_THREAD Or PROCESS_VM_OPERATION Or PROCESS_VM_WRITE, 0, PID)
pStub = VirtualAllocEx(hProcess, 0, 100, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
WriteProcessMemory hProcess, pStub + 4, &HB8EC8B55, 4, 0    'push ebp; mov ebp,esp; mov eax,
WriteProcessMemory hProcess, pStub + 8, GetProcAddress(GetModuleHandle("user32"), "SetWindowLongW"), 4, 0
WriteProcessMemory hProcess, pStub + 12, &H68, 1, 0         'push
WriteProcessMemory hProcess, pStub + 13, pStub + 35, 4, 0
WriteProcessMemory hProcess, pStub + 17, &H68FC6A, 3, 0     'push GWL_WNDPROC; push
WriteProcessMemory hProcess, pStub + 20, hWnd, 4, 0
WriteProcessMemory hProcess, pStub + 24, &HA3D0FF, 3, 0     'call eax; mov [imm32],eax
WriteProcessMemory hProcess, pStub + 27, pStub, 4, 0
WriteProcessMemory hProcess, pStub + 31, &H4C2C9, 4, 0      'leave; ret 4
WriteProcessMemory hProcess, pStub + 35, &H81EC8B55, 4, 0   'push ebp; mov ebp,esp; cmp
WriteProcessMemory hProcess, pStub + 39, &H4640C7D, 4, 0    'dword ptr [ebp+0Ch],464h
WriteProcessMemory hProcess, pStub + 43, &H9750000, 4, 0    'jnz $+0Bh
WriteProcessMemory hProcess, pStub + 47, &HB8, 1, 0         'mov eax,
WriteProcessMemory hProcess, pStub + 48, &H100060, 4, 0
WriteProcessMemory hProcess, pStub + 52, &H10C2C9, 4, 0     'leave; ret 10h
WriteProcessMemory hProcess, pStub + 56, &HFF1475FF, 4, 0   'push dword ptr [ebp+14h]; push
WriteProcessMemory hProcess, pStub + 60, &H75FF1075, 4, 0   'dword ptr [ebp+10h]; push dword ptr
WriteProcessMemory hProcess, pStub + 64, &H875FF0C, 4, 0    '[ebp+0Ch]; push dword ptr [ebp+8]
WriteProcessMemory hProcess, pStub + 68, &HA1, 1, 0         'mov eax,[imm32]
WriteProcessMemory hProcess, pStub + 69, pStub, 4, 0
WriteProcessMemory hProcess, pStub + 73, &HE7EBD0FF, 4, 0   'call eax; jmp $-17h

CreateRemoteThread hProcess, ByVal 0&, 0, pStub + 4, 0, 0, TID
hThread = OpenThread(SYNCHRONIZE, 0, TID)
WaitForSingleObject hThread, -1
CloseHandle hThread
VirtualFreeEx hProcess, pStub, 100, MEM_DECOMMIT Or MEM_RESERVE
CloseHandle hProcess
End Sub


Проверено на Win2000; может работать на WinXP, точно не будет работать на Win9x и WinNT4-.

[Ennor]

Монстр... Смещения в ассемблерном коде сам рассчитывал, или тулзу какую припахал?

Н-да, три раза "мы - черви".

[tyomitch]

Тулзу Masm32 называется

[GSerg]

Гы-гы-гы Извращенец! Если я говорю "попробуй", то это не значит, что это не извращение

Однако же...
предлагаю объединить подход 2k>= с подходом <=98. Как мы все помним, в 98 разрешается сабклассить чужие окна

Давай, пиши полную версию, работающую везде, а я спать пошёл

[A.A.Z.]

!!!
Круто!!!
Спасибо!!!

[A.A.Z.]

Вот только как она работает?
Точнее, куда это надо добавить, чтобы работало?

[A.A.Z.]

Ой! :) Заработало :)) После закрытия ВБ :)))

!!!
Круто!!!
Спасибо!!!

[A.A.Z.]

А теперь еще раз, для тупых В каком месте кода увеличивается трэй?

[GSerg]

Что значит в каком?

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

WriteProcessMemory hProcess, pStub + 47, &HB8, 1, 0         'mov eax,
WriteProcessMemory hProcess, pStub + 48, &H100060, 4, 0

Вот видищь (c), всё очень просто. Пихаем в eax нужный размер часиков

[A.A.Z.]

О, большой-большой THANKS! Вот такой
Спа-си-ба! Всем, кто помогал Особенно Сергею и Артёму

[A.A.Z.]

В продолжение темы: как заставить трэй обновиться? После выполнения указанного выше кода он растягивается только тогда, когда нажмешь на кнопочку "<" (в ХР), или когда добавишь туда свою иконку, что я, собственно, до сего дня и делал. Все бы ничего (добавил-удалил, делов-то), но почему-то при закрытии проги, когда трэй я уменьшаю, он добавляет иудаляет иконку моей проги секунд 10, что ужасно раздражает Почему так? Надеюсь, проблема разрешаемая

[tyomitch]

Попробуй послать кому-нибудь (часам, notification area, таскбару целиком, всем окнам сразу ) WM_SETTINGCHANGE. Тогда таскбар обязан будет перерисоваться.

[A.A.Z.]

Всем окнам попробую

[A.A.Z.]

Трэй расширился, но VB полностью завис

[A.A.Z.]

Ну что за?? Все остальные (часы, notification area, таскбар целиком) не катят, а на HWND_BROADCAST все нафиг виснет
Кстати, а почему надо слать WM_WININICHANGE? Точнее, почему так константа называется?

[GSerg]

Дык потому что раньше хранилось всё в ini

The WM_WININICHANGE message is provided only for compatibility with earlier versions of the system. Applications should use the WM_SETTINGCHANGE message.

[A.A.Z.]

Дык это...

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

Private Const WM_SETTINGCHANGE As Long = WM_WININICHANGE
Private Const WM_WININICHANGE As Long = &H1A

[GSerg]

Ну правильно, они равны

Что тебя смущает?

[A.A.Z.]

Дык это!

The WM_WININICHANGE message is provided only for compatibility with earlier versions of the system. Applications should use the WM_SETTINGCHANGE message.

Типа, WM_WININICHANGE устарел, юзайте WM_SETTINGCHANGE Так они ж равны, какая майкрософту-то разница, как девелоперы будут константу эту называть?

[tyomitch]

Для совместимости с ещё не вышедшими версиями Винды

[tyomitch]

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

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

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

А теперь объясни мне, откуда в этой библе берётся значение hHook? Как легко догадаться, SetHook вызывается в одном процессе, а CallWndProcRet - уже в другом, и все глобальные переменные там будут обнулены

(Это не подвох - правильного ответа я сам не знаю, а хамелеона, чтобы распотрошить, под рукой нет.)

[GSerg]

Э... А... Щас два часа ночи, а ты такие вопросы задаёшь Завтра скажу чё-нить... только напомни

[alibek]

Ну вы, блин, даете.
Вот.


P.S. А форум то называется "для новичков"

[GSerg]

Это у кофейника спроси, почему он в этом разделе вопрос задал


В общем, я подозреваю, что мы опять заблудились в одной сосне Разумеется, инстанс2 не будет знать о значении хука1. Обычно эта проблема решается объявлением переменной в shared-секции (интересно, как с этим делом у VB... напрямую-то нельзя, но...). Меня сбило то, что пример на дельфи, хоть он и столь же неправильный, тем не менее работает. Переменная для хука у дельфийской библы попадает в секцию BSS, которая не является shared, и, в принципе, работать не должна Вероятно, имеет место совпадение, благодаря которому тот адрес по умолчанию, по которому грузится дельфийская библа, оказался свободен в обоих процессах, и переменная очутилась там же... хотя всё равно я не понимаю, как это соотносится с раздельной моделью памяти.
В общем, надо переделать на файл-мэппинги для проверки

[tyomitch]

Хахаха... А я сделал глобальный хук чистым VB
Выложил на http://bbs.vbstreets.ru/viewtopic.php?p=119291#119291