Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Setting VBA Project Password
Here's what I ended up with.
It was a difficult birth. http://www.standards.com/index.html?...rojectPassword |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Setting VBA Project Password
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Setting VBA Project Password
"keepITcool" wrote in message ft.com... 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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Setting VBA Project Password
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" wrote in message ft.com... 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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Setting VBA Project Password
"keepITcool" wrote in message
ft.com... 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excell VBA Project Password? | Excel Discussion (Misc queries) | |||
VBP Project Password | Excel Programming | |||
Lost VBA Project Password | Excel Programming | |||
VBA Project Password | Excel Programming | |||
Accesing vba project from wb that has vba project password protected | Excel Programming |