第二个:contextmenuhandle.pas unit contextmenuhandle; interface uses Windows,ActiveX,ComObj,ShlObj,Classes; type TContextMenu = class(TComObject,IShellExtInit,IContextMenu) private FFileName: array[0..MAX_PATH] of Char; protected function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall; 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 IsValidFileType(FileName: String):Boolean; end; const Class_ContextMenu: TGUID = '{19770906-C300-11D1-8233-0020AF3E97A0} '; {全局唯一标识符(GUID)是一个16字节(128为)的值,它唯一地标识一个接口(interface)} var FileName: String; FileNumber: Integer; implementation uses ComServ, SysUtils, ShellApi, Registry, opwindow; function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; var StgMedium: TStgMedium; FormatEtc: TFormatEtc; begin //如果lpdobj等于Nil,则本调用失败 if (lpdobj = nil) then begin Result := E_INVALIDARG; Exit; end; //首先初始化并清空FileList以添加文件 (duduwolf修改,取消FileList) //FileList:=TStringList.Create; //FileList.Clear; FileName:= ' '; //初始化剪贴版格式文件 with FormatEtc do begin cfFormat := CF_HDROP; ptd := nil; dwAspect := DVASPECT_CONTENT; lindex := -1; tymed := TYMED_HGLOBAL; end; Result := lpdobj.GetData(FormatEtc, StgMedium); if Failed(Result) then Exit; //首先查询用户选中的文件的个数 FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0); //循环读取,将所有用户选中的文件保存到FileList中 (duduwolf修改) //如果文件个数大于1就返回 {for i:=0 to FileNumber-1 do begin DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName)); FileList.Add(FFileName); Result := NOERROR; end;} if FileNumber = 1 then begin DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName)); FileName:= FFileName; Result:= NOERROR; end; ReleaseStgMedium(StgMedium); end; function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; var bmp1: HBITMAP; begin Result := 0; if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) then begin if (FileNumber = 1) and (IsValidFileType(FileName) = true) then begin InsertMenu(Menu,indexMenu+1, MF_SEPARATOR or MF_BYPOSITION,idCmdLast,nil); InsertMenu(Menu, indexMenu+2, MF_STRING or MF_BYPOSITION, idCmdFirst,PChar( 'Telecom - 发送报表 ')); InsertMenu(Menu,indexMenu+3, MF_SEPARATOR or MF_BYPOSITION,idCmdLast,nil); // 往Context Menu中加入一个菜单项 ,菜单项的标题为察看位图文件 bmp1:= LoadBitmap(hInstance, 'B1 '); SetMenuItemBitmaps(Menu,indexMenu+2,MF_BYPOSITION,bmp1,0); // 返回增加菜单项的个数 Result := 3; end; end; end; function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; var frmOP:TFrmContextMenu; begin // 首先确定该过程是被系统而不是被一个程序所调用 if (HiWord(Integer(lpici.lpVerb)) <> 0) then begin Result := E_FAIL; Exit; end; // 确定传递的参数的有效性 if (LoWord(lpici.lpVerb) <> 0) then begin Result := E_INVALIDARG; Exit; end; //建立文件操作窗口 frmOP:=TFrmContextMenu.Create(nil); //将所有的文件列表添加到文件操作窗口的列表中 frmOP.Edit1.Text := FileName; frmOP.Show; Result := NOERROR; end; function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT; begin if (idCmd = 0) then begin if (uType = GCS_HELPTEXT) then {返回该菜单项的帮助信息,此帮助信息将在用户把鼠标 移动到该菜单项时出现在状态条上。} StrCopy(pszName, PChar( 'Telecom商品管理软件报表发送 ')); Result := NOERROR; end else Result := E_INVALIDARG; end; type TContextMenuFactory =class(TComObjectFactory) public procedure UpdateRegistry(Register: Boolean); override; end; procedure TContextMenuFactory.UpdateRegistry(Register: Boolean); var ClassID: string; begin if Register then begin inherited UpdateRegistry(Register); ClassID := GUIDToString(Class_ContextMenu); //当注册扩展库文件时,添加库到注册表中 CreateRegKey( '*\shellex ', ' ', ' '); CreateRegKey( '*\shellex\ContextMenuHandlers ', ' ', ' '); CreateRegKey( '*\shellex\ContextMenuHandlers\FileOpreation ', ' ', ClassID); //如果操作系统为Windows NT的话 if (Win32Platform = VER_PLATFORM_WIN32_NT) then with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; OpenKey( 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions ', True); OpenKey( 'Approved ', True); WriteString(ClassID, 'Telecom Send Reports ContextMenu '); finally Free; end; end else begin DeleteRegKey( '*\shellex\ContextMenuHandlers\FileOpreation '); inherited UpdateRegistry(Register); end; end; function TContextMenu.IsValidFileType(FileName: String): Boolean; begin Result:= false; if FileExists(FileName) then begin if UpperCase(ExtractFileExt(FileName)) = '.XLS ' then Result:= true else if UpperCase(ExtractFileExt(Filename)) = '.DOC ' then Result:= true else Result:= false; end; end; initialization TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu, ' ', 'Telecom Send Reports ContextMenu ', ciMultiInstance,tmApartment); end. |
联系客服