hook or subclass issue within MS word /VBA

vb6 France
  • 12 years ago

    Dear all,

    I am trying to Subclass or hook  this DialogBox window which pops up when running the following code under Word VBA IDE 

     

    option explicit

    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function SetWindowsHookEx& Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook&, ByVal lpfn&, ByVal hMod&, ByVal dwThreadId&)
    Private Declare Function UnhookWindowsHookEx& Lib "user32" (ByVal hHook&)
    Private Declare Function GetClassName& Lib "user32" Alias "GetClassNameA" (ByVal hwnd&, ByVal lpClassName$, ByVal nMaxCount&)
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal sResult As String) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal CodeNo As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal ParenthWnd As Long, ByVal ChildhWnd As Long, ByVal ClassName As String, ByVal Caption As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As Any) As Long
    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
    Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Boolean
    Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Sub GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT)
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
    Private Declare Function GetTextExtentPointA Lib "gdi32" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSIZE As SIZE) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
    Private Declare Function ExtTextOutA Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal wOptions As Long, lpRect As Any, ByVal lpString As String, ByVal nCount As Long, ByVal lpDx As Any) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
    Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, ByRef pInputs As Key_Input_Type, ByVal cbSize As Long) As Long
    Private Declare Function enumchildwindows Lib "user32.dll" Alias "EnumChildWindows" (ByVal hWndParent As Long _
    , ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
                                                (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
                                                 ByVal wParam As Long, ByVal lParam As Long) As Long
    Private xPos&, yPos&, msgHook&, hInstance&, hIcon&, TimerId&
    Private TitleMsgBox As String, strMsg As String, BtnTitle(2) As String, PathIco As String
    Private hWndMsgBox As Long, hwndlbl As Long, hwndBtn As Long, nPct As Long
    Private wRect As RECT, sbhWnd As Long, hDCWks As Long, nhBr As Long, ohBr As Long
    Private nhPen As Long, ohPen As Long, lPos As Long, BarColor As Long, BkColOption

















































    Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
    End Type





    'USER32
    Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

    Private Type CWPSTRUCT
      lParam As Long
      wParam As Long
      message As Long
      hwnd As Long
    End Type




    Private Type ANICURSOR
      m_hCursor As Long
      m_hWnd As Long
    End Type


    Type SIZE
      cx As Long
      cy As Long
    End Type



    Type KEYBDINPUT
        wVk As Integer
        wScan As Integer
        dwFlags As Long
        time As Long
        dwExtraInfo As Long 'this is a pointer
    End Type
    Dim shiftx As Long
    Dim shifty As Long
    Type Key_Input_Type
     dwType As Long
     Key As KEYBDINPUT
     Padding(0 To 7) As Byte
    End Type
    Private hHook As Long
    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
    Dim MUser As String
    Public Const VK_TAB = &H9
    Public Const VK_UpArrow = 54 '94
    Public Const VK_RETURN = &HD

























    Public Sub NewSignature(sig As signature, User As String) 'sig As signature
     
      Const WH_CALLWNDPROC& = 4
      MUser = User
     
      xPos = 285: yPos = 97  ' Coordonnées de l'origine en pixels
      'set a  hook here
      msgHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookMsgPos, 0, GetCurrentThreadId)
     
      On Error Resume Next
      Set sig = activedocument.Signatures.Add
      UnhookWindowsHookEx msgHook
    End Sub











    Private Function HookMsgPos&(ByVal ncode&, ByVal wParam&, msgStruct As CWPSTRUCT)
      Const MODAL_WINDOW_CLASSNAME As String = "#32770"
      Const SWP_NOSIZE = &H1
      Const SWP_NOZORDER = &H4
      Const WM_CREATE& = &H1
      Dim PosFlag&




      With msgStruct
        If .message = WM_CREATE Then
         
          Dim s As String, i As Integer
          s = String(255, 0)
          GetClassName .hwnd, s, 256
          i = InStr(s, vbNullChar)
          If i Then s = Left(s, i - 1)
          If s = MODAL_WINDOW_CLASSNAME Then
         
            PosFlag = SWP_NOZORDER Or SWP_NOSIZE
            'definir la position de la fenetre
            SetWindowPos .hwnd, 0&, xPos, yPos, 0&, 0&, PosFlag
            'definir un titre personnalisé pour la fenetre
            SetWindowText .hwnd, MUser + " please select your certificate"
          End If
        End If
      End With
     'This line will ensure that any other hooks that may be in place are
      'called correctly.
      'CallNextHookEx msgHook, lngCode, wParam, lParam
    End Function




















     

     

    on the document add a button and in the vba ide put the follow code in the button-click event

    (word /toolbar/ controltoolbox /design mode )

    Private Sub Command1_Click()
    activedocument.SaveAs "test"
    Dim sig As signature
    Call NewSignature(sig, "David Ireland")


    'here I would like to pass the timestamp to be applied

    'and filter the certificates to be displayed
    activedocument.Signatures.Commit
    End Sub



     

    The aim is to be able to tweak this dialog box and to achieve the following goals:

     

    1°) To be able to Collect and check certificates from any stores instead of only “My store” as the actual  current behaviour. (To address the case where  I have a smartcard or a central LDAP repository )

     

    2°) To pass a date variable with the time stamp to be applied (to have the  same time stamp  date as the handwritten signature I applied  previously to the document, I can pass either a date variable or a system time structure if needed )

     

    3°) To select programmatically the accurate certificate(s) corresponding to the signatory identity (passed as parameter)  with filters on Certificate Subject Name, Certificate Issuer, and expiry date , in order  to disable possible selection of  any else certificate available in the store or LDAP or smartcard.

     

    4°) To be able to move the Dialog box wherever needed  on screen  (Done)

     

    5°) To be able to Change the Static Textbox1 content message of the DialogBox

     

    6°) To be able to change the Title message of the Dialog Box (Done)

     

    I found very limited resources over the web to address this , except the SelectCert Structure  used to build any Of these particular DialogBoxes on MSDN, and some C Code …

     

    Have you any idea on how to achieve that ?

    See http://msdn.microsoft.com/library/default.asp?url=/library/en-us/seccrypto/security/certselectcertificate.asp

     

    My problem is still with C++ to VB translation as the existing resources are all in C++.

     

     There is a question of how to load the  library then how to getProcAdress  and then how to change the select_Cert_Struct  used to construct the dialog box displayed to show the certificates….

     

Post a reply

No one has replied yet! Why not be the first?

Sign in or Join us (it's free).

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“The difference between theory and practice is smaller in theory than in practice.”