Mega Code Archive
Implementing Send To Menu In Your Programs
<![CDATA[
Title: Implementing Send-To Menu In Your Programs
Question: I See Many programs like windows explorer itself that implements a send-to menu item, may i do it myself ??
Answer:
Here Is The Whole Unit
======================
unit uSendTo;
interface
uses
SysUtils, Windows, Messages, Classes, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, ComCtrls, FileCtrl,
ShellAPI, ShlObj, ActiveX, ComObj ;
// Very basic example - a Form with a FileListBox and a PopupMenu...
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
FileListBox1: TFileListBox;
procedure FormCreate(Sender: TObject);
private
procedure SendToItemClick(Sender: TObject); // MenuItem event-handler
public
{ Public declarations }
end;
// declare a special type of TMenuItem to store the EXE name...
type TMyMenuItem=class(TMenuItem)
public Verb:String;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// a pipe-delimited list of file extensions that are normally hidden...
const HiddenExtensions = '.LNK|.DESKLINK|.MYDOCS|.MAPIMAIL';
// Get path to the SendTo folder (Like Madshi says) ...
function GetSendToFolder:string;
var
pIDL :pItemIDList;
Buffer: array[0..MAX_PATH]of char;
Malloc: IMalloc;
begin
SHGetSpecialFolderLocation(0, CSIDL_SENDTO, pIDL);
ShGetPathFromIdList(pIDL, PChar(@Buffer));
Result:= Buffer;
OLECheck(SHGetMalloc(Malloc));
if pIDL nil then Malloc.Free(pIDL);
end;
// Recursive function to find all items in SendTo folder
// Creates sub-menu items if the folder has sub-directories...
procedure CreateMenuItems(Path:string; aMenuItem:TMenuItem);
var
SR:TSearchRec;
MI:TMyMenuItem;
procedure AddIf;
begin
if SR.Attr and faDirectory MI := TMyMenuItem.Create(Form1);
if pos(UpperCase(ExtractFileExt(SR.Name)), HiddenExtensions)0 then
MI.Caption :=ChangeFileExt(SR.Name,'') else MI.Caption :=SR.Name;
MI.Verb:=Path+SR.Name;
MI.OnClick:=Form1.SendToItemClick; //Assign event handler
aMenuItem.Add(MI)
end else if SR.Name[1]'.' then begin // if it's a folder
MI := TMyMenuItem.Create(Form1);
MI.Caption := SR.Name;
aMenuItem.Add(MI);
CreateMenuItems(Path+SR.Name, MI); // Recursive call
end;
end;
begin
if Path[Length(Path)]'\' then Path:=Path+'\';
if FindFirst(Path+'*',faAnyFile,SR)=0 then begin
AddIf;
while FindNext(SR)=0 do AddIf;
end;
end;
// Find the EXE that the shortcut points to -
// Adapted from Elliott Shevin's TShortcutLink component
// (this could be modified to get the icon, ShowState, etc... )
function GetShortcutTarget(ShortcutFilename:string):string;
var
Psl:IShellLink;
Ppf:IPersistFile;
WideName:Array [0..MAX_PATH] of WideChar;
pResult:Array [0..MAX_PATH-1] Of Char;
Data:TWin32FindData;
const
IID_IPersistFile: TGUID = (
D1:$0000010B; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
begin
CoCreateInstance(CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER, IID_IShellLinkA ,psl);
psl.QueryInterface(IID_IPersistFile,ppf);
MultiByteToWideChar(CP_ACP, 0, pChar(ShortcutFilename), -1, WideName, Max_Path);
ppf.Load(WideName,STGM_READ);
psl.Resolve(0,SLR_ANY_MATCH);
psl.GetPath( @pResult,MAX_PATH,Data,SLGP_UNCPRIORITY);
Result:=StrPas(@pResult);
end;
procedure TForm1.SendToItemClick(Sender: TObject);
begin
// Just shows the filename - you could use ShellExecute or CreateProcess instead
// But need some special handling for MyDocuments, Desktop and MailRecipient
ShowMessage(GetShortcutTarget(TMyMenuItem(Sender).Verb));
end;
after compiling, it will be very easy to U to ge the needed functions and add them tto your own applications !!
Have Fun !!
]]>