open multiple files via shell context menu as params

Question

I want to select more than one text file in the windows explorer and open the files via context menu in my app. For one file I found the solution but for more files there some ideas but no (working) solutions. Anyone here that has the answer?

Answer 1

Here is an example that i've just searched and collected from internet.

Aim: Select multiple folders in Windows Explorer and get list of these folders' names via a shell context menu item "SelectedFolders", or using SendTo menu or drag-and-drop folders from shell onto the application form.

Please put a listbox named lstSelectedFolders and a speed button named sbClearList.

The main form name is frmSelectedFolders.

Here we go.

/////////////////////////////////////////////////////////////

program selectedfolders;

uses
  Windows, Messages, SysUtils, Forms,
  uSelectedFolders in 'uSelectedFolders.pas' {frmSelectedFolders};

{$R *.res}

var
  receiver: THandle;
  i, result: integer;
  s: string;
  dataToSend: TCopyDataStruct;

  Mutex : THandle;

begin
  Mutex := CreateMutex(nil, True, 'SelectedFolders');

  if (Mutex <> 0) and (GetLastError = 0) then
  begin
    Application.Initialize;
    Application.Title := 'Selected Folders';
    Application.CreateForm(TfrmSelectedFolders, frmSelectedFolders);
    Application.Run;

    if Mutex <> 0 then CloseHandle(Mutex);
  end

  else
  begin
    receiver := FindWindow(PChar('TfrmSelectedFolders'), PChar('Selected Folders'));

    if receiver <> 0 then
    begin

      for i:=1 to ParamCount do
      begin
        s := trim(ParamStr(i));

        if s <> '' then
        begin
          dataToSend.dwData := 0;
          dataToSend.cbData := 1 + Length(s);
          dataToSend.lpData := PChar(s);

          result := SendMessage(receiver, WM_COPYDATA, Integer(Application.Handle), Integer(@dataToSend));
          //sleep(100);
          //if result > 0 then
          //  ShowMessage(Format('Sender side: Receiver has %d items in list!', [result]));
        end;
      end; // for i
    end;
  end;
end.

/////////////////////////////////////////////////////////////

unit uSelectedFolders;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, ActiveX, ComObj, ShlObj, Registry, Buttons;

type
  TfrmSelectedFolders = class(TForm)
    lstSelectedFolders: TListBox;
    sbClearList: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure sbClearListClick(Sender: TObject);

  private { Private declarations }

  public { Public declarations }
    procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
    function GetTarget(const LinkFileName: string): string;
  end;

var
  frmSelectedFolders: TfrmSelectedFolders;

implementation

{$R *.dfm}

procedure RegisterContextMenuForFolders();
const
  Key = 'Directory\shell\SelectedFolders\command\';    
begin
  with TRegistry.Create do
  try
    // for all users, class registration for directories
    RootKey := HKEY_CLASSES_ROOT;

    if OpenKey(Key, true) then
      WriteString('', '"' + Application.ExeName + '" "%l"');
  finally
    Free; 
  end;
end;

procedure TfrmSelectedFolders.WMDROPFILES(var Message: TWMDROPFILES);
var
  N, i: integer;
  buffer: array[0..255] of Char;
  s: string;
begin
  try
    N := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);

    for i:=1 to N do
    begin
      DragQueryFile(Message.Drop, i-1, @buffer, SizeOf(buffer));

      s := buffer;

      if UpperCase(ExtractFileExt(s)) = '.LNK' then
        s := GetTarget(s);

      if lstSelectedFolders.Items.IndexOf(s) < 0 then
        lstSelectedFolders.Items.Add(s);
    end;
  finally
    DragFinish(Message.Drop);
  end;
end;

function TfrmSelectedFolders.GetTarget(const LinkFileName: string): string;
var
   //Link : String;
   psl  : IShellLink;
   ppf  : IPersistFile;
   WidePath  : Array[0..260] of WideChar;
   Info      : Array[0..MAX_PATH] of Char;
   wfs       : TWin32FindData;
begin
  if UpperCase(ExtractFileExt(LinkFileName)) <> '.LNK' then
  begin
    Result := 'NOT a shortuct by extension!';
    Exit;
  end;

  CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
  if psl.QueryInterface(IPersistFile, ppf) = 0 Then
  Begin
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(LinkFileName), -1, @WidePath, MAX_PATH);
    ppf.Load(WidePath, STGM_READ);
    psl.GetPath(@info, MAX_PATH, wfs, SLGP_UNCPRIORITY);
    Result := info;
  end
  else
    Result := '';
end;

procedure TfrmSelectedFolders.WMCopyData(var Msg: TWMCopyData);
var
  s: string;  
begin
  s := trim(PChar(Msg.copyDataStruct.lpData));

  if s = '' then
  begin
    msg.Result := -1;
    exit;
  end;

  if UpperCase(ExtractFileExt(s)) = '.LNK' then
    s := GetTarget(s);

  if lstSelectedFolders.Items.IndexOf(s) < 0 then
    lstSelectedFolders.Items.Add(s);

  msg.Result := lstSelectedFolders.Items.Count;
end;

procedure TfrmSelectedFolders.FormCreate(Sender: TObject);
var
  i: integer;
  s: string;
begin
  RegisterContextMenuForFolders();

  DragAcceptFiles(Handle, TRUE);

  lstSelectedFolders.Clear;

  s := ExtractFileDir(Application.ExeName);
  lstSelectedFolders.Items.Add(s);

  for i:=1 to ParamCount do
  begin
    s := trim(ParamStr(i));

    if UpperCase(ExtractFileExt(s)) = '.LNK' then
      s := GetTarget(s);

    if lstSelectedFolders.Items.IndexOf(s) < 0 then
      lstSelectedFolders.Items.Add(s);
  end;
end;

procedure TfrmSelectedFolders.sbClearListClick(Sender: TObject);
begin
  lstSelectedFolders.Clear;
end;

end.