Solved

Contmenu.dpr in Win'98 - problem!

Posted on 1998-09-23
5
156 Views
Last Modified: 2010-04-06
Hi experts!
I'm try to make project: '...\Demos\SHELLEXT\contmenu.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?
0
Comment
Question by:DValery
  • 3
  • 2
5 Comments
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
Valery (I guess that's your name?),

I don't have Delphi 3 anymore. Can you please write the two functions "TContextMenu.SEIInitialize" (or something near to that) and "TContextMenu.QueryContextMenu" into a comment. Then I can (perhaps) help you.
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.
0
 
LVL 1

Author Comment

by:DValery
Comment Utility
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?
----------------------------------Unit------------------------------------------------------------------------------
unit ContextM;

interface
uses
    Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils;

Const
   {8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f}
   CLSID_ContextMenuShellExtension: 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.QueryContextMenu(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.lpVerb)) <> 0 then Exit;

  // Execute the command specified by lpici.lpVerb.
  if LoWord(Integer(lpici.lpVerb)) = 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.GetCommandString(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(pidlFolder: 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.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  begin
    DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
    Result := NOERROR;
  end
  else
    Result := E_FAIL;
  ReleaseStgMedium(medium);
end;

initialization
    TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
         'Class_ContextMenu', 'Copy full path to the Clipboard', ciMultiInstance);

end.
----------------------------------INF-file-----------------------------------------------------------------------------------------------------------

[Version]
Signature=$Chicago$

[DefaultInstall]
AddReg=Path2Clipboard.Add.Reg,Path2Clipboard.Uninst.Reg
Copyfiles=DestGrp

[DefaultUninstall]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add.Reg,Path2Clipboard.Uninst.Reg

[DefaultUninstall.NT]
DelFiles=DestGrp
DelReg=Path2Clipboard.Add.Reg,Path2Clipboard.Uninst.Reg.NT

[Path2Clipboard.Add.Reg]
HKCR,CLSID\{8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f},,,PathToClipboard
HKCR,CLSID\{8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f}\InProcServer32,,,"%11%\Path2Clp.dll"
HKCR,*\shellex\ContextMenuHandlers\PathToClipboard,,,{8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f}
HKCR,directory\shellex\ContextMenuHandlers\PathToClipboard,,,{8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f}
HKCR,CLSID\{8e3e0f0a-0fcc-11ce-bcb0-b3fd0e25381f}\InProcServer32,ThreadingModel,,Apartment

[Path2Clipboard.Uninst.Reg]
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,,,
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,DisplayName,,"Copy path to Clipboard (for Explorer)"
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,UninstallString,,"rundll setupx.dll,InstallHinfSection DefaultUninstall 4 %11%\Path2Clp.INF"

[Path2Clipboard.Uninst.Reg.NT]
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,,,
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,DisplayName,,"Copy path to Clipboard (for Explorer)"
HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\PathToClipboard,UninstallString,,"RunDll32 syssetup.dll,SetupInfObjectInstallAction 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


0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
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-b3fd0e25381f}
   CLSID_ContextMenuShellExtension: 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.QueryContextMenu(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.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  Result := E_INVALIDARG;
end;

function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
begin
  Result := NOERROR;
end;

initialization
    TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
         '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.
0
 
LVL 1

Author Comment

by:DValery
Comment Utility
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.

0
 
LVL 20

Accepted Solution

by:
Madshi earned 20 total points
Comment Utility
Thank you...   :-)
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Suggested Solutions

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now