hook or subclass issue within MS word /VBA

• • Reply

  15 years ago

  by hcadieu

  herve cadieu

  , France

  Joined 15 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….

   

  Report abuse