通過shell上下文菜單打開多個文件作爲參數

Question

我想在Windows資源管理器中選擇多個文本文件並通過我的應用程序中的上下文菜單打開文件。對於一個文件，我找到了解決方案，但對於更多的文件有一些想法，但沒有（工作）解決方案。 這裏有誰有答案？

Answer 1

這裏是我剛從互聯網上搜索和收集的一個例子。

目標：在Windows資源管理器中選擇多個文件夾，並通過shell上下文菜單項「SelectedFolders」獲取這些文件夾名稱的列表，或者使用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.