کلاس پنجره ها در باکس ورودی پسورد اکسس ( دیتابیس با پسورد )

کلاس پنجره 32770# است و آیدی های کنترل داخل آن با لوپ زدن و استفاده از تابع GetDlgCtrlID گرفته شده

SendMessageA(GetDlgItem(hhWnd, 2213), WM_GETTEXT, wparam,lparam use strptr

wParam تعداد کاراکتری است که به متغیر بافر تخصیص می دهد ( منظور داخل بافر کپی می کند ) و lParam خود متغیر بافر است مثل $Buff ، برای ارسال نوشته  داخل کنترل RichEdit جایی که پسورد را تایپ کردیم  به Caption پنجره والد از تابع SetWindowTextA بهره بردیم دقیقا مثل تصویر زیر

Function NewWindow1(ByVal hWnd As LongPtr,ByVal uMsg As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr
Dim lRes As long
NewWindow1=CallWindowProc(oldWindow, hWnd, uMsg, wParam, lParam)
Select Case uMsg
   Case &H133
   Case &138
   SetBkMode wParam,1
   wParam, RGB(255, 0, 0)
NewWindow1=GetStockObject(8)
   Case WM_NCHITTEST
 lRes=DefWindowProc(hWnd,uMsg,wParam,lParam)
   '   1  : Client
   '   2 :  Caption
   '   wm-nchittest
   Case Else
End Select
End Function

منظور نوشته زیر این است که اگر شما از DefWindowProc استفاده کنید تغییر رنگ ناحیه Static امکانپذیر نیست و این تابع رنگ پیش فرض سیستم را انتخاب می کند پس سعی بیهوده نکنید!!!

By default, the DefWindowProc function selects the default system colors for the static control.

setwindowsubclass

Declare PtrSafe Function SetWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, _

  ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr

Declare PtrSafe Function RemoveWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, _

  ByVal uIdSubclass As LongPtr) As LongPtr

Declare PtrSafe Function DefSubclassProc Lib "comctl32" (ByVal hWnd As LongPtr, ByVal uMsg As Long, _

  ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Dim hNotePad As Long
    Dim hEdit As Long
    hNotePad = FindWindow("NotePad", vbNullString)
    hEdit = FindWindowEx(hNotePad, 0, "Edit", vbNullString)
    Call SendMessage(hEdit, WM_SETTEXT, 0, ByVal "abc")
'StrPtr : Transfer Unicode
'Const WM_SETTEXT = &HC




CopyMemory  nml,ByVal lParam,,LenB(nml)

CopyMemory  lParam,,ByVal nml,LenB(nml)

SubClassing ( Tested Successfully ) 

وقتی SubClass می کنید در واقع پنجره جدیدی ساخته شده و پنجره قدیمی میشود Default.لذا زمان خروج از New به Prev یا Default منتقل میشوید. اگر حذف بدرستی انجام نشود Crash حتمی است  و در نهایت مجبور خواهید شد با Ctrl+Shift+Esc  به Task Manager رفته و اپلیکیشن را End Process  کنید !!! متاسفم چاره ای نیست برای همه پیش می آید حتی باتجربه ها

OnTimer : 

Use FindWindowA  To Get Handle For the Window Class  "#32770"

if HandleWindow<>0  And hHook=0 Then

hHook=SetWindowsHookEx(WH_CBT,AddressOf NewHook,0&,GetCurrentThreadId)

Me.TimerInterval=0

Crash در این قبیل موارد طبیعی است و می بایست قبل از انجام همچین موارد غیر اصولی  که آفیس هم توصیه نمی کند ، حتما یک بک آپ از فایل تهیه شود تا در صورت خرابی فایل فایل جایگزین داشته باشید!!!

Function NewHook(nCode,wParam,lParam)

NewHook=CallNextHookEx(hHook,nCode,wParam,lParam)

If nCode=5 Then 

      If GetClass(wParam)=""32770" Then 

              UnhookWindowsHookEx hHook

              SetWindowSubclass wParam,AddressOf SubClass,1,0

      End If 

End If

End Function

Function SubClass(hWnd,uMsg,wParam,lParam)

Dim hBr As LongPtr

Dim WinR As RECT

Dim WinP1 As POINTAPI,WinP2 As POINTAPI

SubClass=DefSubClassProc(hWnd,uMsg,wParam,lParam)

Select Case uMsg

            Case WM_CREATE

                  hBkColor=RGB(100,100,100)

                  hTxtColor=RGB(200,0,100)

                 hBr=hBkColor 'GetStockObject(8)

           Case WM_ERASEBKGND

'البته مختصات صفحه باید با تابع ScreenToClient به مختصات کلایِنت تبدیل شود اگر این پیام توسط Parent یا والد Recieve شود رنگ بک گراند پنجره عوض خواهد شد. ( به رنگ دلخواه شما از پالت رنگ آمیزی )  RGB

          Case  WM_CTLCOLORSTATIC

'در اینجا رنگ داخل ناحیه استاتیک و نوشته هاش  که Prompt است عوض می شود

                SetBackColor wParam,hBkColor

                SetTextColor wParam,hTxtColor

               SubClass=hBr

          Case WM_DESTROY,WM_NCDESTROY

'حذف ساب کلاس و هوک در زمان خروج 

               RemoveWindowSubclass

 hWnd,SubClass,1

              ' DeleteObject (hBrush Or hFont)

              hHook=False

End Select

End Function

sputniknews.

free : subclassing-and-hooking-with-visual-basic

free : subclassing-and-hooking-with-visual basic_78aa.pdf

i can not figure out what to do what not  to  do

21 بهمن 1351؛ دلار سقوط کرد

21 بهمن 1400 : ایرنا نوشت: جواد منصوری گفت: آمریکا ژنرال هایزر را فرستاده بود تا یک میلیون آدم بکشد  تا محمدرضا پهلوی بر اوضاع مسلط شود ولی این اتفاق نیافتاد، خداوند نخواست و امام (ره) انقلاب را رهبری و فرماندهی کرد و نهایتا انقلاب پیروز شد.

21 بهمن 1400 : علیرغم انتقاد رهبر انقلاب از افزایش قیمت‌ لوازم خانگی، متاسفانه هنوز شرکتهای بزرگ این حوزه از جمله اسنوا که سودهای غیرمتعارف بالای هزار میلیارد تومانی دریافت می کردند، اقدام به کاهش قیمت نکرده اند، بلکه برخی هنوز دنبال افزایش مجدد قیمت هستند.

22 بهمن 1400 : مدیر بیوتکنولوژی موسسه رازی با بیان اینکه بر اساس مطالعات انجام شده، اثربخشی واکسن کووپارس ۲.۵ تا سه برابر بیش از سینوفارم بوده است، گفت: تزریق دز استنشاقی واکسن رازی منجر به افزایش مقدار آنتی بادی در قسمت‌های بینی و مخاطی شده و هم ورود ویروس به قسمت فوقانی دستگاه تنفسی کمتر شده و در نتیجه انتقال ویروس کمتر اتفاق می‌افتد.

قلاب کردن پنجره HOOK و دسترسی به کلاس های آن از طریق Subclass کردن

در WIN32 : 

Private Type CWPSTRUCT

lParam As Long

wParam As Long

message As Long

hwnd As Long

End Type

End Type 

Private Const SWP_FRAMECHANGED=&H20

Private Const SWP_NOSIZE=&H1

Private Const SWP_NOZORDER=&H4

Private Const WH_CALLWNDPROC=4

(Private Const GWL_WNDPROC=(-4

Private Const WM_GETFONT=&H31

Private Const WM_CREATE=&H1

Private Const WM_CTLCOLORBTN=&H135

Private Const WM_CTLCOLORDLG=&H136

Private Const WM_CTLCOLORSTATIC=&H138

Private Const WM_CTLCOLOREDIT=&H133

Private Const WM_DESTROY=&H2

Private Const WM_SHOWWINDOW=&H18

Private Const WM_COMMAND=&H111

Private Const BN_CLICKED=0

Private Const IDOK=1

 

Private Const EM_SETPASSWORDCHAR =&HCC

Private INPUTBOX_HOOK As Long

Private INPUTBOX_HWND As Long

Private INPUTBOX_PASSCHAR As String

Private INPUTBOX_FONT As String

Private INPUTBOX_SHOWING As Boolean

Private INPUTBOX_OK As Boolean

Public Function InputBoxEx(ByVal Prompt As String,Optional ByVal Title As String,Optional ByVal FontName As String,Optional ByVal FontSize As Long, Optional ByVal PasswordChar As String,Optional ByVal CancelError As Boolean = False) As String

"INPUTBOX_FONT="MS Sans Serif

INPUTBOX_FONTSIZE=8

INPUTBOX_PASSCHAR=PasswordChar

If Len(FontName) Then INPUTBOX_FONT=FontName

If FontSize>0 Then INPUTBOX_FONTSIZE=FontSize

INPUTBOX_SHOWING = True

INPUTBOX_HOOK=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf 

(HookWindow,0,GetCurrentThreadID

(InputBoxEx=InputBox(Prompt,Title,Context

INPUTBOX_SHOWING=False

 Remove The Hook'

(UnhookWindowsHookEx(INPUTBOX_HOOK

If Not INPUTBOX_OK And CancelError Then Err.Raise vbObjectError + 1, , "User Pressed " & Chr(34) & "Cancel" & Chr(34)

End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim tCWP As CWPSTRUCT

This is where you need to Hook the Inputbox'

(CopyMemory tCWP, ByVal lParam, Len(tCWP

If tCWP.message=WM_CREATE Then

     If ClassName ="#32770" Then

         If INPUTBOX_SHOWING Then

INPUTBOX_HWND=SetWindowLong(tCWP.hwnd,GWL_WNDPROC,AddressOf 

(InputBoxProc

          End If

     End If

End If HookWindow=CallNextHookEx(INPUTBOX_HOOK,nCode,wParam,ByVal lParam)

End Function

Private Function InputBoxProc(ByVal hwnd As Long,ByVal Msg As Long, ByVal wParam As Long,ByVal lParam As Long) As Long

Select Case Msg

    Case WM_COMMAND

        '..Check to see if the OK Button was Pressed'

       lNotify=Val("&H" & Left$(Right$("00000000" & Hex$(wParam), 8), 4))

       lID = Val("&H" & Right$(Right$("00000000" & Hex$(wParam), 8), 4))

       If lNotify = BN_CLICKED Then

          (INPUTBOX_OK = (lID = IDOK

       End If

Case WM_SHOWWINDOW

      GetWindowRect(hwnd, tRECT

     SetWindowPos hwnd,0, tRECT.Left,tRECT.Top,0,0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED)

Case WM_CTLCOLORDLG,WM_CTLCOLORSTATIC,WM_CTLCOLORBTN,WM_CTLCOLOREDIT

.

.

.

If Msg=WM_CTLCOLORSTATIC Then
Set the Font'
lFont=CreateFont(((INPUTBOX_FONTSIZE/72)*96),0,0,0,0,0,0,0,0,0,0,0,0, 

(INPUTBOX_FONT
SelectObject wParam,lFont
End If

tLB.lbColor=INPUTBOX_BACKCOLOR

(InputBoxProc = CreateBrushIndirect(tLB

 Case WM_DESTROY

    Remove the Inputbox Subclassing'

Call SetWindowLong(hwnd,GWL_WNDPROC, INPUTBOX_HWND)

End Select

InputBoxProc=CallWindowProc(INPUTBOX_HWND,hwnd,Msg,wParam,ByVal lParam)

End Function