How to disable File Saveas menu option

[Chancile]

How to disable the File SaveAs menu option of an application opened via shell/shellex
any help on this will be highly appreciated.

Thanks

[ndvck]

Hi,
U can try the following code to disable the "SaveAs" menu option of a application which was opened by shell.

In this application i have disabled "notepad" SaveAs menu option.

Start a EXE project. Add a module to the project and Paste the following code in the module.
'**************************
Public Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Private Const GW_HWNDNEXT = 2
Private Const MIIM_STATE As Long = &H1&
Private Const MF_BYPOSITION = &H400&
Private Const MFS_GRAYED As Long = &H3&

Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, _
ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long

Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, _
ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, _
ByVal wFlag As Long) As Long

Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, _
ByVal nPos As Long) As Long

Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwprocessid As Long) As Long

Function ProcIDFromWnd(ByVal hwnd As Long) As Long
Dim idProc As Long

' Get PID for this HWnd
GetWindowThreadProcessId hwnd, idProc

' Return PID
ProcIDFromWnd = idProc
End Function

Function GetWinHandle(hInstance As Long) As Long
Dim tempHwnd As Long

' Grab the first window handle that Windows finds:
tempHwnd = FindWindow(vbNullString, vbNullString)

' Loop until you find a match or there are no more window handles:
Do Until tempHwnd = 0
' Check if no parent for this window
If GetParent(tempHwnd) = 0 Then
' Check for PID match
If hInstance = ProcIDFromWnd(tempHwnd) Then
' Return found handle
GetWinHandle = tempHwnd
' Exit search loop
Exit Do
End If
End If

' Get the next window handle
tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
Loop
End Function

Public Function BlockMenuItem(plHwnd As Long, psMenuTxt As String) As Boolean
On Error GoTo ErrorHandler
Dim lnhwndMenu As Long
Dim lnhwndSubmenu As Long
Dim lnMenuItemCount As Long
Dim lnMenuItemId As Long
Dim lncount As Integer
Dim llRetVal As Long
Dim ltMenuInfo As MENUITEMINFO
Dim lsBuffStr As String * 80 ' Define as largest possible menu text.
Dim lsMenuText As String

BlockMenuItem = False

'Get the main menu
lnhwndMenu = GetMenu(plHwnd)

If (lnhwndMenu = 0) Then
Exit Function
End If

'Get the First sub menu
lnhwndSubmenu = GetSubMenu(lnhwndMenu, 0)

If (lnhwndSubmenu = 0) Then
Exit Function
End If

'Get the menu items count
lnMenuItemCount = GetMenuItemCount(lnhwndSubmenu)

For lncount = 0 To lnMenuItemCount - 1
lsBuffStr = Space(80)

llRetVal = GetMenuString(lnhwndSubmenu, lncount, lsBuffStr, 80, MF_BYPOSITION)

If (llRetVal <> 0) Then
lsMenuText = Mid(lsBuffStr, 1, llRetVal)
If (InStr(1, lsMenuText, psMenuTxt) > 0) Then

With ltMenuInfo
.cbSize = Len(ltMenuInfo)
.dwTypeData = String(80, 0)
.cch = Len(.dwTypeData)
.fMask = MIIM_STATE
.fState = MFS_GRAYED
End With

'Disable the menu item
llRetVal = SetMenuItemInfo(lnhwndSubmenu, lncount, True, ltMenuInfo)
If (llRetVal <> 0) Then
BlockMenuItem = True
End If

Exit For
End If
Else
Exit Function
End If
Next

Exit Function
ErrorHandler:
BlockMenuItem = False
End Function
'**************************

The form add the following code.
'**************************
Sub Command1_Click()
Dim hInst As Long ' Instance handle from Shell function.
Dim hWndApp As Long ' Window handle from GetWinHandle.

' Shell to an application
hInst = Shell("Notepad.exe")

' Begin search for handle
hWndApp = GetWinHandle(hInst)

If hWndApp <> 0 Then
Call BlockMenuItem(hWndApp, "Save &As")
End If
End Sub
'**************************

Hope this will solve u'r problem. if u have any doubts u can mail me.

[Chancile]

Thanks... I shall defi implement ur suggested code and get back.