Подскажите, пожалуйста, как вызвать в своей программе контекстное меню к файлу\файлам как в проводнике при нажатии правой кнопки?

Типо так...

Код

uses ShlObj,ActiveX,ShellCtrls; procedure GetProperties(const fName:string;MP:TPoint;WC:TWinControl); var dISF,ISF:IShellFolder;    ICMenu:IContextMenu;    ICMenu2:IContextMenu2;    CMD:TCMInvokeCommandInfo;    PathPIDL,FilePIDL:PItemIDList;    cIE,HR:HResult;    M:IMAlloc;    pMenu:HMenu;    fPath:PWideChar;    s:string;    Attr,L:Cardinal;    fPM:LongBool;    ICmd:integer;    ZVerb: array[0..1023] of char;    Verb: string;    Handled:Boolean;    SCV: IShellCommandVerb; begin pMenu:=0; cIE:=CoInitializeEx(nil,COINIT_MULTITHREADED); try  s:=ExtractFilePath(trim(fName));  if s[Length(s)]<>'\' then s:=s+'\';  fPath:=StringToOleStr(s);  L:=Length(s);  Attr:=0;  PathPIDL:=nil;  FilePIDL:=nil;  if Succeeded(SHGetDesktopFolder(dISF)) then   if dISF.ParseDisplayName(WC.Handle,nil,fPath,L,PathPIDL,Attr)=S_OK then    if dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))=S_OK then     begin      s:=ExtractFileName(trim(fName));      if s<>'' then       begin        fPath:=StringToOleStr(s);        L:=Length(s);        ISF.ParseDisplayName(WC.Handle,nil,fPath,L,FilePIDL,Attr);        HR:=ISF.GetUIObjectOf(WC.Handle,1,FilePIDL,IID_IContextMenu,nil,Pointer(ICMenu));       end else HR:=dISF.GetUIObjectOf(WC.Handle,1,PathPIDL,IID_IContextMenu,nil,Pointer(ICMenu));      if Succeeded(HR) then       begin        Windows.ClientToScreen(WC.Handle,MP);        pMenu:=CreatePopupMenu;        ICMenu.QueryContextMenu(pMenu,0,1,$7FFF,CMF_EXPLORE or CMF_CANRENAME);        ICMenu.QueryInterface(IID_IContextMenu2,ICMenu2);        try         fPM:=TrackPopupMenu(pMenu,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD,MP.X,MP.Y,0,WC.Handle,nil);        finally         ICMenu2:=nil;        end;        if fPM then         begin          ICmd:=LongInt(fPM)-1;          HR:=ICMenu.GetCommandString(ICmd,GCS_VERBA,nil,ZVerb,SizeOf(ZVerb));          Verb:=StrPas(ZVerb);          Handled:=False;          if Supports(WC,IShellCommandVerb,SCV) then           begin            HR:=0;            SCV.ExecuteCommand(Verb, Handled);           end;          if not(Handled) then           begin            FillChar(CMD,SizeOf(CMD),#0);            with CMD do             begin              cbSize:=SizeOf(CMD);              hWND:=WC.Handle;              lpVerb:=MakeIntResource(ICmd);              nShow:=SW_SHOWNORMAL;             end;            HR:=ICMenu.InvokeCommand(CMD);           end;          if Assigned(SCV) then           SCV.CommandCompleted(Verb,HR=S_OK);         end;       end;     end; finally  if FilePIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(FilePIDL);   M:=nil;  end;  if PathPIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(PathPIDL);   M:=nil;  end;  if pMenu<>0 then DestroyMenu(pMenu);  ICMenu:=nil;  ISF:=nil;  dISF:=nil;  if Succeeded(cIE) then CoUninitialize; end; end; procedure TForm1.Button1Click(Sender: TObject); begin GetProperties(Edit1.Text,Point(100,100),Form1); end;

PS: Не понимает диски , т.е. если Edit1.text='c:\' и т.п., для остального работает... (папок/файлов)

Удачи.

Комодератор: Перенесенно из раздела Delphi:WinAPI

Это сообщение отредактировал(а) Girder - 12.12.2004, 17:00

А если несколько объектов?
Плюс ещё интересно: вместо подпунктов "Send To" вылазит просто одна менюшка с названием "Send To", но которая естественно не действует , а ещё лишний пункт присутствует - Rename? Можно это как-нибудь подправить? Что-то я не совсем тут понимаю ...

Это сообщение отредактировал(а) Illusion Dolphin - 12.12.2004, 19:25

На счёт rename вопрос снят, но вот как сделать чтобы отображалось меню "Send To"???

Цитата(Illusion @ 12.12.2004, 19:31)

но вот как сделать чтобы отображалось меню "Send To"???

Вот не много подкорректировал... что б submenu выводилось и понимало 'e:\', т.е. диски

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ShlObj, ActiveX, ComObj; type  TForm1 = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  ICMenu2:IContextMenu2=nil;  OldWinProc:integer; implementation {$R *.dfm} function SendToProc(Wnd: HWND; Msg: UINT; WParam, LParam: Integer):LRESULT; stdcall; var Text:array [0..255] of char; begin if ((Msg=WM_INITMENUPOPUP)or(Msg=WM_DRAWITEM)or(Msg=WM_MENUSELECT)or(MSG=WM_MENUCHAR)or     (Msg=WM_MEASUREITEM))and Assigned(ICMenu2) then  begin   if Msg=WM_MENUSELECT then    begin     ICMenu2.GetCommandString(LoWord(WParam-1),GCS_HELPTEXT,nil,Text,SizeOf(Text));     Form1.Caption:=Text;     Result:=0;     exit;    end;   ICMenu2.HandleMenuMsg(Msg,wParam,lParam);   Result:=0;  end else  Result:=CallWindowProc(Pointer(OldWinProc),Wnd,Msg,WParam,LParam); end; procedure GetProperties(const fName:string;MP:TPoint;WC:TWinControl); var dISF,ISF:IShellFolder;    ICMenu:IContextMenu;    CMD:TCMInvokeCommandInfo;    PathPIDL,FilePIDL{,nn}:PItemIDList;    cIE,HR:HResult;    M:IMAlloc;    pMenu:HMenu;    fPath:PWideChar;    sFP,sFN:string;    Attr,L:Cardinal;    fPM:LongBool;    ICmd:integer; begin OldWinProc:=0; pMenu:=0; Attr:=0; PathPIDL:=nil; FilePIDL:=nil; {nn:=nil;} cIE:=CoInitializeEx(nil,COINIT_MULTITHREADED); try  sFP:=ExtractFilePath(trim(fName));  if sFP[Length(sFP)]<>'\' then SFP:=sFP+'\';  sFN:=ExtractFileName(trim(fName));  if SHGetDesktopFolder(dISF)<>S_OK then exit;  if sFN='' then   begin    sFN:=sFP;    fPath:=StringToOleStr(sFN);    L:=Length(sFN);    if (SHGetSpecialFolderLocation(0,CSIDL_DRIVES,PathPIDL)<>S_OK)or     (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;    ISF.ParseDisplayName(0,nil,fPath,L,FilePIDL,Attr);    HR:=ISF.GetUIObjectOf(0,1,FilePIDL,IID_IContextMenu,nil,Pointer(ICMenu));   end else   begin    fPath:=StringToOleStr(sFP);    L:=Length(sFP);    if (dISF.ParseDisplayName(0,nil,fPath,L,PathPIDL,Attr)<>S_OK)or     (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;    fPath:=StringToOleStr(sFN);    L:=Length(sFN);    ISF.ParseDisplayName(0,nil,fPath,L,FilePIDL,Attr); //    fPath:=StringToOleStr('1\vvv.exe'); //    L:=Length('1\vvv.exe'); //    ISF.ParseDisplayName(WC.Handle,nil,fPath,L,nn,Attr);    HR:=ISF.GetUIObjectOf(0,1,FilePIDL,IID_IContextMenu,nil,Pointer(ICMenu)); //    HR:=ISF.GetUIObjectOf(0,2,nn,IID_IContextMenu,nil,Pointer(ICMenu));   end; if Succeeded(HR) then  begin   ICMenu2:=nil;   Windows.ClientToScreen(WC.Handle,MP);   OldWinProc:=SetWindowLong(WC.Handle,GWL_WNDPROC,Integer(@SendToProc));   pMenu:=CreatePopupMenu;   ICMenu.QueryContextMenu(pMenu,0,1,$7FFF,CMF_EXPLORE or CMF_CANRENAME);   ICMenu.QueryInterface(IID_IContextMenu2,ICMenu2);   try    fPM:=TrackPopupMenu(pMenu,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD,MP.X,MP.Y,0,WC.Handle,nil);   finally //   ICMenu2:=nil;   end;   if fPM then    begin     ICmd:=LongInt(fPM)-1;     FillChar(CMD,SizeOf(CMD),#0);     with CMD do      begin       cbSize:=SizeOf(CMD);       lpVerb:=MakeIntResource(ICmd);       nShow:=SW_SHOWNORMAL;      end;     ICMenu.InvokeCommand(CMD);    end;  end; finally  if OldWinProc<>0 then SetWindowLong(WC.Handle,GWL_WNDPROC,OldWinProc);  ICMenu2:=nil;  if FilePIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(FilePIDL);   M:=nil;  end;  if PathPIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(PathPIDL);   M:=nil;  end;  if pMenu<>0 then DestroyMenu(pMenu);  ISF:=nil;  dISF:=nil;  if cIE=S_OK then CoUninitialize; end; end; procedure TForm1.Button1Click(Sender: TObject); begin GetProperties('e:\4\VVV.exe',Point(100,100),Form1); end; end.

PS: Обрати внимание на закоментированные строчки: енто я показал тебе как делается отображение для "мульти выбора" . т.е. необходимо: разделить самый-самый верхний(общий) каталог для твоего списка выбранных файлов/папок и и файлы(с путями) относительно общего каталога. Если что будет не понятно... пиши...

Удачи.

Это сообщение отредактировал(а) Girder - 14.12.2004, 18:09

Во-первых ConcatPIDLs - откуда она? Я её пытался так определить, но что-то не так:

Код

function CreatePIDL(Size: Integer): PItemIDList; var Malloc: IMalloc; HR: HResult; begin Result := nil; HR := SHGetMalloc(Malloc); if Failed(HR) then Exit; try Result := Malloc.Alloc(Size); if Assigned(Result) then FillChar(Result^, Size, 0); finally end; end; function GetPIDLSize(pidl: PItemIDList): Integer; begin  Result := 0;  while pidl <> nil do  begin    if pidl^.mkid.cb = 0 then    begin      Inc( Result, sizeof(WORD) ); // size of terminator;      break;    end;    Inc( Result, pidl^.mkid.cb );    pidl := PItemIDList ( Integer(PByte(pidl)) + pidl^.mkid.cb );  end; end; function ConcatPIDLs(ID1, ID2: PItemIDList): PItemIDList; var cb1, cb2: Integer; begin if Assigned(ID1) then cb1 := GetPIDLSize(ID1) - sizeof(ID1^.mkid.cb) else cb1 := 0; cb2 := GetPIDLSize(ID2); Result := CreatePIDL(cb1 + cb2); if Assigned(Result) then begin if Assigned(ID1) then CopyMemory(Result, ID1, cb1); CopyMemory(PChar(Result) + cb1, ID2, cb2); end; end;

P.S. Ещё странный глюк обнаружился у меня как в этом коде: если выбрать в меню send to мои документы, то пункт выполняется, НО выдаётся ошибка, что не unable to handle этот документ (боюсь переводить чтобы смысл не потерялся). Или это только у меня на компе?

Это сообщение отредактировал(а) Illusion Dolphin - 13.12.2004, 18:55

ВСЁ РАБОТАЕТ!!!! БАЛЬШОЕ СЕНЬКС, буду разбираться... что-то у меня было немного не то... Но на счёт отправки в мои документы что-нибудь можешь посмотреть?

Вот интересно на счёт того места с коментариями. Я долго-долго думал, как оно всё работает (особенно то место где мы получаем nn и совсем забываем про FilePIDL) и вот что я думаю... Самое интересное, что если сделать не так

Код

PathPIDL,FilePIDL,nn:PItemIDList;

а так

Код

PathPIDL,FilePIDL,MyPITEM,nn:PItemIDList;

то прога работать не будет
Полчала думал что за чушь, потом понял... при инициализации процедуры делфа выделяет память по очереди для переменных (слева направо) и в результате получалось именно то, что требует MSDN - последовательность этих структур. В конце концов я юзал массив PItemIDList и передавал в параметр просто 0-й элемент, самое странно теперь, что всё это работает .

Это сообщение отредактировал(а) Illusion Dolphin - 13.12.2004, 21:59

Вот что получилось в итоге (демо версия, нужно оптимизировать, глюк с "Send to->My Documents" остался)

Код

unit ShellContextMenu; interface uses StdCtrls, ComCtrls, ShlObj, ActiveX, ShellCtrls, WIndows, SysUtils, Messages,     Controls, Math;     procedure GetProperties(fNames : array of string; MP : TPoint; WC : TWinControl); procedure GetPropertiesWindows(fNames : array of string; WC : TWinControl); implementation procedure FormatDir(var s:string); begin if s='' then exit; if s[length(s)]<>'\' then s:=s+'\'; end; Function GetCommonDir(dir1 {Common  dir}, dir2 {Compare dir} : String) : String; var  i, c : integer; begin if Dir1=dir2 then begin  Result:=Dir1; end else begin  if dir1=Copy(dir2,1,Length(dir1)) then  begin   Result:=dir1;   exit;  end;  c:=Min(Length(dir1),Length(dir2));  for i:=1 to c do  if dir1[i]<>dir2[i] then  begin   c:=i;   break;  end;  Result:=ExtractFilePath(Copy(dir1,1,c-1)); end; end; function GetCommonDirectory(Files : array of string) : String; var  i, j : integer;  s, temp, d : string; begin Result:=''; if Length(Files)=0 then exit; for i:=0 to Length(Files)-1 do begin  Files[i]:=ExtractFilePath(Files[i]) end; s:=Copy(Files[0],1,2); temp:=Files[0]; for i:=0 to Length(Files)-1 do begin  Files[i]:=AnsiLowerCase(Files[i]);  If length(Files[i])<2 then exit;  if s<>Copy(Files[i],1,2) then exit;  d:=ExtractFilePath(Files[i]);  if Length(Temp)>Length(d) then  temp:=d; end; for i:=0 to Length(Files)-1 do begin  temp:=GetCommonDir(temp,Files[i]); end; Result:=temp; end; function MenuCallback(Wnd: HWND; Msg: UINT; wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall; var  ContextMenu2: IContextMenu2; begin  case Msg of    WM_CREATE:      begin        ContextMenu2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);        SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2));        Result := DefWindowProc(Wnd, Msg, wParam, lParam);      end;    WM_INITMENUPOPUP:      begin        ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));        ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);        Result := 0;      end;    WM_DRAWITEM, WM_MEASUREITEM:      begin        ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));        ContextMenu2.HandleMenuMsg(Msg, wParam, lParam);        Result := 1;      end;  else    Result := DefWindowProc(Wnd, Msg, wParam, lParam);  end; end; function CreateMenuCallbackWnd(const ContextMenu: IContextMenu2): HWND; const  IcmCallbackWnd = 'ICMCALLBACKWND'; var  WndClass: TWndClass; begin  FillChar(WndClass, SizeOf(WndClass), #0);  WndClass.lpszClassName := PChar(IcmCallbackWnd);  WndClass.lpfnWndProc := @MenuCallback;  WndClass.hInstance := HInstance;  Windows.RegisterClass(WndClass);  Result := CreateWindow(IcmCallbackWnd, IcmCallbackWnd, WS_POPUPWINDOW, 0,    0, 0, 0, 0, 0, HInstance, Pointer(ContextMenu)); end; procedure GetProperties(fNames : array of string; MP : TPoint; WC : TWinControl); var   dISF,ISF:IShellFolder;   ICMenu:IContextMenu;   ICMenu2: IContextMenu2;   CMD:TCMInvokeCommandInfo;   PathPIDL:PItemIDList;   FilePIDLs : array of PItemIDList;   cIE,HR:HResult;   M:IMAlloc;   pMenu:HMenu;   fPath:PWideChar;   sFP,sFN,s:string;   Attr,L:Cardinal;   fPM:LongBool;   ICmd:integer;   ZVerb: array[0..1023] of char;   Verb: string;   Handled:Boolean;   SCV:IShellCommandVerb;   i, len : integer;   CallbackWindow: HWND; begin pMenu:=0; Attr:=0; PathPIDL:=nil; cIE:=CoInitializeEx(nil,COINIT_MULTITHREADED); try  sFP:=GetCommonDirectory(fNames);  len:=length(sFP);  sFN:=fNames[0];  Delete(sFN,1,length(sFP));  if SHGetDesktopFolder(dISF)<>S_OK then exit;  if sFN='' then  begin   sFN:=sFP;   fPath:=StringToOleStr(sFN);   L:=Length(sFN);   if (SHGetSpecialFolderLocation(0,CSIDL_DRIVES,PathPIDL)<>S_OK) or   (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;   SetLength(FilePIDLs,1);   ISF.ParseDisplayName(WC.Handle,nil,fPath,L,FilePIDLs[0],Attr);   HR:=ISF.GetUIObjectOf(WC.Handle,1,FilePIDLs[0],IID_IContextMenu,nil,Pointer(ICMenu));  end else  begin   fPath:=StringToOleStr(sFP);   L:=Length(sFP);   SetLength(FilePIDLs,Length(fNames)+1);   FillChar(FilePIDLs[Length(fNames)],Sizeof(PItemIDList),#0);   for i:=0 to Length(fNames)-1 do   FilePIDLs[i]:=nil;   if (dISF.ParseDisplayName(WC.Handle,nil,fPath,L,PathPIDL,Attr)<>S_OK)or   (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;   for i:=0 to Length(fNames)-1 do   begin    delete(fNames[i],1,len);    fPath:=StringToOleStr(fNames[i]);    L:=Length(fNames[i]);    ISF.ParseDisplayName(WC.Handle,nil,fPath,L,FilePIDLs[i],Attr);   end;   HR:=ISF.GetUIObjectOf(WC.Handle,Length(fNames),FilePIDLs[0],IID_IContextMenu,nil,Pointer(ICMenu));  end;  if Succeeded(HR) then  begin   ICMenu2:=nil;   Windows.ClientToScreen(WC.Handle,MP);   pMenu:=CreatePopupMenu;   if Succeeded(ICMenu.QueryContextMenu(pMenu, 0, 1, $7FFF, CMF_EXPLORE)) then   CallbackWindow := 0;   if Succeeded(ICMenu.QueryInterface(IContextMenu2, ICMenu2)) then   begin    CallbackWindow := CreateMenuCallbackWnd(ICMenu2);   end;   try    fPM:=TrackPopupMenu(pMenu,TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_RETURNCMD,MP.X,MP.Y,0,CallbackWindow,nil);   finally    ICMenu2:=nil;   end;   if fPM then   begin    ICmd:=LongInt(fPM)-1;    HR:=ICMenu.GetCommandString(ICmd,GCS_VERBA,nil,ZVerb,SizeOf(ZVerb));    Verb:=StrPas(ZVerb);    Handled:=False;    if Supports(WC,IShellCommandVerb,SCV) then    begin     HR:=0;     SCV.ExecuteCommand(Verb, Handled);    end;    if not(Handled) then    begin     FillChar(CMD,SizeOf(CMD),#0);     with CMD do     begin      cbSize:=SizeOf(CMD);      hWND:=WC.Handle;      lpVerb:=MakeIntResource(ICmd);      nShow:=SW_SHOWNORMAL;     end;     HR:=ICMenu.InvokeCommand(CMD);    end;    if Assigned(SCV) then    SCV.CommandCompleted(Verb,HR=S_OK);   end;  end; finally  for i:=0 to Length(fNames)-1 do  if FilePIDLs[i]<>nil then  begin   SHGetMAlloc(M);   M.Free(FilePIDLs[i]);   M:=nil;  end;  if PathPIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(PathPIDL);   M:=nil;  end;  if pMenu<>0 then DestroyMenu(pMenu);  if CallbackWindow <> 0 then DestroyWindow(CallbackWindow);  ICMenu:=nil;  ISF:=nil;  dISF:=nil;  if cIE=S_OK then CoUninitialize; end; end; procedure GetPropertiesWindows(fNames : array of string; WC : TWinControl); var   dISF,ISF:IShellFolder;   ICMenu:IContextMenu;   CMD:TCMInvokeCommandInfo;   PathPIDL:PItemIDList;   FilePIDLs : array of PItemIDList;   cIE,HR:HResult;   M:IMAlloc;   pMenu:HMenu;   fPath:PWideChar;   sFP,sFN:string;   Attr,L:Cardinal;   ICmd:integer;   ZVerb: array[0..1023] of char;   Verb: string;   Handled:Boolean;   SCV:IShellCommandVerb;   i, len : integer; begin pMenu:=0; Attr:=0; PathPIDL:=nil; cIE:=CoInitializeEx(nil,COINIT_MULTITHREADED); try  sFP:=GetCommonDirectory(fNames);  len:=length(sFP);  sFN:=fNames[0];  Delete(sFN,1,length(sFP));  if SHGetDesktopFolder(dISF)<>S_OK then exit;  if sFN='' then  begin   sFN:=sFP;   fPath:=StringToOleStr(sFN);   L:=Length(sFN);   if (SHGetSpecialFolderLocation(0,CSIDL_DRIVES,PathPIDL)<>S_OK) or   (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;   SetLength(FilePIDLs,1);   ISF.ParseDisplayName(WC.Handle,nil,fPath,L,FilePIDLs[0],Attr);   HR:=ISF.GetUIObjectOf(WC.Handle,1,FilePIDLs[0],IID_IContextMenu,nil,Pointer(ICMenu));  end else  begin   fPath:=StringToOleStr(sFP);   L:=Length(sFP);   SetLength(FilePIDLs,Length(fNames)+1);   FillChar(FilePIDLs[Length(fNames)],Sizeof(PItemIDList),#0);   for i:=0 to Length(fNames)-1 do   FilePIDLs[i]:=nil;   if (dISF.ParseDisplayName(WC.Handle,nil,fPath,L,PathPIDL,Attr)<>S_OK)or   (dISF.BindToObject(PathPIDL,nil,IID_IShellFolder,Pointer(ISF))<>S_OK) then exit;   for i:=0 to Length(fNames)-1 do   begin    delete(fNames[i],1,len);    fPath:=StringToOleStr(fNames[i]);    L:=Length(fNames[i]);    ISF.ParseDisplayName(WC.Handle,nil,fPath,L,FilePIDLs[i],Attr);   end;   HR:=ISF.GetUIObjectOf(WC.Handle,Length(fNames),FilePIDLs[0],IID_IContextMenu,nil,Pointer(ICMenu));  end;  if Succeeded(HR) then  begin   pMenu:=CreatePopupMenu;   if Succeeded(ICMenu.QueryContextMenu(pMenu, 0, 1, $7FFF, CMF_EXPLORE)) then   FillChar(CMD,SizeOf(CMD),#0);   with CMD do   begin    cbSize:=SizeOf(CMD);    hWND:=WC.Handle;    lpVerb:='Properties';    nShow:=SW_SHOWNORMAL;   end;   HR:=ICMenu.InvokeCommand(CMD);   if Assigned(SCV) then   SCV.CommandCompleted(Verb,HR=S_OK);  end; finally  for i:=0 to Length(fNames)-1 do  if FilePIDLs[i]<>nil then  begin   SHGetMAlloc(M);   M.Free(FilePIDLs[i]);   M:=nil;  end;  if PathPIDL<>nil then  begin   SHGetMAlloc(M);   M.Free(PathPIDL);   M:=nil;  end;  dISF:=nil;  if cIE=S_OK then CoUninitialize; end; end; end.

Цитата(Illusion @ 13.12.2004, 21:27)

то прога работать не будет

Просто обнулять надо... не забывать...

Цитата(Illusion @ 14.12.2004, 01:10)

глюк с "Send to->My Documents" остался

Она везде присутствует... , кроме explorer-а .
Ставь "заглушку" и не парься .

Типо такая функция :

Код

function SetErrorShell(Cmd:Byte):Byte; var ErrOld,Shell32,OP,i:Cardinal;    SMB_W:Pointer;    R:Byte; begin R:=0; if Cmd=0 then Cmd:=$C3; ErrOld:=SetErrorMode(SEM_NOOPENFILEERRORBOX); Shell32:=LoadLibrary('shell32.dll'); if Shell32<>0 then  begin   SMB_W:=GetProcAddress(Shell32,'ShellMessageBoxW');   if SMB_W<>nil then    begin     OP:=OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE or PROCESS_VM_OPERATION,false,GetCurrentProcessID);     if OP<>0 then      begin       if not(ReadProcessMemory(OP,SMB_W,@R,SizeOf(R),i)and(i=SizeOf(R))and              WriteProcessMemory(OP,SMB_W,@Cmd,SizeOf(Cmd),i)and(i=SizeOf(Cmd))) then R:=0;       CloseHandle(OP);      end;    end;   FreeLibrary(Shell32);  end; SetErrorMode(ErrOld); Result:=R; end;

PS: использование SetErrorShell:

Код

var ... R_H:Byte; begin  ....   R_H:=SetErrorShell(0); //Ставим   ICMenu.InvokeCommand(CMD);   if R_H<>0 then SetErrorShell(R_H); //Востанавливаем ... end;

Удачи.

Это сообщение отредактировал(а) Girder - 15.12.2004, 10:00