DValery
asked on
Contmenu.dpr in Win'98 - problem!
Hi experts!
I'm try to make project: '...\Demos\SHELLEXT\contme nu.dpr' from Delphi3 CD.
It's working in right panel of the Explorer Win'98, but when I try use item for left panel - tree directory, the Explorer is Crash!
In Win'95 it application is working... What the problem? Do you now?
I'm try to make project: '...\Demos\SHELLEXT\contme
It's working in right panel of the Explorer Win'98, but when I try use item for left panel - tree directory, the Explorer is Crash!
In Win'95 it application is working... What the problem? Do you now?
ASKER
Hi Madshi,
I'm write below my project the Unit and Inf-file for create Item in context menu of the Explorer
for copy the path of the selected file to Clipboard. It's fine working for Win'95 and
crash in Win'98 when I select item for left panel Explorer (Tree) with Dump:
(...translated for English...)
Program EXPLORER has caused malfunction when addressing to page
of memory in module SHDOCVW.DLL by address 0177:79e63782.
Registers:
EAX=00000000 CS=0177 EIP=79e63782 EFLGS=00010246
EBX=00000000 SS=017f ESP=006bf5f0 EBP=006bf600
ECX=c146e5b0 DS=017f ESI=00445314 FS=11f7
EDX=00000000 ES=017f EDI=bff5582a GS=0000
Byte by address CS:EIP:
8b 08 ff 51 08 ff 75 f0 ff 15 34 1a db 79 8b 45
Stack:
00000000 00000000 006bfca8 00445314 e8efeeca e0e2eef0 ef20fcf2 fbedebee f3ef20e9 ea20fcf2 e1fbe220 edede0f0 20f3ecee 00e9e0f4 f6900000 0000006b
I did try to make breakpoints and, as I think, crash occurs when calls the function InvokeCommand.
The function Initialize is working.
What you may to advise?
-------------------------- --------Un it-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
unit ContextM;
interface
uses
Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils;
Const
{8e3e0f0a-0fcc-11ce-bcb0-b 3fd0e25381 f}
CLSID_ContextMenuShellExte nsion: TGUID = (
D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1f));
type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
szFile: array[0..MAX_PATH] of Char;
public
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
end;
implementation
function TContextMenu.QueryContextM enu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
// Add one menu item to context menu
InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,'Copy Path');
// Return number of menu items added
Result := 1;
end;
function TContextMenu.InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult;
var
H: THandle;
P: PChar;
i: integer;
ClassName: array[0..64] of char;
begin
// If the high-order word of lpcmi.lpVerb is not NULL, this
// function was called by an application and lpVerb is a command
// that should be activated. Otherwise, the shell has called this
// function, and the low-order word of lpcmi.lpVerb is the
// identifier of the menu item that the user selected.
Result := E_FAIL;
// Make sure we are not being called by an application
if HiWord(Integer(lpici.lpVer b)) <> 0 then Exit;
// Execute the command specified by lpici.lpVerb.
if LoWord(Integer(lpici.lpVer b)) = 0 then
begin
// Copy Path to Clipboard
If Not OpenClipboard(lpici.hwnd) then Exit; // lpici.hwnd - Handler of the Explorer or Tray ...
EmptyClipboard();
H := GlobalAlloc(GMEM_DDESHARE, SizeOf(szFile)+1);
P := GlobalLock(H);
try
if P <> Nil Then
begin
for i:=0 to SizeOf(szFile) do
if szFile[i] <> null then P[i] := szFile[i]
else break;
SetClipboardData(CF_TEXT, H);
CloseClipboard();
end;
finally
GlobalUnlock(H);
end;
end;
Result := NOERROR;
end;
function TContextMenu.GetCommandStr ing(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if idCmd = 0 then
begin
// return help string for menu item
StrLCopy(pszName, 'To Copy full path of chosen file or directory in the Clipboard',cchMax);
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;
function TContextMenu.Initialize(pi dlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
medium: TStgMedium;
fe: TFormatEtc;
begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := Nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Fail the call if lpdobj is Nil.
if lpdobj = Nil then
begin
Result := E_FAIL;
Exit;
end;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(fe, medium);
if Failed(Result) then Exit;
// If only one file is selected, retrieve the file name and store it in
// szFile. Otherwise fail the call.
if DragQueryFile(medium.hGlob al, $FFFFFFFF, Nil, 0) = 1 then
begin
DragQueryFile(medium.hGlob al, 0, szFile, SizeOf(szFile));
Result := NOERROR;
end
else
Result := E_FAIL;
ReleaseStgMedium(medium);
end;
initialization
TComObjectFactory.Create(C omServer, TContextMenu, CLSID_ContextMenuShellExte nsion,
'Class_ContextMenu', 'Copy full path to the Clipboard', ciMultiInstance);
end.
-------------------------- --------IN F-file---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---
[Version]
Signature=$Chicago$
[DefaultInstall]
AddReg=Path2Clipboard.Add. Reg,Path2C lipboard.U ninst.Reg
Copyfiles=DestGrp
[DefaultUninstall]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add. Reg,Path2C lipboard.U ninst.Reg
[DefaultUninstall.NT]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add. Reg,Path2C lipboard.U ninst.Reg. NT
[Path2Clipboard.Add.Reg]
HKCR,CLSID\{8e3e0f0a-0fcc- 11ce-bcb0- b3fd0e2538 1f},,,Path ToClipboar d
HKCR,CLSID\{8e3e0f0a-0fcc- 11ce-bcb0- b3fd0e2538 1f}\InProc Server32,, ,"%11%\Pat h2Clp.dll"
HKCR,*\shellex\ContextMenu Handlers\P athToClipb oard,,,{8e 3e0f0a-0fc c-11ce-bcb 0-b3fd0e25 381f}
HKCR,directory\shellex\Con textMenuHa ndlers\Pat hToClipboa rd,,,{8e3e 0f0a-0fcc- 11ce-bcb0- b3fd0e2538 1f}
HKCR,CLSID\{8e3e0f0a-0fcc- 11ce-bcb0- b3fd0e2538 1f}\InProc Server32,T hreadingMo del,,Apart ment
[Path2Clipboard.Uninst.Reg ]
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,,,
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,Dis playName,, "Copy path to Clipboard (for Explorer)"
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,Uni nstallStri ng,,"rundl l setupx.dll,InstallHinfSect ion DefaultUninstall 4 %11%\Path2Clp.INF"
[Path2Clipboard.Uninst.Reg .NT]
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,,,
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,Dis playName,, "Copy path to Clipboard (for Explorer)"
HKLM,SOFTWARE\Microsoft\Wi ndows\Curr entVersion \Uninstall \PathToCli pboard,Uni nstallStri ng,,"RunDl l32 syssetup.dll,SetupInfObjec tInstallAc tion DefaultUnInstall.NT 4 %11%\Path2Clp.INF"
[Strings]
Product="Copy path of the file or directory from Windows Explorer to the Clipboard. FreeWare!"
Info="Copy path of the file or directory from Windows Explorer to the Clipboard. FreeWare!"
DiskName="Copy path to Clipboard, Setup Disk"
[SourceDisksNames]
1=%DiskName%,Sample,0
[SourceDisksFiles]
Path2Clp.DLL=1
[DestGrp]
Path2Clp.DLL
Path2Clp.INF
[DestinationDirs]
DestGrp=11
I'm write below my project the Unit and Inf-file for create Item in context menu of the Explorer
for copy the path of the selected file to Clipboard. It's fine working for Win'95 and
crash in Win'98 when I select item for left panel Explorer (Tree) with Dump:
(...translated for English...)
Program EXPLORER has caused malfunction when addressing to page
of memory in module SHDOCVW.DLL by address 0177:79e63782.
Registers:
EAX=00000000 CS=0177 EIP=79e63782 EFLGS=00010246
EBX=00000000 SS=017f ESP=006bf5f0 EBP=006bf600
ECX=c146e5b0 DS=017f ESI=00445314 FS=11f7
EDX=00000000 ES=017f EDI=bff5582a GS=0000
Byte by address CS:EIP:
8b 08 ff 51 08 ff 75 f0 ff 15 34 1a db 79 8b 45
Stack:
00000000 00000000 006bfca8 00445314 e8efeeca e0e2eef0 ef20fcf2 fbedebee f3ef20e9 ea20fcf2 e1fbe220 edede0f0 20f3ecee 00e9e0f4 f6900000 0000006b
I did try to make breakpoints and, as I think, crash occurs when calls the function InvokeCommand.
The function Initialize is working.
What you may to advise?
--------------------------
unit ContextM;
interface
uses
Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils;
Const
{8e3e0f0a-0fcc-11ce-bcb0-b
CLSID_ContextMenuShellExte
D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1f));
type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
szFile: array[0..MAX_PATH] of Char;
public
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
end;
implementation
function TContextMenu.QueryContextM
idCmdLast, uFlags: UINT): HResult;
begin
// Add one menu item to context menu
InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,'Copy Path');
// Return number of menu items added
Result := 1;
end;
function TContextMenu.InvokeCommand
var
H: THandle;
P: PChar;
i: integer;
ClassName: array[0..64] of char;
begin
// If the high-order word of lpcmi.lpVerb is not NULL, this
// function was called by an application and lpVerb is a command
// that should be activated. Otherwise, the shell has called this
// function, and the low-order word of lpcmi.lpVerb is the
// identifier of the menu item that the user selected.
Result := E_FAIL;
// Make sure we are not being called by an application
if HiWord(Integer(lpici.lpVer
// Execute the command specified by lpici.lpVerb.
if LoWord(Integer(lpici.lpVer
begin
// Copy Path to Clipboard
If Not OpenClipboard(lpici.hwnd) then Exit; // lpici.hwnd - Handler of the Explorer or Tray ...
EmptyClipboard();
H := GlobalAlloc(GMEM_DDESHARE,
P := GlobalLock(H);
try
if P <> Nil Then
begin
for i:=0 to SizeOf(szFile) do
if szFile[i] <> null then P[i] := szFile[i]
else break;
SetClipboardData(CF_TEXT, H);
CloseClipboard();
end;
finally
GlobalUnlock(H);
end;
end;
Result := NOERROR;
end;
function TContextMenu.GetCommandStr
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
if idCmd = 0 then
begin
// return help string for menu item
StrLCopy(pszName, 'To Copy full path of chosen file or directory in the Clipboard',cchMax);
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;
function TContextMenu.Initialize(pi
hKeyProgID: HKEY): HResult;
var
medium: TStgMedium;
fe: TFormatEtc;
begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := Nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Fail the call if lpdobj is Nil.
if lpdobj = Nil then
begin
Result := E_FAIL;
Exit;
end;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(fe, medium);
if Failed(Result) then Exit;
// If only one file is selected, retrieve the file name and store it in
// szFile. Otherwise fail the call.
if DragQueryFile(medium.hGlob
begin
DragQueryFile(medium.hGlob
Result := NOERROR;
end
else
Result := E_FAIL;
ReleaseStgMedium(medium);
end;
initialization
TComObjectFactory.Create(C
'Class_ContextMenu', 'Copy full path to the Clipboard', ciMultiInstance);
end.
--------------------------
[Version]
Signature=$Chicago$
[DefaultInstall]
AddReg=Path2Clipboard.Add.
Copyfiles=DestGrp
[DefaultUninstall]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add.
[DefaultUninstall.NT]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add.
[Path2Clipboard.Add.Reg]
HKCR,CLSID\{8e3e0f0a-0fcc-
HKCR,CLSID\{8e3e0f0a-0fcc-
HKCR,*\shellex\ContextMenu
HKCR,directory\shellex\Con
HKCR,CLSID\{8e3e0f0a-0fcc-
[Path2Clipboard.Uninst.Reg
HKLM,SOFTWARE\Microsoft\Wi
HKLM,SOFTWARE\Microsoft\Wi
HKLM,SOFTWARE\Microsoft\Wi
[Path2Clipboard.Uninst.Reg
HKLM,SOFTWARE\Microsoft\Wi
HKLM,SOFTWARE\Microsoft\Wi
HKLM,SOFTWARE\Microsoft\Wi
[Strings]
Product="Copy path of the file or directory from Windows Explorer to the Clipboard. FreeWare!"
Info="Copy path of the file or directory from Windows Explorer to the Clipboard. FreeWare!"
DiskName="Copy path to Clipboard, Setup Disk"
[SourceDisksNames]
1=%DiskName%,Sample,0
[SourceDisksFiles]
Path2Clp.DLL=1
[DestGrp]
Path2Clp.DLL
Path2Clp.INF
[DestinationDirs]
DestGrp=11
I compiled something close to your unit with Delphi 4 and had no problems with Win98!
Please try the following:
unit ContextM;
interface
uses
Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils;
Const
{8e3e0f0a-0fcc-11ce-bcb0-b 3fd0e25381 f}
CLSID_ContextMenuShellExte nsion: TGUID = (
D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1f));
type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
public
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
end;
implementation
function TContextMenu.QueryContextM enu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
result:=0;
if (uFlags and CMF_VERBSONLY=0) and (uFlags and CMF_EXPLORE=0) and (uFlags and $F<>0) then
exit;
InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,'Copy Path');
Result := 1;
end;
function TContextMenu.InvokeCommand (var lpici: TCMInvokeCommandInfo): HResult;
begin
Result := E_FAIL;
end;
function TContextMenu.GetCommandStr ing(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
Result := E_INVALIDARG;
end;
function TContextMenu.Initialize(pi dlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
begin
Result := NOERROR;
end;
initialization
TComObjectFactory.Create(C omServer, TContextMenu, CLSID_ContextMenuShellExte nsion,
'Class_ContextMenu', 'Copy full path to the Clipboard', ciMultiInstance);
end.
If this code works with Win98 then include step by step what I deleted - until Win98 crashes again. Then you'll have the problem.
If this code does NOT work with Win98 then I don't know what you can do. Perhaps Delphi 4 help you. My Delphi 4 context menu extension runs without any problems...
Regards, Madshi.
Please try the following:
unit ContextM;
interface
uses
Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils;
Const
{8e3e0f0a-0fcc-11ce-bcb0-b
CLSID_ContextMenuShellExte
D1:$8e3e0f0a; D2:$0fcc; D3:$11ce; D4:($bc, $b0, $b3, $fd, $0e, $25, $38, $1f));
type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
public
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
end;
implementation
function TContextMenu.QueryContextM
idCmdLast, uFlags: UINT): HResult;
begin
result:=0;
if (uFlags and CMF_VERBSONLY=0) and (uFlags and CMF_EXPLORE=0) and (uFlags and $F<>0) then
exit;
InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,'Copy Path');
Result := 1;
end;
function TContextMenu.InvokeCommand
begin
Result := E_FAIL;
end;
function TContextMenu.GetCommandStr
pszName: LPSTR; cchMax: UINT): HRESULT;
begin
Result := E_INVALIDARG;
end;
function TContextMenu.Initialize(pi
hKeyProgID: HKEY): HResult;
begin
Result := NOERROR;
end;
initialization
TComObjectFactory.Create(C
'Class_ContextMenu', 'Copy full path to the Clipboard', ciMultiInstance);
end.
If this code works with Win98 then include step by step what I deleted - until Win98 crashes again. Then you'll have the problem.
If this code does NOT work with Win98 then I don't know what you can do. Perhaps Delphi 4 help you. My Delphi 4 context menu extension runs without any problems...
Regards, Madshi.
ASKER
Dear, Madshi
I'm fixed my error in this program.
The error was in function GetCommandString.
I made mistake in StrLCopy parameters. Below the correct record of this operator:
StrLCopy(pszName, 'To Copy full path of chosen file or directory in the Clipboard',cchMax-1);
Thank you for your participation in decision the my problem.
I wants to give you 20 point for help.
I'm fixed my error in this program.
The error was in function GetCommandString.
I made mistake in StrLCopy parameters. Below the correct record of this operator:
StrLCopy(pszName, 'To Copy full path of chosen file or directory in the Clipboard',cchMax-1);
Thank you for your participation in decision the my problem.
I wants to give you 20 point for help.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I don't have Delphi 3 anymore. Can you please write the two functions "TContextMenu.SEIInitializ
Please try to insert some "windows.MessageBox"es to find the exact location where the explorer crashes. Does the menu appear or crashes the explorer before that?
Regards, Madshi.