Question

我想在Windows资源管理器中选择多个文本文件，并通过我的应用程序中的上下文菜单打开文件。对于一个文件我找到了解决方案但是对于更多文件有一些想法但没有（工作）解决方案。这里的任何人都有答案吗？

Answer 1

这是我刚从互联网上搜索和收集的一个例子。

目标：在Windows资源管理器中选择多个文件夹并获取这些文件夹的列表＆＃39;通过shell上下文菜单项＆＃34; SelectedFolders＆＃34;，或使用SendTo菜单或将文件夹从shell拖放到申请表上。

请输入名为lstSelectedFolders的列表框和名为sbClearList的速度按钮。

主要表单名称是frmSelectedFolders。

我们走了。

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

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.

通过shell上下文菜单打开多个文件作为参数

1 个答案: