Setting VBA Project Password

[Howard Kaikow]

Here's what I ended up with.
It was a difficult birth.

http://www.standards.com/index.html?...rojectPassword

[keepITcool]

Howard..

Nice code!

I've adapted it to work from VBA

I ironed out a flaw that the new password is appended to an existing
password.
I changed the GetDlgItem/SendMessage to 1 liners SendDlgItemMessage

When called from VBA I needed both a messagehook and timer for the
final Buttonclick.

Let me know if and when you read this.
glad to get your comments... you can use this on your site if you want.



'Concept Howard Kaikow
'Adapted by keepITcool to run from VBA (excelXP+)

Option Explicit

'Windowhook
Private Const WH_CBT As Long = 5
'HookComputerBasedTraining
Private Const HCBT_ACTIVATE As Long = 5
'GetWindowLong
Private Const GWL_HINSTANCE As Long = -6
'ButtonMessages
Private Const BM_SETCHECK As Long = &HF1&
Private Const BM_CLICK As Long = &HF5&
'WindowMessages
Private Const WM_SETTEXT As Long = &HC
'ButtonState
Private Const BST_CHECKED As Long = &H1
'TabControlMessages
Private Const TCM_FIRST As Long = &H1300
Private Const TCM_GETCURSEL As Long = (TCM_FIRST + 11)
Private Const TCM_SETCURFOCUS As Long = (TCM_FIRST + 48)
'EditBoxMessages
Private Const EM_REPLACESEL As Long = &HC2

'Declarations
'KERNEL32
Private Declare Function GetCurrentThreadId Lib "kernel32" ( _
) As Long

'USER32
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" (ByVal idHook As Long, _
ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetDlgItem Lib "user32.dll" ( _
ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function SendDlgItemMessage Lib _
"user32.dll" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByRef lParam As Any) 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 GetDesktopWindow Lib "user32.dll" ( _
) As Long
Private Declare Function LockWindowUpdate Lib "user32.dll" ( _
ByVal hwndLock As Long) As Long

'CONSTANTS
Const IDtimedOK = &H998877 'UniqueID for the timer
'controlID's for the various dialog controls
Const IDBTN = &H1&, IDTAB = &H3020&, IDPW1 = &H1555&, _
IDPW2 = &H1556&, IDCHK = &H1557&

'VARIABLES
Private hWndHook As Long 'Handle of "Hooked" WindowProcedure
Private hWndDlg As Long 'Handle of the Dialog's Window
Private sPassword As String


Sub aTest()
sPassword = InputBox("VBA Password")
Debug.Print ThisWorkbook.Name, _
ThisWorkbook.VBProject.Name, sPassword

ThisWorkbook.Activate
'Set the hook to catch the dialog
hWndHook = SetWindowsHookEx(WH_CBT, _
AddressOf ProcVBADialog, GetWindowLong(Application.hwnd, _
GWL_HINSTANCE), GetCurrentThreadId())
'Show the dialog
Application.VBE.CommandBars.FindControl(ID:=2578).Execute
'Doevents to give your hook time to do its stuff
DoEvents
End Sub

Public Function ProcVBADialog(ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Static bFlag As Boolean

If Not bFlag And lMsg = HCBT_ACTIVATE And wParam <> _
Application.hwnd And wParam <> _
Application.VBE.mainwindow.hwnd Then
bFlag = True
hWndDlg = wParam
Call SetVBAPW
UnhookWindowsHookEx hWndHook
bFlag = False
End If
ProcVBADialog = False
End Function

Public Sub SetVBAPW(Optional Dummy&)

Dim hTabFrame&, lRet&
On Error GoTo errH
If hWndDlg = 0 Then Err.Raise 1

'Get the tabcontrol index
lRet = SendDlgItemMessage(hWndDlg, IDTAB, TCM_GETCURSEL, 0&, 0&)
If lRet = -1 Then
Err.Raise 2
ElseIf lRet = 0 Then
'Change to 1
SendDlgItemMessage hWndDlg, IDTAB, TCM_SETCURFOCUS, 1&, 0&
End If
'Get the first child (dialog of 2nd tab)
hTabFrame = FindWindowEx(hWndDlg, 0&, vbNullString, vbNullString)

If hTabFrame = 0 Then Err.Raise 2
'Check we have the correct frame
lRet = GetDlgItem(hTabFrame, IDCHK)
If lRet = 0 Then Err.Raise 3

SendDlgItemMessage hTabFrame, IDCHK, BM_SETCHECK, BST_CHECKED, 0&
'Clear the text
SendDlgItemMessage hTabFrame, IDPW1, WM_SETTEXT, 0&, ByVal
vbNullString
SendDlgItemMessage hTabFrame, IDPW2, WM_SETTEXT, 0&, ByVal
vbNullString
'Replace used otherwise it wont 'catch'
SendDlgItemMessage hTabFrame, IDPW1, EM_REPLACESEL, -1&, ByVal
sPassword & vbNullChar
SendDlgItemMessage hTabFrame, IDPW2, EM_REPLACESEL, -1&, ByVal
sPassword & vbNullChar

'The dialog must be fully activated, then we can click the OK..
'the delay is achieved by using the timer
LockWindowUpdate GetDesktopWindow
SetTimer hWndDlg, IDtimedOK, 100, AddressOf SetVBAOK

endH:
Exit Sub
errH:
UnhookWindowsHookEx hWndHook
Debug.Print "ERRORS", Err.Number; Hex(hWndDlg), Hex(hTabFrame)


End Sub

Public Sub SetVBAOK(Optional Dummy&)
KillTimer hWndDlg, IDtimedOK
'the 2nd tab must have focus when the OK is clicked
SendDlgItemMessage hWndDlg, IDTAB, TCM_SETCURFOCUS, 1&, 0&
SendDlgItemMessage hWndDlg, IDBTN, BM_CLICK, 0&, 0&
LockWindowUpdate 0&
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Howard Kaikow wrote :

> Here's what I ended up with.
> It was a difficult birth.
>
> http://www.standards.com/index.html?...rojectPassword

[Howard Kaikow]

"keepITcool" <[email protected]> wrote in message
news:[email protected]...
> Howard..
>
> Nice code!
>
> I've adapted it to work from VBA
>
> I ironed out a flaw that the new password is appended to an existing
> password.

That was not a flaw. It was intentional.
I'm creatomg NEW projects, not modifying old projects.

[keepITcool]

agreed..
in your scenario of creating a new workbook it's not a problem.
in other scenarios it could be.. hence flaw not bug <G>

as you have discovered using wm_settext doesn't work properly.
and a replacesel is needed for the PW to be saved correctly.
(i use settext to clear the edit box)

how do you like the syntax ? SendDlgItemMessage iso
GetDlgItem / SendMessage imo makes the code more straightforward.

you indicated that porting it from VB6 to VBA would be a cinch
hmm... i know i needed the hook but found i needed
the timer for the final click.

btw:
thanks for pointing me to that nifty little property called ID
never realized its potential for hacking into dialogs

re Spy++
have you ever tried WinSpector Spy? I think it's got a "few" advantages
over Spy++ http://www.windows-spy.com/
(check out the windows class watch ..)



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Howard Kaikow wrote :

>
> "keepITcool" <[email protected]> wrote in message
> news:[email protected]...
> > Howard..
> >
> > Nice code!
> >
> > I've adapted it to work from VBA
> >
> > I ironed out a flaw that the new password is appended to an existing
> > password.
>
> That was not a flaw. It was intentional.
> I'm creatomg NEW projects, not modifying old projects.

[Howard Kaikow]

"keepITcool" <[email protected]> wrote in message
news:[email protected]...
>
> agreed..
> in your scenario of creating a new workbook it's not a problem.
> in other scenarios it could be.. hence flaw not bug <G>

It is only a flaw if it was dome unintentionally.

In other forums I describe the purposes of my task.

I have developed a VB 6 EXE to totally create a Word template from scratch,
including setting a password, reference, etc. There is no option for the
user to set the password, the password is set by the code and the use is not
informed of the password.

There are other issue to increase the security, e.g., running the code
without displaying the dialog. I won't discuss those as they affect
security.

Note that it is only necessary to display the dialog momentarily to get the
handle, after that the dialog need not be visible.

Of course, the setting of a VBA password in code is almost a pointless
exercise, as it is all too easy to bypass the password.

The challenge was to do the deed without using SendKeys, as those techniques
can be applied at other times in useful scenarios. The biggest obstacle was
MSFT's poor documentation.

It's been a while since I moved the code to VBA, as I have no intention of
using such code other than in VB 6.
I did not need a hook or a timer.

My recollection is that if you take the code exactly as I wrote it, the code
should work in each Office app with no change other than specifying the path
to which to write the file.

Also, I am creating a new project, not applying a password to an extant
project.

I've spent so much time on this issue recently, I do not really want to
discuss the topic further.

> re Spy++
> have you ever tried WinSpector Spy? I think it's got a "few" advantages
> over Spy++ http://www.windows-spy.com/
> (check out the windows class watch ..)

Never tried it.